delphi使用技藝大全

問:如何讓del+CTRL+ALT看不見程序運行?
答:為了讓程序用ALT+DEL+CTRL看不見,在implementation后添加聲明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
再在上面的窗口Create事件加上一句：RegisterServiceProcess(GetCurrentProcessID, 1);//隱藏
也可以使用下面的函數(shù):
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;

問:自我拷貝法怎么樣使用?
答:這種方法的原理是程序運行時先查看自己是不是在特定目錄下,如果是就繼續(xù)運行,如果不是就把自己拷貝到特定目錄下,然后運行新程序,再退出舊程序.
打開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是自定義函數(shù),起功能是找出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;

問:如何避免同時運行多個相同程序?
答:為了避免同時運行多個程序的副本(節(jié)約系統(tǒng)資源也),程序一般會弄成每次只能運行一個.這又有幾種方法.
一種方法是程序運行時先查找有沒有相同的運行了,如果有,就立刻退出程序.
修改dpr項目文件，修改begin和end之間的代碼如下：
begin
Application.Initialize;
if FindWindow('TForm1','Form1')=0 then begin
//當沒有找到Form1時執(zhí)行下面代碼
Application.ShowMainForm:=False; //不顯示主窗口
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
另一種方法是啟動時會先通過窗口名來確定是否已經(jīng)在運行，如果是則關閉原先的再啟動。“冰河”就是用這種方法的。
這樣做的好處在于方便升級.它會自動用新版本覆蓋舊版本.
方法如下:修改dpr項目文件
uses
Forms,windows,messages,
Unit1 in 'Unit1.pas' {Form1};

問:如何能使程序能在windows啟動時自動啟動?
答:為了程序能在Windows每次啟動時自動運行,可以通過六種途徑來實現(xiàn).“冰河”用注冊表的方式。
加入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可執(zhí)行文件，比如說abc.exe,新建一個批處理文件a.bat，編輯其內容為：
:pp
del abc.exe
if exist abc.exe goto pp
del %0
先運行abc.exe，再運行a.bat，然后將abc.exe退出，你會發(fā)現(xiàn)a.exe和a.bat都沒有了！��！按照這個思路，我們可以在程序中根據(jù)文件名稱寫一個批處理，將上面的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！上面的程序原理是對的，但如果你的程序是運行在系統(tǒng)目錄下如Windows目錄下或者Windows\System等目錄下，除非你打開那個目錄看著它刪除，否則根本沒法卸掉的。那怎么辦？別急，我們請出一個函數(shù)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
);
這個函數(shù)和OpenProcess、ReadProcessMemory、WriteProcessMemory使用可以用來讀取和修改內存數(shù)據(jù)，常用的游戲修改器就是用它。由于這些不是本文的重點所以這里不作詳細介紹，感興趣的讀者可自行翻閱Delphi自帶的幫助文件。用CreateProcess函數(shù)創(chuàng)建一個進程就可以完美的完成我們的“程序自殺”了。
運行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制作自己的安裝程序。記得有一位著名的黑客說過：我從來不去找什么工具軟件，需要的話就自己寫一個。如果我們也持這種態(tài)度，則編程水平一定會越來越高。

問:如何得到*******中的密碼?
答:這里有一個例子:
//***********************************************************8
//password_dos.dpr，陳經(jīng)韜作品
//http://lovejingtao.126.com
//lovejingtao@21cn.com
//***********************************************************8

program password_dos;
{$apptype console} //設置程序為非圖形界面

uses
windows,
messages;

const s:boolean=true;//置循環(huán)標志

var

pass_edit_hwnd:hwnd;//密碼窗口句柄
p:tpoint; //鼠標指針

begin

writeln;
writeln('**************************************************************************');
writeln;
writeln;
writeln('     星號*密碼破解器'                                             );
writeln('     使用方法:將鼠標移動到密碼框,密碼就會自動現(xiàn)形!'               );
writeln('     按 Ctrl+C 退出程序。 '                                       );
writeln('                                \\\|/// '                         );
writeln('                               \\ - - // '                        );
writeln('                                ( @ @ ) '                         );
writeln('      +----------------------oOOo-(_)-oOOo---------------------+ ');
writeln('      |                                                        | ');
writeln('      | 若在使用過程中發(fā)現(xiàn)任何問題或有新的想法請及時與我聯(lián)系:  | ');
writeln('      | 主頁:http://lovejingtao.126.com                        | ');
writeln('      | E-MAIL: lovejingtao@21cn.com                           | ');
writeln('      |                                                        | ');
writeln('      |                               Oooo 陳經(jīng)韜 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);//發(fā)送消息
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//創(chuàng)建a.ini
    begin
    WriteBool('MySetting', 'CheckBox1_Checked', CheckBox1.Checked);{保存到MySetting下面的CheckBox1_Checked子鍵下,然后把Checkbox1的是否按下狀態(tài)寫進去}
    WriteString('MySetting', 'Edit1_Text', Edit1.Text);//同上
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);//讀入a.ini文件中的設置
begin
  With TINIFile.Create('a.ini') do//打開已創(chuàng)建的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發(fā)送一條最大化消息(SC_MAXIMIZE)到這個窗體的句柄
