问:如何让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; 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; 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 //***********************************************************8 program password_dos; {$apptype console} //设置程序为非图形界面 uses windows, messages; const s:boolean=true;//置循环标志 var pass_edit_hwnd:hwnd;//密码窗口句柄 p:tpoint; //鼠标指针 begin writeln; writeln('**************************************************************************'); writeln; writeln; writeln(' 星号*密码破解器' ); writeln(' 使用方法:将鼠标移动到密码框,密码就会自动现形!' ); writeln(' 按 Ctrl+C 退出程序。 ' ); writeln(' \\\|/// ' ); writeln(' \\ - - // ' ); writeln(' ( @ @ ) ' ); writeln(' +----------------------oOOo-(_)-oOOo---------------------+ '); writeln(' | | '); writeln(' | 若在使用过程中发现任何问题或有新的想法请及时与我联系: | '); writeln(' | 主页:http://lovejingtao.126.com | '); writeln(' | E-MAIL: 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; 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; 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; 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; end; 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; 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; 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 ; 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; 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; 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)]));