先人的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)
AZ：$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="/" onclick="Javascript:window.close();return false;">關閉</a>
定時轉URL
<meta http-equiv="refresh" content="40;url=http://www.086net.com">
設為首頁
<a onclick="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] 在 ['/','/',':','*','?','<','>','|'] 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): 布林; 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): 布林;
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 (像素，相對於螢幕的解析度)
絕對長度：
在 (英寸，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
與 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 cellpadding="0" cellspacing="0">
<tr>
<td><ILAYER id="ad1" visibility="hidden"></ILAYER> <NOLAYER> <IFRAME SRC="i:/jinhtml/zj/h21.htm" 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控制項會顯示在ActiveXser控制項面板。
◇[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;