Delphi技巧集

<摘自網絡>

◇[DELPHI]網絡鄰居複製文件
uses shellapi;
copyfile(pchar('newfile.txt'),pchar('//computername/direction/targer.txt'),false);

◇[DELPHI]產生鼠標拖動效果
通過MouseMove事件、DragOver事件、EndDrag事件實現，例如在PANEL上的LABEL：
var xpanel,ypanel,xlabel,ylabel:integer;
PANEL的MouseMove事件：xpanel:=x;ypanel:=y;
PANEL的DragOver事件：xpanel:=x;ypanel:=y;
LABEL的MouseMove事件：xlabel:=x;ylabel:=y;
LABEL的EndDrag事件：label.left:=xpanel-xlabel;label.top:=ypanel-ylabel;

◇[DELPHI]取得WINDOWS目錄
uses shellapi;
var windir:array[0..255] of char;
getwindowsdirectory(windir,sizeof(windir));
或者從註冊表中讀取，位置：
HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersion
SystemRoot鍵，取得如：C:/WINDOWS

◇[DELPHI]在FORM或其他容器上畫線
var x,y:array [0..50] of integer;
canvas.pen.color:=clred;
canvas.pen.style:=psDash;
form1.canvas.moveto(trunc(x[i]),trunc(y[i]));
form1.canvas.lineto(trunc(x[j]),trunc(y[j]));

◇[DELPHI]字符串列表使用
var tips:tstringlist;
tips:=tstringlist.create;
tips.loadfromfile('filename.txt');
edit1.text:=tips[0];
tips.add('last line addition string');
tips.insert(1,'insert string at NO 2 line');
tips.savetofile('newfile.txt');
tips.free;

◇[DELPHI]簡單的剪貼板操作
richedit1.selectall;
richedit1.copytoclipboard;
richedit1.cuttoclipboard;
edit1.pastefromclipboard;

◇[DELPHI]關於文件、目錄操作
Chdir('c:/abcdir');轉到目錄
Mkdir('dirname');建立目錄
Rmdir('dirname');刪除目錄
GetCurrentDir;//取當前目錄名，無'/'
Getdir(0,s);//取工作目錄名s:='c:/abcdir';
Deletfile('abc.txt');//刪除文件
Renamefile('old.txt','new.txt');//文件更名
ExtractFilename(filelistbox1.filename);//取文件名
ExtractFileExt(filelistbox1.filename);//取文件後綴

◇[DELPHI]處理文件屬性
attr:=filegetattr(filelistbox1.filename);
if (attr and faReadonly)=faReadonly then ... //只讀
if (attr and faSysfile)=faSysfile then ... //系統
if (attr and faArchive)=faArchive then ... //存檔
if (attr and faHidden)=faHidden then ... //隱藏

◇[DELPHI]執行程序外文件
WINEXEC//調用可執行文件
winexec('command.com /c copy *.* c:/',SW_Normal);
winexec('start abc.txt');
ShellExecute或ShellExecuteEx//啓動文件關聯程序
function executefile(const filename,params,defaultDir:string;showCmd:integer):THandle;
ExecuteFile('C:/abc/a.txt','x.abc','c:/abc/',0);
ExecuteFile('http://tingweb.yeah.net','','',0);
ExecuteFile('mailto:[email protected]','','',0);

◇[DELPHI]取得系統運行的進程名
var hCurrentWindow:HWnd;szText:array[0..254] of char;
begin
hCurrentWindow:=Getwindow(handle,GW_HWndFrist);
while hCurrentWindow <> 0 do
begin
if Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext));
hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);
end;
end;

◇[DELPHI]關於彙編的嵌入
Asm End;
可以任意修改EAX、ECX、EDX；不能修改ESI、EDI、ESP、EBP、EBX。

◇[DELPHI]關於類型轉換函數
FloatToStr//浮點轉字符串
FloatToStrF//帶格式的浮點轉字符串
IntToHex//整數轉16進制
TimeToStr
DateToStr
DateTimeToStr
FmtStr//按指定格式輸出字符串
FormatDateTime('YYYY-MM-DD,hh-mm-ss',DATE);

◇[DELPHI]字符串的過程和函數
Insert(obj,target,pos);//字符串target插入在pos的位置。如插入結果大於target最大長度，多出字符將被截掉。如Pos在255以外，會產生運行錯。例如，st:='Brian'，則Insert（'OK',st,2）會使st變爲'BrOKian'。
Delete(st,pos,Num);//從st串中的pos（整型）位置開始刪去個數爲Num（整型）個字符的子字串。例如，st:='Brian'，則Delete(st,3,2)將變爲Brn。
Str(value,st);//將數值value（整型或實型）轉換成字符串放在st中。例如，a=2.5E4時，則str(a:10,st)將使st的值爲' 25000'。
Val(st,var,code);//把字符串表達式st轉換爲對應整型或實型數值，存放在var中。St必須是一個表示數值的字符串，並符合數值常數的規則。在轉換過程中，如果沒有檢測出錯誤，變量code置爲0，否則置爲第一個出錯字符的位置。例如，st:=25.4E3,x是一個實型變量，則val(st,x,code)將使X值爲25400，code值爲0。
Copy(st.pos.num);//返回st串中一個位置pos（整型）處開始的，含有num（整型）個字符的子串。如果pos大於st字符串的長度，那就會返回一個空串，如果pos在255以外，會引起運行錯誤。例如，st:='Brian'，則Copy(st,2,2)返回'ri'。
Concat(st1,st2,st3……,stn);//把所有自變量表示出的字符串按所給出的順序連接起來，並返回連接後的值。如果結果的長度255，將產生運行錯誤。例如，st1:='Brian',st2:=' ',st3:='Wilfred'，則Concat(st1,st2,st3)返回'Brian Wilfred'。
Length(st);//返回字符串表達式st的長度。例如，st:='Brian'，則Length(st)返回值爲5。
Pos(obj,target);//返回字符串obj在目標字符串target的第一次出現的位置，如果target沒有匹配的串，Pos函數的返回值爲0。例如，target:='Brian Wilfred'，則Pos('Wil',target)的返回值是7，Pos('hurbet',target)的返回值是0。

◇[DELPHI]關於處理註冊表
uses Registry;
var reg:Tregistry;
reg:=Tregistry.create;
reg.rootkey:='HKey_Current_User';
reg.openkey('Control Panel/Desktop',false);
reg.WriteString('Title Wallpaper','0');
reg.writeString('Wallpaper',filelistbox1.filename);
reg.closereg;
reg.free;

◇[DELPHI]關於鍵盤常量名
VK_BACK/VK_TAB/VK_RETURN/VK_SHIFT/VK_CONTROL/VK_MENU/VK_PAUSE/VK_ESCAPE
/VK_SPACE/VK_LEFT/VK_RIGHT/VK_UP/VK_DOWN
F1--F12：$70(112)--$7B(123)
A-Z：$41(65)--$5A(90)
0-9：$30(48)--$39(57)
◇[DELPHI]初步判斷程序母語
DELPHI軟件的DOS提示：This Program Must Be Run Under Win32.
VC++軟件的DOS提示：This Program Cannot Be Run In DOS Mode.

◇[DELPHI]操作Cookie
response.cookies("name").domain:='http://www.086net.com';
with response.cookies.add do
begin
name:='username';
value:='username';
end

