如何讓del+CTRL+ALT看不見程序運行

問:如何讓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,[url]http://Lovejingtao.126.com[/url],[email]Lovejingtao@21cn.com[/email]}

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.

補充：一、上面的批處理的 del %0等同於 del a.bat，用del a.bat則批處理文件必須爲a.bat,用del %0則能夠隨意。

二、全部程序在Pwin98+Delphi五、Win2000+Delphi5下運行經過。

本文的標題爲《安裝與卸載之卸載篇》，下次將介紹如何用Delphi製做本身的安裝程序。記得有一位著名的***說過：我歷來不去找什麼工具軟件，須要的話就本身寫一個。若是咱們也持這種態度，則編程水平必定會愈來愈高。

問:如何獲得*******中的密碼?

答:這裏有一個例子:

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

//password_dos.dpr，陳經韜做品

//http://lovejingtao.126.com

[email]lovejingtao@21cn.com[/email] | ');

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.

完整源代碼 [url]http://www.aidelphi.com/6to23/docu/hotkey.zip[/url]

如下是例子

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

p_w_picpath1.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: [url]http://tb.blog.csdn.net/TrackBack.aspx?PostId=255482[/url]