| 導購 | 订阅 | 在线投稿
分享
 
 
當前位置: 王朝網路 >> delphi >> DELPHI的一些開發技巧和方法(二)
 

DELPHI的一些開發技巧和方法(二)

2007-06-23 04:20:04  編輯來源:互聯網  简体版  手機版  評論  字體: ||
 
 
  作者 : toofree

  

  

   標題 : DELPHI的一些開發技巧和方法(二)

  

  

   關鍵字: DELPHI 開發技巧

  

  

   分類 : 開發技巧

  

  

   密級 : 參賽

  

  

  

  

  

  

   (評分:★ , 回複: 3, 閱讀: 1185)

  11、向其他應用程序發送模擬鍵:

  var

  h: Thandle;

  begin

  h := FindWindow(nil, '應用程序標題');

  PostMessage(h, WM_KEYDOWN, VK_F9, 0);//發送F9鍵

  end

  12、判斷當前網絡連接方式:

  (判斷結果爲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;

  13、取機器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;

  14、解析服務器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;

  15、清空一個目錄:

  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;

  16、計算目錄的大小:

  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;

  17、獲得硬盤序列號:

  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;

  18、目錄完全刪除:

  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;

  19、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;

  20、獲得CPU序列號:

  function GetCpuId:longint;assembler;register;

  var

  temp:longint;

  begin

  asm

   PUSH EBX

   PUSH EDI

   MOV EDI,EAX

   MOV EAX,1

   DW $A20F

   MOV TEMP,EDX

   POP EDI

   POP EBX

  end;

  result:=temp;

  end;

  procedure TForm1.Button1Click(Sender: Tobject);

  begin

   label1.Caption:=IntToHex(GetCpuId,8);

  end;

  2003-5-30 10:47:00
 
 
 
上一篇《用DELPHI實現文件加密壓縮》
下一篇《Delphi中使用ListView和TreeView的Item中的Data可能被忽略的內存泄漏》
 
 
 
 
 
 
日版寵物情人插曲《Winding Road》歌詞

日版寵物情人2017的插曲,很帶節奏感,日語的,女生唱的。 最後聽見是在第8集的時候女主手割傷了,然後男主用嘴幫她吸了一下,插曲就出來了。 歌手:Def...

兄弟共妻,我成了他們夜裏的美食

老鍾家的兩個兒子很特別,就是跟其他的人不太一樣,魔一般的執著。兄弟倆都到了要結婚的年齡了,不管自家老爹怎麽磨破嘴皮子,兄弟倆說不娶就不娶,老父母爲兄弟兩操碎了心...

如何磨出破洞牛仔褲?牛仔褲怎麽剪破洞?

把牛仔褲磨出有線的破洞 1、具體工具就是磨腳石,下面墊一個硬物,然後用磨腳石一直磨一直磨,到把那塊磨薄了,用手撕開就好了。出來的洞啊很自然的。需要貓須的話調幾...

我就是掃描下圖得到了敬業福和愛國福

先來看下敬業福和愛國福 今年春節,支付寶再次推出了“五福紅包”活動,表示要“把欠大家的敬業福都還給大家”。 今天該活動正式啓動,和去年一樣,需要收集“五福”...

冰箱異味産生的原因和臭味去除的方法

有時候我們打開冰箱就會聞到一股異味,冰箱裏的這種異味是因爲一些物質發出的氣味的混合體,聞起來讓人惡心。 産生這些異味的主要原因有以下幾點。 1、很多人有這種習...

《極品家丁》1-31集大結局分集劇情介紹

簡介 《極品家丁》講述了現代白領林晚榮無意回到古代金陵,並追隨蕭二小姐化名“林三”進入蕭府,不料卻陰差陽錯上演了一出低級家丁拼搏上位的“林三升職記”。...

李溪芮《極品家丁》片尾曲《你就是我最愛的寶寶》歌詞

你就是我最愛的寶寶 - 李溪芮 (電視劇《極品家丁》片尾曲) 作詞:常馨內 作曲:常馨內 你的眉 又鬼馬的挑 你的嘴 又壞壞的笑 上一秒吵鬧 下...

烏梅的功效與作用以及烏梅的食用禁忌有哪些?

烏梅,又稱春梅,中醫認爲,烏梅味酸,性溫,無毒,具有安心、除熱、下氣、祛痰、止渴調中、殺蟲的功效,治肢體痛、肺痨病。烏梅泡水喝能治傷寒煩熱、止吐瀉,與幹姜一起制...

什麽是脂肪粒?如何消除臉部脂肪粒?

什麽是脂肪粒 在我們的臉上總會長一個個像脂肪的小顆粒,弄也弄不掉,而且顔色還是白白的。它既不是粉刺也不是其他的任何痘痘,它就是脂肪粒。 脂肪粒雖然也是由油脂...

網絡安全治理:國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰受害者

來源:中國青年報 新的攻擊方法不斷湧現,黑客幾乎永遠占據網絡攻擊的上風,我們不可能通過技術手段杜絕網絡攻擊。國家安全保障的主要方向是打擊犯罪,而不是處置和懲罰...

河南夫妻在溫嶺網絡直播“造人”內容涉黃被刑事拘留

夫妻網絡直播“造人”爆紅   1月9日,溫嶺城北派出所接到南京警方的協查通告,他們近期打掉了一個涉黃直播APP平台。而根據掌握的線索,其中有一對涉案的夫妻主播...

如何防止牆紙老化?牆紙變舊變黃怎麽辦?

如何防止牆紙老化? (1)選擇透氣性好的牆紙 市場上牆紙的材質分無紡布的、木纖維的、PVC的、玻璃纖維基材的、布面的等,相對而言,PVC材質的牆紙最不透氣...

鮮肌之謎非日本生産VS鮮肌之謎假日貨是謠言

觀點一:破日本銷售量的“鮮肌之謎” 非日本生産 近一段時間,淘寶上架了一款名爲“鮮肌之謎的” 鲑魚卵巢美容液,號稱是最近日本的一款推出的全新護膚品,産品本身所...

中國最美古詩詞精選摘抄

系腰裙(北宋詞人 張先) 惜霜蟾照夜雲天,朦胧影、畫勾闌。人情縱似長情月,算一年年。又能得、幾番圓。 欲寄西江題葉字,流不到、五亭前。東池始有荷新綠,尚小如...

關于女人的經典語句

關于女人的經典語句1、【做一個獨立的女人】 思想獨立:有主見、有自己的人生觀、價值觀。有上進心,永遠不放棄自己的理想,做一份自己喜愛的事業,擁有快樂和成就...

未來我們可以和性愛機器人結婚嗎?

你想體驗機器人性愛嗎?你想和性愛機器人結婚嗎?如果你想,機器人有拒絕你的權利嗎? 近日,第二屆“國際人類-機器人性愛研討會”大會在倫敦金史密斯大學落下帷幕。而...

全球最變態的十個地方

10.土耳其地下洞穴城市 變態指數:★★☆☆☆ 這是土耳其卡帕多西亞的一個著名景點,傳說是當年基督教徒們爲了躲避戰爭而在此修建。裏面曾住著20000人,...

科學家稱,人類死亡後意識將在另外一個宇宙中繼續存活

據英國《每日快報》報道,一位科學家兼理論家Robert Lanza博士宣稱,世界上並不存在人類死亡,死亡的只是身體。他認爲我們的意識借助我們體內的能量生存,而且...

《屏裏狐》片頭曲《我愛狐狸精》歌詞是什麽?

《我愛狐狸精》 - 劉馨棋   (電視劇《屏裏狐》主題曲)   作詞:金十三&李旦   作曲:劉嘉   狐狸精 狐狸仙   千年修...

 
 
 
作者 : toofree 標題 : DELPHI的一些開發技巧和方法(二) 關鍵字: DELPHI 開發技巧 分類 : 開發技巧 密級 : 參賽 (評分:★ , 回複: 3, 閱讀: 1185) 11、向其他應用程序發送模擬鍵: var h: Thandle; begin h := FindWindow(nil, '應用程序標題'); PostMessage(h, WM_KEYDOWN, VK_F9, 0);//發送F9鍵 end 12、判斷當前網絡連接方式: (判斷結果爲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; 13、取機器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; 14、解析服務器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; 15、清空一個目錄: 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; 16、計算目錄的大小: 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; 17、獲得硬盤序列號: 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; 18、目錄完全刪除: 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; 19、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; 20、獲得CPU序列號: function GetCpuId:longint;assembler;register; var temp:longint; begin asm PUSH EBX PUSH EDI MOV EDI,EAX MOV EAX,1 DW $A20F MOV TEMP,EDX POP EDI POP EBX end; result:=temp; end; procedure TForm1.Button1Click(Sender: Tobject); begin label1.Caption:=IntToHex(GetCpuId,8); end; 2003-5-30 10:47:00
󰈣󰈤
 
 
 
  免責聲明:本文僅代表作者個人觀點,與王朝網路無關。王朝網路登載此文出於傳遞更多信息之目的,並不意味著贊同其觀點或證實其描述,其原創性以及文中陳述文字和內容未經本站證實,對本文以及其中全部或者部分內容、文字的真實性、完整性、及時性本站不作任何保證或承諾,請讀者僅作參考,並請自行核實相關內容。
 
 
陽光靓麗的模特兒(8)
陽光靓麗的模特兒(7)
陽光靓麗的模特兒(6)
陽光靓麗的模特兒(5)
秋-印象
德慶盤龍峽 一
松江印象之三
雲之南(寬幅)
 
>>返回首頁<<
 
 
 
 熱帖排行
 
 
 
 
© 2005- 王朝網路 版權所有