◇[DELPHI]增加到文檔菜單連接
uses shellapi,shlOBJ;
shAddToRecentDocs(shArd_path,pchar(filepath));//增加連接
shAddToRecentDocs(shArd_path,nil);//清空

◇[雜類]備份智能ABC輸入法詞庫
windows/system/user.rem
windows/system/tmmr.rem

◇[DELPHI]判斷鼠標按鍵
if GetAsyncKeyState(VK_LButton)<>0 then ... //左鍵
if GetAsyncKeyState(VK_MButton)<>0 then ... //中鍵
if GetAsyncKeyState(VK_RButton)<>0 then ... //右鍵

◇[DELPHI]設置窗體的最大顯示
onFormCreate事件
self.width:=screen.width;
self.height:=screen.height;

◇[DELPHI]按鍵接受消息
OnCreate事件中處理：Application.OnMessage:=MyOnMessage;
procedure TForm1.MyOnMessage(var MSG:TMSG;var Handle:Boolean);
begin
if msg.message=256 then ... //ANY鍵
if msg.message=112 then ... //F1
if msg.message=113 then ... //F2
end;

◇[雜類]隱藏共享文件夾
共享效果：可訪問，但不可見（在資源管理、網絡鄰居中）
取共享名爲：direction$
訪問：//computer/dirction/

◇[Java Script]Java Script網頁常用效果
網頁60秒定時關閉
<script language="java script"><!--
settimeout('window.close();',60000)
--></script>
關閉窗口
<a href="/" οnclick="javascript:window.close();return false;">關閉</a>
定時轉URL
<meta http-equiv="refresh" content="40;url=http://www.086net.com">
設爲首頁
<a οnclick="this.style.behavior='url(#default#homepage)';this.sethomepage('http://086net.com');"href="#">設爲首頁</a>
收藏本站
<a href="javascript:window.external.addfavorite('http://086net.com','[未名碼頭]')">收藏本站</a>
加入頻道
<a href="javascript:window.external.addchannel('http://086net.com')">加入頻道</a>

◇[DELPHI]文本編輯相關
checkbox1.checked:=not checkbox1.checked;
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsBold] else richedit1.font.style:=richedit1.font.style-[fsBold]//粗體
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsItalic] else richedit1.font.style:=richedit1.font.style-[fsItalic]//斜體
if checkbox1.checked then richedit1.font.style:=richedit1.font.style+[fsUnderline] else richedit1.font.style:=richedit1.font.style-[fsUnderline]//下劃線
memo1.alignment:=taLeftJustify;//居左
memo1.alignment:=taRightJustify;//居右
memo1.alignment:=taCenter;//居中

◇[DELPHI]隨機產生文本色
randomize;//隨機種子
memo1.font.color:=rgb(random(255),random(255),random(255));

◇[DELPHI]DELPHI5 UPDATE升級補丁序列號
1000003185
90X25fx0

◇[DELPHI]文件名的非法字符過濾
for i:=1 to length(s) do
if s[i] in ['/','/',':','*','?','<','>','|'] then

◇[DELPHI]轉換函數的定義及說明
datetimetofiledate (datetime:Tdatetime):longint; 將Tdatetime格式的日期時間值轉換成DOS格式的日期時間值
datetimetostr (datetime:Tdatetime):string; 將Tdatatime格式變量轉換成字符串，如果datetime參數不包含日期值，返回字符串日期顯示成爲00/00/00，如果datetime參數中沒有時間值，返回字符串中的時間部分顯示成爲00：00：00 AM
datetimetostring (var result string;
const format:string;
datetime:Tdatetime); 根據給定的格式字符串轉換時間和日期值，result爲結果字符串，format爲轉換格式字符串，datetime爲日期時間值
datetostr (date:Tdatetime) 使用shortdateformat全局變量定義的格式字符串將date參數轉換成對應的字符串
floattodecimal (var result:Tfloatrec;value:
extended;precision,decimals:
integer); 將浮點數轉換成十進制表示
floattostr (value:extended):string 將浮點數value轉換成字符串格式，該轉換使用普通數字格式，轉換的有效位數爲15位。
floattotext (buffer:pchar;value:extended;
format:Tfloatformat;precision,
digits:integer):integer; 用給定的格式、精度和小數將浮點值value轉換成十進制表示形式，轉換結果存放於buffer參數中，函數返回值爲存儲到buffer中的字符位數，buffer是非0結果的字符串緩衝區。
floattotextfmt (buffer:pchar;value:extended;
format:pchar):integer 用給定的格式將浮點值value轉換成十進制表示形式，轉換結果存放於buffer參數中，函數返回值爲存儲到buffer中的字符位數。
inttohex (value:longint;digits:integer):
string; 將給定的數值value轉換成十六進制的字符串。參數digits給出轉換結果字符串包含的數字位數。
inttostr (value:longint):string 將整數轉換成十進制形式字符串
strtodate (const S:string):Tdatetime 將字符串轉換成日期值，S必須包含一個合法的格式日期的字符串。
strtodatetime (const S:string):Tdatetime 將字符串S轉換成日期時間格式，S必須具有MM/DD/YY HH：MM：SS[AM|PM]格式，其中日期和時間分隔符與系統時期時間常量設置相關。如果沒有指定AM或PM信息，表示使用24小時制。
strtofloat (const S:string):extended; 將給定的字符串轉換成浮點數，字符串具有如下格式：
[+|-]nnn…[.]nnn…[<+|-><E|e><+|->nnnn]
strtoint (const S:string):longint 將數字字符串轉換成整數，字符串可以是十進制或十六進制格式，如果字符串不是一個合法的數字字符串，系統發生ECONVERTERROR異常
strtointdef (const S:string;default:
longint):longint; 將字符串S轉換成數字，如果不能將S轉換成數字，strtointdef函數返回參數default的值。
strtotime (const S:string):Tdatetime 將字符串S轉換成TDATETIME值，S具有HH：MM：SS[AM|PM]格式，實際的格式與系統的時間相關的全局變量有關。
timetostr (time:Tdatetime):string; 將參數TIME轉換成字符串。轉換結果字符串的格式與系統的時間相關常量的設置有關。

◇[DELPHI]程序不出現在ALT+CTRL+DEL
在implementation後添加聲明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隱藏
RegisterServiceProcess(GetCurrentProcessID, 0);//顯示
用ALT+DEL+CTRL看不見

◇[DELPHI]程序不出現在任務欄
uses windows
var
ExtendedStyle : Integer;
begin
Application.Initialize;
//==============================================================
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW
AND NOT WS_EX_APPWINDOW);
//===============================================================
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

◇[DELPHI]如何判斷撥號網絡是開還是關
if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then
showmessage('在線!')
else showmessage('不在線!');

◇[DELPHI]實現IP到域名的轉換
function GetDomainName(Ip:string):string;
var
pH:PHostent;
data:twsadata;
ii:dword;
begin
WSAStartup($101, Data);
ii:=inet_addr(pchar(ip));
pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET);
if (ph<>nil) then
result:=pH.h_name
else
result:='';
WSACleanup;
end;

