問:如何讓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)在運行，如果是則關(guān)閉原先的再啟動�！氨印本褪怯眠@種方法的。
這樣做的好處在于方便升級.它會自動用新版本覆蓋舊版本.
方法如下:修改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，編輯其內(nèi)容為:del %0,然后運行它，怎么樣？a.bat把自己刪除掉了�。�！好，我們就用它來進行程序的“自殺”！
找一個EXE可執(zhí)行文件，比如說abc.exe,新建一個批處理文件a.bat，編輯其內(nèi)容為：
: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使用可以用來讀取和修改內(nèi)存數(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; //轉(zhuǎn)換長文件名
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} //設(shè)置程序為非圖形界面
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文件進行一些設(shè)置的保存?
答:其實很簡單,在uses中加入INIFiles然后可以在form的onCreate和onClose兩個事件中寫東西,onCreate是讀出以前寫的內(nèi)容,onClose是寫入更改過的內(nèi)容,下面是一個例子:
放一個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文件中的設(shè)置
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);為關(guān)閉
//如果需要要自己的程序中使程序動態(tài)變最大化則用
form1.windowstate:=wsmaximized; //form1為你要最大化的窗口名！
//幾個要用到的名詞:
1.hwnd是句柄的意思,只有先得到了窗體的句柄才能控制它
2.findwindow是找窗體的意思
3.nil是空指針的意思
4.postmessage發(fā)送一條消息給一個已找到的窗口句柄.
問:如何使程序在執(zhí)行過程中暫停一段時間?
答:要使在運行中的程序暫停一段時間可以使用sleep這個關(guān)鍵詞,下面是一個例子
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文件調(diào)用到窗口上例子如下:
procedure TForm1.FormCreate(Sender: TObject);
var
URL: OleVariant;
begin
URL := ExtractFilePath(Application.EXEName) + 'fla.htm';
Webbrowser1.Navigate2(URL);
end;
//要添加一下webbrowser控件
問:怎樣才能在程序中實現(xiàn)跳轉(zhuǎ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
問:如何關(guān)閉windows?
答:這個可以關(guān)閉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ā)消息關(guān)閉程序
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
其內(nèi)容是
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,設(shè)置其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范圍之內(nèi)，對DLL來講其值必需在0xC000 - 0xFFFF 范圍之內(nèi)，在同一進程內(nèi)該值必須唯一
參數(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 :='' 表示一直到結(jié)束
HttpCli.ContentRangeEnd :='200' 表示到200字節(jié)處結(jié)束
如果使用 TNMHTTP 控件
在OnAboutToSend事件，寫：
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-' 表示從100字節(jié)處開始下載到最后
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-200' 表示從100字節(jié)處開始下載到200字節(jié)處結(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)代碼重用
面向?qū)ο蟮木幊坦ぞ叩奶攸c之一就是要提高代碼重用性(Reuse)，作為新一代可視化開發(fā)工具，Delphi中的代碼重用性相當高。我們知道，在Delphi中，大部分程序代碼都直接或間接地對應著一個事件，此程序稱為事件處理句柄，它實際上就是一個過程。從應用程序的工程到表單、構(gòu)件和程序，Delphi強調(diào)的是其開發(fā)過程中每一層次的重用性，可以通過編寫某些構(gòu)件常用的事件處理句柄來達到程序重用目的。你可以在屬性窗口的Events頁上將A事件的處理句柄指向B事件的處理句柄，這樣A事件和B事件就共享了一個過程段，從而達到了重用的目的。如果共享的程序段與發(fā)生該事件的控件無關(guān)，如ShowMessage(′hello,world′)，那這種共享是最簡單的。但一般來說，代碼段間的共享都跟發(fā)生該事件的控件有關(guān)，需要根據(jù)控件類型做出相應的處理，這時就要用到Sender參數(shù)。
每個過程段的開頭都類似procedure TForm1FormClick(Sender:TObject)；其中的Sender是一個TObject類型的參數(shù)，它告訴Delphi哪個控件接收這個事件并調(diào)用相應的處理過程。你可以編寫一個單一的事件處理句柄，通過Sender參數(shù)和IF…THEN…語句或者CASE語句配合，來處理多個構(gòu)件。發(fā)生事件的構(gòu)件或控件的值已經(jīng)賦給了Sender參數(shù)，該參數(shù)的用途之一就在于：可以使用保留字IS來測試Sender，以便找到調(diào)用這個事件處理句柄的構(gòu)件或控件的類型。例如，將表單中編輯框和標簽的Click事件的處理句柄都指向表單的xxx過程，編輯框和標簽對Click事件有不同的反應：
procedure TForm1xxx(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ù)的第二個用途是結(jié)合AS操作符進行類型轉(zhuǎn)換，將若干個派生于某一父類的子類強制轉(zhuǎn)換成該父類。例如表單中有一個TEdit類控件和一個TMemo控件，它們實際上都派生于TcustomEdit類，如果你要為二者的某一事件提供同樣處理，可以將二者事件句柄都指向自定義的過程yyy:
Procedure TForm1.yyy(Sender:TObject);
begin
(sender as TcustomEdit).text:=′This is some demo text′;
end;
在過程中，AS操作符將TEdit類和TMemo類均強制轉(zhuǎn)換成TcustomEdit類，再對TcustomEdit類的屬性賦值。注意這種轉(zhuǎn)換必須符合Delphi中類的層次關(guān)系。
使用Sender參數(shù)可以通過單一過程段處理多類控件，真正體現(xiàn)了Delphi面向?qū)ο蟮闹赜眯浴?/P>
*****************************
窗口漸漸出現(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)));
版權(quán)： String(PChar(Ptr($FE091)));
日期： String(PChar(Ptr($FFFF5)));
序列號： String(PChar(Ptr($FEC71)));
***********************
在20000下關(guān)機
在20000下關(guān)機不象在98下直接調(diào)用ExitWindows函數(shù)就成，你首先要用OpenProcessToken函數(shù)打開與進程相關(guān)的訪問信令然后再使用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) ; //關(guān)機
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);
*****************************
彈出、關(guān)閉光驅(qū)
uses中加MMSYSTEM
彈出光驅(qū)
mciSendString('Set cdaudio door open wait', nil, 0, handle);
關(guān)閉光驅(qū)
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
*******************************
防止對話框ALT+F4關(guān)閉
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;
*********************************
調(diào)用Windows內(nèi)核
對程序員而言，有一句至理名言就是：“寫得好就是寫得少！(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" - 打開"關(guān)于"窗口
"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" - 設(shè)置鼠標位置為(0,0)
"rundll32 user,wnetconnectdialog" - 打開"映射網(wǎng)絡(luò)驅(qū)動器"窗口
"rundll32 user,wnetdisconnectdialog" - 打開"斷開網(wǎng)絡(luò)驅(qū)動器"窗口
"rundll32 user,disableoemlayer" - 顯示BSOD窗口, (BSOD) = Blue Screen Of Death, 即藍屏
"rundll32 diskcopy,DiskCopyRunDll" - 打開磁盤復制窗口
"rundll32 rnaui.dll,RnaWizard" - 運行"Internet連接向?qū)?, 如果加上參數(shù)"/1"則為silent模式
"rundll32 shell32,SHFormatDrive" - 打開"格式化磁盤(A)"窗口
"rundll32 shell32,SHExitWindowsEx -1" - 冷啟動Windows Explorer
"rundll32 shell32,SHExitWindowsEx 1" - 關(guān)機
"rundll32 shell32,SHExitWindowsEx 0" - 退當前用戶
"rundll32 shell32,SHExitWindowsEx 2" Windows9x 快速重啟
"rundll32 krnl386.exe,exitkernel" - 強行退出Windows 9x(無確認)
"rundll rnaui.dll,RnaDial "MyConnect" - 運行"網(wǎng)絡(luò)連接"對話框
"rundll32 msprint2.dll,RUNDLL_PrintTestPage" - 選擇打印機和打印測試頁
"rundll32 user,setcaretblinktime" - 設(shè)置光標閃爍速度
"rundll32 user, setdoubleclicktime" - 測試鼠標雙擊速度
"rundll32 sysdm.cpl,InstallDevice_Rundll" - 搜索非PnP設(shè)備
***********************************
messagebeep(0);//聲卡發(fā)出be聲
windows.beep(2000,2000);//pc喇叭發(fā)出be聲，很嚇人//前一個是頻率，后一個是延時，98下會忽略
*******************************************************
得到可用內(nèi)存和系統(tǒng)資源
procedure Tversion.FormCreate(Sender: TObject);
var
MS: TMemoryStatus;
begin
GlobalMemoryStatus(MS);
label5.Caption := '可用內(nèi)存：'+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ū)域內(nèi)，最好鎖在你的窗口里}
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
轉(zhuǎn)載請保持文章完整并標明出處
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 聲明.
字段名為關(guān)鍵字的字段用方括號[]括起來,數(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關(guān)鍵字后.
上例中如果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為關(guān)聯(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)]));
|