//******************************************************
//另外postmessage(hwndwindow,wm_close,0,0);為關閉
//如果需要要自己的程序中使程序動態(tài)變最大化則用
form1.windowstate:=wsmaximized; //form1為你要最大化的窗口名！
//幾個要用到的名詞:
1.hwnd是句柄的意思,只有先得到了窗體的句柄才能控制它
2.findwindow是找窗體的意思
3.nil是空指針的意思
4.postmessage發(fā)送一條消息給一個已找到的窗口句柄.

問:如何使程序在執(zhí)行過程中暫停一段時間?
答:要使在運行中的程序暫停一段時間可以使用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控件

問:怎樣才能在程序中實現(xiàn)跳轉到網(wǎng)頁?
答:例子如下:
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系統(tǒng)
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數(shù)組是char類型的
//然后getwindowsdirectory(dir,255);
//用strpas函數(shù)來顯示出來
//還有一個例子也可以做到如下:
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:動態(tài)移動控件

************************
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;

**************************************
對某一個窗口發(fā)送鼠標消息
   SendMessage(Handle,WM_LBUTTONDBLCLK,0,0);
對系統(tǒng)發(fā)消息關閉程序
  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)); //毫秒

*****************************
執(zhí)行dos命令

winexec(pchar('net start w3svc '),sw_hide);
就是執(zhí)行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;

****************************
動態(tài)生成批處理文件

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環(huán)境下面的熱鍵
可以參看下面：
RegisterHotKey函數(shù)原型及說明：
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);
參數(shù) id為你自己定義的一個ID值，對一個線程來講其值必需在0x0000 - 0xBFFF范圍之內，對DLL來講其值必需在0xC000 - 0xFFFF 范圍之內，在同一進程內該值必須唯一
參數(shù) fsModifiers指明與熱鍵聯(lián)合使用按鍵，可取值為：MOD_ALT MOD_CONTROL MOD_WIN MOD_SHIFT
參數(shù) vk指明熱鍵的虛擬鍵碼

首先（舉個例子）： 
  RegisterHotKey(handle,globaladdatom('hot key'),MOD_ALT,vk_f12);
然后在form中聲明一個函數(shù)（過程）：
  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,則說明這個全局原子已經(jīng)被注冊;
    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;

*****************************
實現(xiàn)斷點續(xù)傳

如果使用ICS控件，那么
HttpCli.ContentRangeBegin := '100' 表示從100開始
HttpCli.ContentRangeEnd :='' 表示一直到結束
HttpCli.ContentRangeEnd :='200' 表示到200字節(jié)處結束

如果使用 TNMHTTP 控件
在OnAboutToSend事件，寫：
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-' 表示從100字節(jié)處開始下載到最后
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-200' 表示從100字節(jié)處開始下載到200字節(jié)處結束
***************
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來續(xù)傳的代碼。

**********************************
Delphi中用Sender參數(shù)實現(xiàn)代碼重用