◇[DELPHI]處理“右鍵菜單”方法
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey:=HKEY_CLASSES_ROOT;
reg.OpenKey('*/shell/check/command', true);
reg.WriteString('', '"' + application.ExeName + '" "%1"');
reg.CloseKey;
reg.OpenKey('*/shell/diary', false);
reg.WriteString('', '操作(&C)');
reg.CloseKey;
reg.Free;
showmessage('DONE!');
end;

◇[DELPHI]發送虛擬鍵值ctrl V
procedure sendpaste;
begin
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), 0, 0);
keybd_event(ord('V'), MapVirtualKey(ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;

◇[DELPHI]當前的光驅的盤符
procedure getcdrom(var cd:char);
var
str:string;
drivers:integer;
driver:char;
i,temp:integer;
begin
drivers:=getlogicaldrives;
temp:=(1 and drivers);
for i:=0 to 26 do
begin
if temp=1 then
begin
driver:=char(i+integer('a'));
str:=driver+':';
if getdrivetype(pchar(str))=drive_cdrom then
begin
cd:=driver;
exit;
end;
end;
drivers:=(drivers shr 1);
temp:=(1 and drivers);
end;
end;

◇[DELPHI]字符的加密與解密
function cryptstr(const s:string; stype: dword):string;
var
i: integer;
fkey: integer;
begin
result:='';
case stype of
0: setpass;
begin
randomize;
fkey := random($ff);
for i:=1 to length(s) do
result := result+chr( ord(s[i]) xor i xor fkey);
result := result + char(fkey);
end;
1: getpass
begin
fkey := ord(s[length(s)]);
for i:=1 to length(s) - 1 do
result := result+chr( ord(s[i]) xor i xor fkey);
end;
end;

□◇[DELPHI]向其他應用程序發送模擬鍵
var
h: THandle;
begin
h := FindWindow(nil, '應用程序標題');
PostMessage(h, WM_KEYDOWN, VK_F9, 0);//發送F9鍵
end;

□◇[DELPHI]DELPHI 支持的DAO數據格式
td.Fields.Append(td.CreateField ('dbBoolean',dbBoolean,0));
td.Fields.Append(td.CreateField ('dbByte',dbByte,0));
td.Fields.Append(td.CreateField ('dbInteger',dbInteger,0));
td.Fields.Append(td.CreateField ('dbLong',dbLong,0));
td.Fields.Append(td.CreateField ('dbCurrency',dbCurrency,0));
td.Fields.Append(td.CreateField ('dbSingle',dbSingle,0));
td.Fields.Append(td.CreateField ('dbDouble',dbDouble,0));
td.Fields.Append(td.CreateField ('dbDate',dbDate,0));
td.Fields.Append(td.CreateField ('dbBinary',dbBinary,0));
td.Fields.Append(td.CreateField ('dbText',dbText,0));
td.Fields.Append(td.CreateField ('dbLongBinary',dbLongBinary,0));
td.Fields.Append(td.CreateField ('dbMemo',dbMemo,0));
td.Fields['ID'].Set_Attributes(dbAutoIncrField);//自增字段

□◇[DELPHI]DELPHI配置MS SQL 7和BDE步驟
第一步，配置ODBC：
先在ODBC 中設數據源，安裝過SQL Server7.0 後,ODBC中有一項"系統DSN"應該有兩項
數據源，一個是MQIS，一個是LocalSever，任選一個選後點擊配置按鈕，不知你的SQL7.0
是不是安裝在本地機器上，如果是的話直接進行下一步，如果不是，在服務器一欄中填上
Server,然後進行下一步，填寫登錄ID 和密碼（登錄ID，和密碼是在SQL7.0中的用戶選項
中設的）。
第二步，配置BDE:
打開Delphi的BDE，然後點擊MQIS 或 LocalServer，就會提示用戶名和密碼，這和
ODBC的用戶名和密碼是一樣的，填上就行了。
第三步，配置程序：
如果用的是TTable，就在TTable的DatabaseName中選擇MQIS 或LocalServer,然後在
TableName中選擇Sale就行了，然後將Active改爲True,Delphi彈出提示對話，填入用戶
名和密碼。
如果用的是TQuery,在TQuery上點擊右鍵，再擊"SQL Builder"，這是以界面方式配置
SQL語句，或者在TQuery的SQL中填入SQL語句。最後，別忘了將Active改爲True。
在運行也可能配置TQuery,具體見Delphi幫助。

□◇[DELPHI]得到圖像上某一點的RGB值
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
red,green,blue:byte ;
i:integer;
begin
i:= image1.Canvas.Pixels[x,y];
Blue:= GetBValue(i);
Green:= GetGValue(i):
Red:= GetRValue(i);
Label1.Caption:=inttostr(Red);
Label2.Caption:=inttostr(Green);
Label3.Caption:=inttostr(Blue);
end;

□◇[DELPHI]關於日期格式分解轉換
var year,month,day:word;now2:Tdatatime;
now2:=date();
decodedate(now2,year,month,day);
lable1.Text :=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日';

◇[DELPHI]如何判斷當前網絡連接方式
判斷結果是MODEM、局域網或是代理服務器方式。
uses wininet;
Function ConnectionKind :boolean;
var flags: dword;
begin
Result := InternetGetConnectedState(@flags, 0);
if Result then
begin
if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then
begin
showmessage('Modem');
end;
if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
begin
showmessage('LAN');
end;
if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then
begin
showmessage('Proxy');
end;
if (flags and INTERNET_CONNECTION_MODEM_BUSY)=INTERNET_CONNECTION_MODEM_BUSY then
begin
showmessage('Modem Busy');
end;
end;
end;

◇[DELPHI]如何判斷字符串是否是有效EMAIL地址
function IsEMail(EMail: String): Boolean;
var s: String;ETpos: Integer;
begin
ETpos:= pos('@', EMail);
if ETpos > 1 then
begin
s:= copy(EMail,ETpos+1,Length(EMail));
if (pos('.', s) > 1) and (pos('.', s) < length(s)) then
Result:= true else Result:= false;
end
else
Result:= false;
end;

◇[DELPHI]判斷系統是否連接INTERNET
需要引入URL.DLL中的InetIsOffline函數。
函數申明爲：
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';
然後就可以調用函數判斷系統是否連接到INTERNET
if InetIsOffline(0) then ShowMessage('not connected!')
else ShowMessage('connected!');
該函數返回TRUE如果本地系統沒有連接到INTERNET。
附：
大多數裝有IE或OFFICE97的系統都有此DLL可供調用。
InetIsOffline
BOOL InetIsOffline(
DWORD dwFlags,
);

◇[DELPHI]簡單地播放和暫停WAV文件
uses mmsystem;

function PlayWav(const FileName: string): Boolean;
begin
Result := PlaySound(PChar(FileName), 0, SND_ASYNC);
end;

procedure StopWav;
var
buffer: array[0..2] of char;
begin
buffer[0] := #0;
PlaySound(Buffer, 0, SND_PURGE);
end;

◇[DELPHI]取機器BIOS信息
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;

◇[DELPHI]網絡下載文件
uses UrlMon;

function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result := False;
end;
end;

if DownloadFile('http://www.borland.com/delphi6.zip, 'c:/kylix.zip') then
ShowMessage('Download succesful')
else ShowMessage('Download unsuccesful')

◇[DELPHI]解析服務器IP地址
uses winsock

function IPAddrToName(IPAddr : String): String;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then result:=StrPas(Hostent^.h_name) else result:='';
end;

◇[DELPHI]取得快捷方式中的連接
function ExeFromLink(const linkname: string): string;
var
FDir,
FName,
ExeName: PChar;
z: integer;
begin
ExeName:= StrAlloc(MAX_PATH);
FName:= StrAlloc(MAX_PATH);
FDir:= StrAlloc(MAX_PATH);
StrPCopy(FName, ExtractFileName(linkname));
StrPCopy(FDir, ExtractFilePath(linkname));
z:= FindExecutable(FName, FDir, ExeName);
if z > 32 then
Result:= StrPas(ExeName)
else
Result:= '';
StrDispose(FDir);
StrDispose(FName);
StrDispose(ExeName);
end;

◇[DELPHI]控制TCombobox的自動完成
{'Sorted' property of the TCombobox to true }
var lastKey: Word; //全局變量
//TCombobox的OnChange事件
procedure TForm1.AutoCompleteChange(Sender: TObject);
var
SearchStr: string;
retVal: integer;
begin
SearchStr := (Sender as TCombobox).Text;
if lastKey <> VK_BACK then // backspace: VK_BACK or $08
begin
retVal := (Sender as TCombobox).Perform(CB_FINDSTRING, -1, LongInt(PChar(SearchStr)));
if retVal > CB_Err then
begin
(Sender as TCombobox).ItemIndex := retVal;
(Sender as TCombobox).SelStart := Length(SearchStr);
(Sender as TCombobox).SelLength :=
(Length((Sender as TCombobox).Text) - Length(SearchStr));
end; // retVal > CB_Err
end; // lastKey <> VK_BACK
lastKey := 0; // reset lastKey
end;
//TCombobox的OnKeyDown事件
procedure TForm1.AutoCompleteKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
lastKey := Key;
end;

◇[DELPHI]如何清空一個目錄
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;

◇[DELPHI]如何計算一個目錄的大小
function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '/*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;

◇[DELPHI]安裝程序如何添加到Uninstall列表
操作註冊表，如下：
1.在HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall鍵下建立一個主鍵，名稱任意。
例HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/MyUninstall
2.在HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Uninstall/MyUnistall下鍵兩個串值，
這兩個串值的名稱是特定的：DisplayName和UninstallString。
3.給串DisplayName賦值爲顯示在“刪除應用程序列表”中的名稱，如'Aiming Uninstall one';
給串UninstallString賦值爲執行的刪除命令，如 C:/WIN97/uninst.exe -f"C:/TestPro/aimTest.isu"

◇[DELPHI]截獲WM_QUERYENDSESSION關機消息
type
TForm1 = class(TForm)
procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;
procedure CMEraseBkgnd(var Message:TWMEraseBkgnd);Message WM_ERASEBKGND;
private
{ Private declarations }
public
{ Public declarations }
end;

procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
Showmessage('computer is about to shut down');
end;

◇[DELPHI]獲取網上鄰居
procedure getnethood();//NT做服務器，WIN98上調試通過。
var
a,i:integer;
errcode:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries:dword;
buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
alldomain:tstrings;
begin //listcomputer is a listview to list all computers;controlcenter is a form.
alldomain:=tstringlist.Create ;
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_DOMAIN;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=nil;
lpcomment :=nil;
lpprovider :=nil;
end; // 獲取所有的域
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then begin
enumentries:=1024;
buffersize:=sizeof(netres);
errcode:=wnetenumresource(enumhandle,enumentries,@netres[0],buffersize);
end;
a:=0;
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
alldomain.Add (netres[a].lpremotename);
a:=a+1;
end;
wnetcloseenum(enumhandle);
// 獲取所有的計算機
mylistitems :=controlcenter.lstcomputer.Items ;
mylistitems.Clear ;
for i:=0 to alldomain.Count-1 do
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_ANY;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SERVER;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(alldomain[i]);
lpcomment :=nil;
lpprovider :=nil;
end;
ErrCode:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,@netres[0],EnumHandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
a:=0;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
mylistitem :=mylistitems.Add ;
mylistitem.ImageIndex :=0;
mylistitem.Caption :=uppercase(stringreplace(string(NetRes[a].lpremotename),'//','',[rfReplaceAll]));
a:=a+1;
end;
wnetcloseenum(enumhandle);
end;
end;

◇[DELPHI]獲取某一計算機上的共享目錄
procedure getsharefolder(const computername:string);
var
errcode,a:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries,buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
mystrings:tstringlist;
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_DISK;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SHARE;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(computername);
lpcomment :=nil;
lpprovider :=nil;
end; // 獲取根結點
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
wnetcloseenum(enumhandle);
a:=0;
mylistitems:=controlcenter.lstfile.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>'') and (errcode=NO_ERROR) do
begin
with mylistitems do
begin
mylistitem:=add;
mylistitem.ImageIndex :=4;
mylistitem.Caption :=extractfilename(netres[a].lpremotename);
end;
a:=a+1;
end;
end;

◇[DELPHI]得到硬盤序列號
var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char;
begin
if GetVolumeInformation('c:/', Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption := IntToStr(SerialNum^);
end;

◇[DELPHI]MEMO的自動翻頁
Procedure ScrollMemo(Memo : TMemo; Direction : char);
begin
case direction of
'd': begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEDOWN, { Scroll Command }
0) { Not Used }
end;

'u' : begin
SendMessage(Memo.Handle, { HWND of the Memo Control }
WM_VSCROLL, { Windows Message }
SB_PAGEUP, { Scroll Command }
0); { Not Used }
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'d'); //上翻頁
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ScrollMemo(Memo1,'u'); //下翻頁
end;

◇[DELPHI]DBGrid中回車到下個位置(Tab鍵)
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if DBGrid1.Columns.Grid.SelectedIndex < DBGrid1.Columns.Count - 1 then
DBGrid1.Columns[DBGrid1.Columns.grid.SelectedIndex + 1].Field.FocusControl
else
begin
Table1.next;
DBGrid1.Columns[0].field.FocusControl;
end;
end;

◇[DELPHI]如何安裝控件
安裝方法：
1.對於單個控件，Component-->install component..-->PAS或DCU文件-->install
2.對於帶*.dpk文件的控件包，File-->open(下拉列表框中選*.dpk)-->install即可.
3.對於帶*.dpl文件的控件包，Install Packages-->Add-->dpl文件名即可。
4.如果以上Install按鈕爲失效的話，試試Compile按鈕。
5.是run time lib則在option下的packages下的runtimepackes加之.
如果編譯時提示文件找不到的話，一般是控件的安裝目錄不在delphi的Lib目錄中，有兩種方法可以解決：
1.把安裝的原文件拷入到delphi的Lib目錄下。
2.或者Tools-->Environment Options中把控件原代碼路徑加入到Delphi的Lib目錄中即可。

◇[DELPHI]目錄完全刪除（deltree）
procedure TForm1.DeleteDirectory(strDir:String);
var
sr: TSearchRec;
FileAttrs: Integer;
strfilename:string;
strPth:string;
begin
strpth:=Getcurrentdir();
FileAttrs := faAnyFile;
if FindFirst(strpth+'/'+strdir+'/*.*', FileAttrs, sr) = 0 then
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.Name;
if fileexists(strpth+'/'+strdir+'/'+strfilename) then
deletefile(strpth+'/'+strdir+'/'+strfilename);
end;
while FindNext(sr) = 0 do
begin
if (sr.Attr and FileAttrs) = sr.Attr then
begin
strfilename:=sr.name;
if fileexists(strpth+'/'+strdir+'/'+strfilename) then
deletefile(strpth+'/'+strdir+'/'+strfilename);
end;
end;
FindClose(sr);
removedir(strpth+'/'+strdir);
end;
end;

◇[DELPHI]取得TMemo 控件當前光標的行和列信息到Tpoint中
1.function ReadCursorPos(SourceMemo: TMemo): TPoint;
var Point: TPoint;
begin
　point.y := SendMessage(SourceMemo.Handle,EM_LINEFROMCHAR,SourceMemo.SelStart,0);
　point.x := SourceMemo.SelStart-SendMessage(SourceMemo.Handle,EM_LINEINDEX,point.y,0);
　Result := Point;
end;
2.LineLength：=SendMessage（memol．handle，EM—LINELENGTH，Cpos，0）；//行長

◇[DELPHI]讀硬盤序列號
function GetDiskSerial(DiskChar: Char): string;
var
SerialNum : pdword;
a, b : dword;
Buffer : array [0..255] of char;
begin
result := "";
if GetVolumeInformation(PChar(diskchar+":/"), Buffer, SizeOf(Buffer), SerialNum,
a, b, nil, 0) then
　Result := IntToStr(SerialNum^);
end;

◇[INTERNET]CSS常用綜合技巧
1。P:first-letter { font-size: 300%; float: left }//首字會比普通字體加大三倍。
2。<LINK REL=StyleSheet HREF="basics.css" TITLE="Contemporary">//連接一個外部樣式表
3。嵌入一個樣式表
<STYLE TYPE="text/css" MEDIA=screen>
<!--
@import url(http://www.htmlhelp.com/style.css);//外部導入一個樣式表
@import url(/stylesheets/punk.css);//同上
BODY { background: url(foo.gif) red; color: black }
.punk { color: lime; background: #ff80c0 }//引用見5。
#wdg97 { font-size: larger }//引用見6。
-->
</STYLE>
4。<P STYLE="color: red; font-family: 'New Century Schoolbook', serif"> //內聯樣式
<SPAN STYLE="font-family: Arial">Arial</SPAN>//SPAN接受STYLE、CLASS和ID屬性
<DIV CLASS=note><P>DIV可以包含段落、標題、表格甚至其它部分</P></DIV>
5。<H1 CLASS=punk>CLASS屬性</H1>//定義見3。
6。<P ID=wdg97>ID屬性</P>//定義見3。
7。屬性列表
字體風格：font-style: [normal | italic | oblique];
字體大小：font-size: [xx-small | x-small | small | medium | large | x-large | xx-large | larger | smaller | <長度> | <百分比>]
文本修飾：text-decoration:[ underline || overline || line-through || blink ]
文本轉換：text-transform:[none | capitalize | uppercase | lowercase]
背景顏色：background-color:[<顏色> | transparent]
背景圖象：background-image:[<URLs> | none]
行高：line-height: [normal | <數字> | <長度> | <百分比>]
邊框樣式：border-style: [ none | dotted | dashed | solid | double | groove | ridge | inset | outset ]
漂浮：float: [left | right | none]
8。長度單位
相對單位：
em (em，元素的字體的高度)
ex (x-height，字母 "x" 的高度)
px (像素，相對於屏幕的分辨率)
絕對長度：
in (英寸，1英寸=2.54釐米)
cm (釐米，1釐米=10毫米)
mm (米)
pt (點，1點=1/72英寸)
pc (帕，1帕=12點)

◇[DELPHI]VCL製作簡要步驟
1.創建部件屬性方法事件
（建立庫單元，繼承爲新的類型，添加屬性、方法、事件，註冊部件，建立包文件）
2.消息處理
3.異常處理
4.部件可視

◇[DELPHI]動態連接庫的裝載
靜態裝載：procedure name;external 'lib.dll';
動態裝載：var handle:Thandle;
handle:=loadlibrary('lib.dll');
if handle<>0 then
begin
{dosomething}
freelibrary(handle);
end;

◇[DELPHI]指針變量和地址
var x,y:integer;p:^integer;//指向INTEGER變量的指針
x:=10;//變量賦值
p:=@x;//變量x的地址
y:=p^;//爲Y賦值指針P
@@procedure//返回過程變量的內存地址

◇[DELPHI]判斷字符是漢字的一個字符
ByteType('你好haha嗎',1) = mbLeadByte//是第一個字符
ByteType('你好haha嗎',2) = mbTrailByte//是第二個字符
ByteType('你好haha嗎',5) = mbSingleByte//不是中文字符

◇[DELPHI]memo的定位操作
memo1.lines.delete(0)//刪除第1行
memo1.selstart:=10//定位10字節處

◇[DELPHI]獲得雙字節字符內碼
function getit(s: string): integer;
begin
Result := byte(s[1]) * $100 + byte(s[2]);
end;
使用：getit('計')//$bcc6 即十進制 48326

◇[DELPHI]調用ADD數據存儲過程
存儲過程如下：
create procedure addrecord(
record1 varchar(10)
record2 varchar(20)
)
as
begin
insert into tablename (field1,field2) values(:record1,:record2)
end
執行存儲過程：
EXECUTE procedure addrecord("urrecord1","urrecord2")

◇[DELPHI]將文件存到blob字段中
function blobcontenttostring(const filename: string):string;
begin
with tfilestream.create(filename,fmopenread) do
try
setlength(Result,size);
read(Pointer(Result)^,size);
finally
free;
end;
end;
//保存字段
begin
if (opendialog1.execute) then
begin
sFileName:=OpenDialog1.FileName;
adotable1.edit;
adotable1.fieldbyname('visio').asstring:=Blobcontenttostring(FileName);
adotable1.post;
end;

◇[DELPHI]把文件全部複製到剪貼板
uses shlobj,activex,clipbrd;
procedure Tform1.copytoclipbrd(var FileName:string);
var
FE:TFormatEtc;
Medium: TStgMedium;
dropfiles:PDropFiles;
pFile:PChar;
begin
FE.cfFormat := CF_HDROP;
FE.dwAspect := DVASPECT_CONTENT;
FE.tymed := TYMED_HGLOBAL;
Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, SizeOf(TDropFiles)+length(FileName)+1);
if Medium.hGlobal<>0 then begin
Medium.tymed := TYMED_HGLOBAL;
dropfiles := GlobalLock(Medium.hGlobal);
try
dropfiles^.pfiles := SizeOf(TDropFiles);
dropfiles^.fwide := False;
longint(pFile) := longint(dropfiles)+SizeOf(TDropFiles);
StrPCopy(pFile,FileName);
Inc(pFile, Length(FileName)+1);
pFile^ := #0;
finally
GlobalUnlock(Medium.hGlobal);
end;
Clipboard.SetAsHandle(CF_HDROP,Medium.hGlobal);
end;
end;

◇[DELPHI]列舉當前系統運行進程
uses TLHelp32;
procedure TForm1.Button1Click(Sender: TObject);
var lppe: TProcessEntry32;
found : boolean;
Hand : THandle;
begin
Hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
found := Process32First(Hand,lppe);
while found do
begin
ListBox1.Items.Add(StrPas(lppe.szExeFile));
found := Process32Next(Hand,lppe);
end;
end;

◇[DELPHI]根據BDETable1建立新表Table2
Table2:=TTable.Create(nil);
try
Table2.DatabaseName:=Table1.DatabaseName;
Table2.FieldDefs.Assign(Table1.FieldDefs);
Table2.IndexDefs.Assign(Table1.IndexDefs);
Table2.TableName:='new_table';
Table2.CreateTable();
finally
Table2.Free();
end;

◇[DELPHI]最菜理解DLL建立和引用
//先看DLL source(FILE-->NEW-->DLL)
library project1;
uses
SysUtils, Classes;
function addit(f:integer;s:integer):integer;export;
begin
makeasum:=f+s;
end;
exports
addit;
end.
//調用(IN ur PROJECT)
implementation
function addit(f:integer;s:integer):integer;far;external 'project1';//申明
{調用就是addit(2,4);結果顯示6}

◇[DELPHI]動態讀取程序自身大小
function GesSelfSize: integer;
var
f: file of byte;
begin
filemode := 0;
assignfile(f, application.exename);
reset(f);
Result := filesize(f);//單位是字節
closefile(f);
end;

◇[DELPHI]讀取BIOS信息
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;

◇[DELPHI]動態建立MSSQL別名
procedure TForm1.Button1Click(Sender: TObject);
var MyList: TStringList;
begin
MyList := TStringList.Create;
try
with MyList do
begin
Add('SERVER NAME=210.242.86.2');
Add('DATABASE NAME=db');
Add('USER NAME=sa');
end;
Session1.AddAlias('TESTSQL', 'MSSQL', MyList); //ミMSSQL
Session1.SaveConfigFile;
finally
MyList.Free;
Session1.Active:=True;
Database1.DatabaseName:='DB';
Database1.AliasName:='TESTSQL';
Database1.LoginPrompt:=False;
Database1.Params.Add('USER NAME=sa');
Database1.Params.Add('PASSWORD=');
Database1.Connected:=True;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Database1.Connected:=False;
Session1.DeleteAlias('TESTSQL'); 
end;

◇[DELPHI]播放背景音樂
uses mmsystem
//播放音樂
MCISendString('OPEN e:/1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('PLAY NN FROM 0', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);
end;
//停止播放
MCISendString('OPEN e:/1.MID TYPE SEQUENCER ALIAS NN', '', 0, 0);
MCISendString('STOP NN', '', 0, 0);
MCISendString('CLOSE ANIMATION', '', 0, 0);

◇[DELPHI]接口和類的一個範例代碼
Type{接口和類申明：區別在於不能在接口中申明數據成員、任何非公有的方法、公共方法不使用PUBLIC關鍵字}
Isample=interface//定義Isample接口
function getstring:string;
end;
Tsample=class(TInterfacedObject,Isample)
public
function getstring:string;
end;
//function定義
function Tsample.getstring:string;
begin
result:='what show is ';
end;
//調用類對象
var sample:Tsample;
begin
sample:=Tsample.create;
showmessage(sample.getstring+'class object!');
sample.free;
end;
//調用接口
var sampleinterface:Isample;
sample:Tsample;
begin
sample:=Tsample.create;
sampleInterface:=sample;//Interface的實現必須使用class
{以上兩行也可表達成sampleInterface:=Tsample.create;}
showmessage(sampleInterface.getstring+'Interface!');
//sample.free;{和局部類不同，Interface中的類自動釋放}
sampleInterface:=nil;{釋放接口對象}
end;

◇[DELPHI]任務條就看不當程序
var
ExtendedStyle : Integer;
begin
Application.Initialize;
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

◇[DELPHI]ALT+CTRL+DEL看不到程序
在implementation後添加聲明:
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
RegisterServiceProcess(GetCurrentProcessID, 1);//隱藏
RegisterServiceProcess(GetCurrentProcessID, 0);//顯示

◇[DELPHI]檢測光驅符號
var drive:char;
cdromID:integer;
begin
for drive:='d' to 'z' do
begin
cdromID:=GetDriveType(pchar(drive+':/'));
if cdromID=5 then showmessage('你的光驅爲:'+drive+'盤!');
end;
end;

◇[DELPHI]檢測聲卡
if auxGetNumDevs()<=0 then showmessage('No soundcard found!') else showmessage('Any soundcard found!');

◇[DELPHI]在字符串網格中畫圖
StringGrid.OnDrawCell事件
with StringGrid1.Canvas do
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);

◇[SQL SERVER]SQL中代替Like語句的另一種寫法
比如查找用戶名包含有"c"的所有用戶, 可以用
use mydatabase
select * from table1 where username like'%c%"
下面是完成上面功能的另一種寫法:
use mydatabase
select * from table1 where charindex('c',username)>0
這種方法理論上比上一種方法多了一個判斷語句,即>0, 但這個判斷過程是最快的, 我想信80%以上的運算都是花在查找字
符串及其它的運算上, 所以運用charindex函數也沒什麼大不了. 用這種方法也有好處, 那就是對%,|等在不能直接用like
查找到的字符中可以直接在這charindex中運用, 如下:
use mydatabase
select * from table1 where charindex('%',username)>0
也可以寫成:
use mydatabase
select * from table1 where charindex(char(37),username)>0
ASCII的字符即爲%

◇[DELPHI]SQL顯示多數據庫/表
SELECT DISTINCT A.bianhao,a.xingming, b.gongzi FROM "jianjie.dbf" a, "gongzi.DBF" b
WHERE A.bianhao=b.bianhao

◇[DELPHI]RFC(Request For Comment)相關
IETF(Internet Engineering Task Force)維護RFC文檔http://www.ietf.cnri.reston.va.us
RFC882：報文頭標結構
RFC1521：MIME第一部分，傳輸報文方法
RFC1945：多媒體文檔傳輸文檔

◇[DELPHI]TNMUUProcessor的使用
var inStream,outStream:TFileStream;
begin
inStream:=TFileStream.create(infile.txt,fmOpenRead);
outStream:=TFileStream(outfile.txt,fmCreate);
NMUUE.Method:=uuCode;{UUEncode/Decode}
//NMUUE.Method:=uuMIME;{MIME}
NMUUE.InputStream:=InStream;
NMUUE.OutputStream:=OutStream;
NMUUE.Encode;{編碼處理}
//NMUUE.Decode;{解碼處理}
inStream.free;
outStream.free;
end;

◇[DELPHI]TFileStream的操作
//從文件流當前位置讀count字節到緩衝區BUFFER
function read(var buffer;count:longint):longint;override;
//將緩衝區BUFFER讀到文件流中
function write(const buffer;count:longint):longint;override;
//設置文件流當前讀寫指針爲OFFSET
function seek(offset:longint;origin:word):longint;override;
origin={soFromBeginning,soFromCurrent,soFromEnd}
//從另一文件流中當前位置複製COUNT到當前文件流當前位置
function copyfrom(source:TStream;count:longint):longint;
//讀指定文件到文件流
var myFStream:TFileStream;
begin
myFStream:=TFileStream.create(OpenDialog1.filename,fmOpenRead);
end;

[JavaScript]檢測是否安裝IE插件Shockwave&Quicktime
<script LANGUAGE="JavaScript">
var myPlugin = navigator.plugins["Shockwave"];
if (myPlugin)
document.writeln("你已經安裝了 Shockwave!")
else
document.writeln("你尚未安裝 Shockwave!")
</script><br>
<script LANGUAGE="JavaScript">
var myPlugin = navigator.plugins["Quicktime"];
if (myPlugin)
document.writeln("你已經安裝了Quicktime!")
else
document.writeln("你尚未安裝 Quicktime!")
</script>

[INTERNET]表格中引用IFRAME效果
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td><ILAYER id="ad1" visibility="hidden" height="60"></ILAYER> <NOLAYER> <IFRAME SRC="i:/jinhtml/zj/h21.htm" width="500" height="200" marginwidth="0" marginheight="110" hspace="10" vspace="20" frameborder="0" scrolling="1"></IFRAME> </NOLAYER> </td>
</tr>
</table>

◇[DELPHI]WebBrowser控件技巧
1。實現打印功能
var vaIn, vaOut: OleVariant;
WebBrowser.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
2。WebBrowser從流中讀取頁面
function TForm1.LoadFromStream(const AStream: TStream): HRESULT;
begin
AStream.seek(0, 0);
Result := (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(AStream));
end;
3。"about:" protocol will let you Navigate to an HTML string:
procedure TForm1.LoadHTMLString(sHTML: String);
var Flags, TargetFrameName, PostData, Headers: OleVariant;
WebBrowser1.Navigate('about:' + sHTML, Flags, TargetFrameName, PostData, Headers)
4。"res:" protocol will let you Navigate to an HTML file stored as a resource. More informations is available from the Microsoft site:
procedure TForm1.LoadHTMLResource;
var Flags, TargetFrameName, PostData, Headers: OleVariant;
WebBrowser1.Navigate('res://' + Application.ExeName + '/myhtml', Flags, TargetFrameName, PostData, Headers)
使用brcc32.exe建立資源文件 (*.rc)
MYHTML 23 "./html/myhtml.htm"
MOREHTML 23 "./html/morehtml.htm"
{$R HTML.RES} //html.rc被編譯成html.res
5。保存完整的HTML文件
var
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
PersistFile.Save(StringToOleStr('test.htm'), True);
while HTMLDocument.readyState <> 'complete' do
Application.ProcessMessages;
end;

◇[DELPHI]安裝WebBrowser控件（內嵌IE控件）
你必須先確定系統已安裝Internet Explorer4或以後版本，DELPHI菜單--Component- - Import ActiveX Contro，列表中選擇Microsoft Internet Controls"並ADD到一個已存在的包文件中，WebBrowser控件將顯示在ActiveX控件面板。

◇[DELPHI]實現windows2000半透明窗體
function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函數聲明
procedure TForm1.FormCreate(Sender: TObject);
var l:longint;
begin
l:=getWindowLong(Handle, GWL_EXSTYLE);
l := l Or $80000;
SetWindowLong (handle, GWL_EXSTYLE, l);
SetLayeredWindowAttributes(handle, 0, 180, 2);
end;

◇[DELPHI]程序顯示廣告WebBrowser加載圖片
var Flag, frame, pData, Header: OLEVariant;
begin
WebBrowser1.Navigate('http://www.chineseall.com/images/logo.jpg', flag, frame,pData, Header)
end;

◇[DELPHI]計算一個目錄的大小
function GetDirectorySize(const ADirectory: string): Integer;
var
Dir: TSearchRec;
Ret: integer;
Path: string;
begin
Result := 0;
Path := ExtractFilePath(ADirectory);
Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);
if Ret <> NO_ERROR then
exit;
try
while ret=NO_ERROR do
begin
inc(Result, Dir.Size);
//如果是目錄，且不是'.'或'..'則進行遞歸調用
if (Dir.Attr in [faDirectory]) and (Dir.Name[1] <> '.') then
Inc(Result, GetDirectorySize(Path + Dir.Name + '/*.*'));
Ret := Sysutils.FindNext(Dir);
end;
finally
Sysutils.FindClose(Dir);
end;
end;

◇[DELPHI]清空一個目錄
function EmptyDirectory(TheDirectory :String ; Recursive : Boolean) :
Boolean;
var
SearchRec : TSearchRec;
Res : Integer;
begin
Result := False;
TheDirectory := NormalDir(TheDirectory);
Res := FindFirst(TheDirectory + '*.*', faAnyFile, SearchRec);
try
while Res = 0 do
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
if ((SearchRec.Attr and faDirectory) > 0) and Recursive
then begin
EmptyDirectory(TheDirectory + SearchRec.Name, True);
RemoveDirectory(PChar(TheDirectory + SearchRec.Name));
end
else begin
DeleteFile(PChar(TheDirectory + SearchRec.Name))
end;
end;
Res := FindNext(SearchRec);
end;
Result := True;
finally
FindClose(SearchRec.FindHandle);
end;
end;

◇[DELPHI]發佈ADO程序之安裝ADO
運行一次 MDac_typ.exe ，這個文件在微軟的 Windows、IE、Office、Visual Studio 中都有。
安裝程序所安裝後的目錄與程序中設置的目錄路徑一樣，C:/Program Files/Common Files/System/ado文件夾中有沒有ADO組件，裝ACCESS2000就有ADO2.1，沒有則安裝MS OFfice2000，編譯要去掉project->Option->Packages對話框中的Build With RunTime Library的勾。

◇[DELPHI]攔截Windows系統消息：WM_CLOSE消息
procedure WMClose(var Msg: TMessage);message WM_CLOSE;
procedure TMainForm.WMClose(var Msg: TMessage);
begin
m_bCloseNoQuery := false;
inherited;
end;

　

來自：Adnil, 時間：2002-3-26 14:54:00, ID：1003492

強！
大致看了一下，提兩個修改意見：

◇[DELPHI]設置窗體的最大顯示
onFormCreate事件
self.width:=screen.width;
self.height:=screen.height;
修改：
self.windowstate := wsmaxmized;

◇[DELPHI]文件名的非法字符過濾
for i:=1 to length(s) do
if s[i] in ['/','/',':','*','?','<','>','|'] then
修改：
try
slist := tstringlist.create;
slist.savetofile(s);
result := true;
deletefile(s);
except
result := false;
end;
利用異常機制，這樣可以兼容linux的文件命名。

追加部分

◇[DELPHI]配置ODBC的代碼
var
reg: TRegistry;
Driver: string;
begin
//建立和更新odbc數據源
//查找ODBCINST.INI鍵,如果sql server的驅動程序沒有安裝，則提示退出
//如果存在，則進行配置
reg := TRegistry.Create;
try
with reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('Software/ODBC/ODBCINST.INI/SQL Server', False) then
begin //如果存在sql server 驅動程序
Driver := ReadString('Driver');
CloseKey;
if OpenKey('Software/ODBC/ODBC.INI/ODBC Data Sources', True) then
begin //註冊一個DSN名稱
WriteString(Edit_DataSource.Text, 'SQL Server');
end
else
begin //創建鍵值失敗
Application.MessageBox(pchar('在創建DSN' + edit_datasource.text + '時發生錯誤'), '創建ODBC數據源失敗', MB_ICONINFORMATION or MB_OK);
exit;
end;
CloseKey;
//end 建立dsn
if OpenKey('Software/ODBC/ODBC.INI/' + Edit_DataSource.Text, True) then
begin
WriteString('Database', Edit_DataSource.Text);
WriteString('Driver', Driver);
WriteString('LastUser', Edit_LoginUser.Text);
WriteString('Server', Edit_Ip.Text);
end
else
begin //創建鍵值失敗
Application.MessageBox(pchar('在創建DSN' + edit_datasource.text + '時發生錯誤'), '創建ODBC數據源失敗', MB_ICONINFORMATION or MB_OK);
exit;
end;
CloseKey;
end
else
Application.MessageBox('在當前機器上沒有安裝 SQL Server的ODBC 驅動程序!，請安裝相應的驅動程序', '驅動程序出錯', MB_ICONINFORMATION or MB_OK);
CloseKey;
end;
finally
reg.Free;
end;
end;

◇[DELPHI]驗證郵件地址有效函數
function IsValidEmail(const Value: string): boolean;
function CheckAllowed(const s: string): boolean;
var
i: integer;
begin
Result:= false;
for i:= 1 to Length(s) do
begin
// illegal char in s -> no valid address
if not (s[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then
Exit;
end;
Result:= true;
end;
var
i: integer;
namePart, serverPart: string;
begin // of IsValidEmail
Result:= false;
i:= Pos('@', Value);
if (i = 0) or (pos('..', Value) > 0) then
Exit;
namePart:= Copy(Value, 1, i - 1);
serverPart:= Copy(Value, i + 1, Length(Value));
if (Length(namePart) = 0) // @ or name missing
or ((Length(serverPart) < 4)) // name or server missing or
then Exit; // too short
i:= Pos('.', serverPart);
// must have dot and at least 3 places from end
if (i = 0) or (i >= (Length(serverPart) - 2)) then
Exit;
Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;

◇[DELPHI]設定IE的默認打開主頁
procedure SetStartPage(StartPage:string);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
Reg.OpenKey(StartPagePath,False);
Reg.WriteString('Start Page',StartPage);
Reg.Free;
end;

◇[DELPHI]FORM邊緣特效
procedure TForm1.FormCreate(Sender: TObject);
var
Region1 : array of tPoint;
Region1hrgn : hRgn;
Begin
SetLength(Region1,59);
Region1[0].X:=12; Region1[0].Y:=6;
Region1[1].X:=484; Region1[1].Y:=6;
Region1[2].X:=484; Region1[2].Y:=7;
Region1[3].X:=486; Region1[3].Y:=7;
Region1[4].X:=486; Region1[4].Y:=8;
Region1[5].X:=487; Region1[5].Y:=8;
Region1[6].X:=487; Region1[6].Y:=9;
Region1[7].X:=488; Region1[7].Y:=9;
Region1.X:=488; Region1.Y:=10;
Region1[9].X:=489; Region1[9].Y:=10;
Region1[10].X:=489; Region1[10].Y:=12;
Region1[11].X:=490; Region1[11].Y:=12;
Region1[12].X:=490; Region1[12].Y:=285;
Region1[13].X:=489; Region1[13].Y:=285;
Region1[14].X:=489; Region1[14].Y:=287;
Region1[15].X:=488; Region1[15].Y:=287;
Region1[16].X:=488; Region1[16].Y:=288;
Region1[17].X:=487; Region1[17].Y:=288;
Region1[18].X:=487; Region1[18].Y:=289;
Region1[19].X:=486; Region1[19].Y:=289;
Region1[20].X:=486; Region1[20].Y:=290;
Region1[21].X:=484; Region1[21].Y:=290;
Region1[22].X:=484; Region1[22].Y:=291;
Region1[23].X:=101; Region1[23].Y:=291;
Region1[24].X:=100; Region1[24].Y:=290;
Region1[25].X:=99; Region1[25].Y:=290;
Region1[26].X:=98; Region1[26].Y:=289;
Region1[27].X:=97; Region1[27].Y:=288;
Region1[28].X:=96; Region1[28].Y:=287;
Region1[29].X:=95; Region1[29].Y:=286;
Region1[30].X:=95; Region1[30].Y:=284;
Region1[31].X:=94; Region1[31].Y:=283;
Region1[32].X:=94; Region1[32].Y:=200;
Region1[33].X:=93; Region1[33].Y:=199;
Region1[34].X:=93; Region1[34].Y:=198;
Region1[35].X:=92; Region1[35].Y:=197;
Region1[36].X:=91; Region1[36].Y:=196;
Region1[37].X:=90; Region1[37].Y:=195;
Region1[38].X:=89; Region1[38].Y:=194;
Region1[39].X:=88; Region1[39].Y:=194;
Region1[40].X:=87; Region1[40].Y:=193;
Region1[41].X:=14; Region1[41].Y:=193;
Region1[42].X:=13; Region1[42].Y:=192;
Region1[43].X:=12; Region1[43].Y:=192;
Region1[44].X:=11; Region1[44].Y:=191;
Region1[45].X:=10; Region1[45].Y:=190;
Region1[46].X:=9; Region1[46].Y:=189;
Region1[47].X:=8; Region1[47].Y:=188;
Region1[48].X:=8; Region1[48].Y:=187;
Region1[49].X:=7; Region1[49].Y:=186;
Region1[50].X:=7; Region1[50].Y:=184;
Region1[51].X:=6; Region1[51].Y:=183;
Region1[52].X:=6; Region1[52].Y:=12;
Region1[53].X:=7; Region1[53].Y:=11;
Region1[54].X:=7; Region1[54].Y:=10;
Region1[55].X:=8; Region1[55].Y:=9;
Region1[56].X:=9; Region1[56].Y:=8;
Region1[57].X:=10; Region1[57].Y:=7;
Region1[58].X:=11; Region1[58].Y:=7;
Region1hrgn:=CreatePolygonRgn(Region1[0],59,2);
SetWindowRgn(Handle, Region1hrgn, True);
end;

◇[DELPHI]LISTVIEW實現隔行背景顏色
procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
begin
if item.Index mod 2 = 1 then
begin
sender.Canvas.Brush.Color:=clYellow;
end
else
sender.Canvas.Brush.Color:=clwhite;
end;

◇[DELPHI]判斷機器是否網絡狀態
uses WinInet;
procedure TForm1.Button1Click(Sender: TObject);
function GetOnlineStatus : Boolean;
var ConTypes : Integer;
begin
ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
if (InternetGetConnectedState(@ConTypes, 0) = False)
then Result := False
else Result := True;
end;
begin
if not GetOnlineStatus then ShowMessage('Not Connected');
end;

◇[DELPHI]窗體漸漸出現
AnimateWindow(Handle,1000,AW_CENTER);
//在窗體創建事件中

◇[DELPHI]製作豎式菜單圖片的關鍵代碼
ONDrawItem事件
begin
acanvas.Draw(0,2,image1.picture.bitmap); anvas.TextOut(arect.left+image1.picture.bitmap.width+2,arect.top,tmenuitem(sender).caption);
end;