面向對象的編程工具的特點之一就是要提高代碼重用性(Reuse)，作為新一代可視化開發(fā)工具，Delphi中的代碼重用性相當高。我們知道，在Delphi中，大部分程序代碼都直接或間接地對應著一個事件，此程序稱為事件處理句柄，它實際上就是一個過程。從應用程序的工程到表單、構件和程序，Delphi強調的是其開發(fā)過程中每一層次的重用性，可以通過編寫某些構件常用的事件處理句柄來達到程序重用目的。你可以在屬性窗口的Events頁上將A事件的處理句柄指向B事件的處理句柄，這樣A事件和B事件就共享了一個過程段，從而達到了重用的目的。如果共享的程序段與發(fā)生該事件的控件無關，如ShowMessage(′hello,world′)，那這種共享是最簡單的。但一般來說，代碼段間的共享都跟發(fā)生該事件的控件有關，需要根據(jù)控件類型做出相應的處理，這時就要用到Sender參數(shù)。
　　每個過程段的開頭都類似procedure TForm1�盕ormClick(Sender:TObject)；其中的Sender是一個TObject類型的參數(shù)，它告訴Delphi哪個控件接收這個事件并調用相應的處理過程。你可以編寫一個單一的事件處理句柄，通過Sender參數(shù)和IF…THEN…語句或者CASE語句配合，來處理多個構件。發(fā)生事件的構件或控件的值已經(jīng)賦給了Sender參數(shù)，該參數(shù)的用途之一就在于：可以使用保留字IS來測試Sender，以便找到調用這個事件處理句柄的構件或控件的類型。例如，將表單中編輯框和標簽的Click事件的處理句柄都指向表單的xxx過程，編輯框和標簽對Click事件有不同的反應：
　　procedure TForm1�眡xx(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參數(shù)的第二個用途是結合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參數(shù)可以通過單一過程段處理多類控件，真正體現(xiàn)了Delphi面向對象的重用性。

*****************************
窗口漸漸出現(xiàn)
 AnimateWindow(Handle,1000,AW_CENTER);

*****************************
delphi中嵌入?yún)R編的方法

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函數(shù)就成，你首先要用OpenProcessToken函數(shù)打開與進程相關的訪問信令然后再使用ExitWindow函數(shù)退出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的運行窗口直接執(zhí)行，在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" - 打開"映射網(wǎng)絡驅動器"窗口
"rundll32 user,wnetdisconnectdialog" - 打開"斷開網(wǎng)絡驅動器"窗口
"rundll32 user,disableoemlayer" - 顯示BSOD窗口, (BSOD) = Blue Screen Of Death, 即藍屏
"rundll32 diskcopy,DiskCopyRunDll" - 打開磁盤復制窗口
"rundll32 rnaui.dll,RnaWizard" - 運行"Internet連接向導", 如果加上參數(shù)"/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" - 運行"網(wǎng)絡連接"對話框
"rundll32 msprint2.dll,RUNDLL_PrintTestPage" - 選擇打印機和打印測試頁
"rundll32 user,setcaretblinktime" - 設置光標閃爍速度
"rundll32 user, setdoubleclicktime" - 測試鼠標雙擊速度
"rundll32 sysdm.cpl,InstallDevice_Rundll" - 搜索非PnP設備

***********************************
messagebeep(0);//聲卡發(fā)出be聲
windows.beep(2000,2000);//pc喇叭發(fā)出be聲，很嚇人//前一個是頻率，后一個是延時，98下會忽略

*******************************************************
得到可用內存和系統(tǒng)資源
procedure Tversion.FormCreate(Sender: TObject);
var
  MS: TMemoryStatus;
begin
  GlobalMemoryStatus(MS);
  label5.Caption := '可用內存：'+FormatFloat('#,###" KB"', MS.dwTotalPhys / 1024);
  label6.Caption := '系統(tǒng)資源 '+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
  {屏蔽系統(tǒng)鍵}
  SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @temp, 0);
  a:=rect(0,0,5,5);
  {鎖定鼠標在一定區(qū)域內，最好鎖在你的窗口里}
  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數(shù)據(jù)庫(建立.mdb文件,壓縮數(shù)據(jù)庫)
以下代碼在WIN2K,D6,MDAC2.6下測試通過,
編譯好的程序在WIN98第二版無ACCESS環(huán)境下運行成功.
//聲明連接字符串
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;
//壓縮與修復數(shù)據(jù)庫,覆蓋源文件
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 聲明.
    字段名為關鍵字的字段用方括號[]括起來,數(shù)字作為字段名也可行.

建立索引:
    下面的語句在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數(shù)據(jù)庫-在SQL中使用In子句:
    Select a.*,b.* From Tab1 a,Tab2 b In 'db2.mdb' Where a.ID=b.ID;
    上面的SQL語句查詢出當前數(shù)據(jù)庫中Tab1和db2.mdb(當前文件夾中)中Tab2以ID為關聯(lián)的所有記錄.
缺點-外部數(shù)據(jù)庫不能帶密碼.

在ACCESS中訪問其它ODBC數(shù)據(jù)源
下例在ACCESS中查詢SQLSERVER中的數(shù)據(jù)
    SELECT * FROM Tab1 IN [ODBC]
    [ODBC;Driver=SQL Server;UID=sa;PWD=;Server=127.0.0.1;DataBase=Demo;]
外部數(shù)據(jù)源連接屬性的完整參數(shù)是:
    [ODBC;DRIVER=driver;SERVER=server;DATABASE=database;UID=user;PWD=password;]
其中的DRIVER=driver可以在注冊表中的
    HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\
中找到

ACCESS支持子查詢

ACCESS支持外連接,但不包括完整外部聯(lián)接,如支持
    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)]));