談Delphi下Internet的編程技巧(一) 
--------------------------------------------------------------------------------
作者：不詳 　來(lái)源于：不詳 　發(fā)布時(shí)間：2005-3-17 10:07:42 
Delphi帶了很多的Internet應(yīng)用編程控件,這使得我們開(kāi)發(fā)Internet的應(yīng)用程序可以輕松些,下面我將逐步介紹一些關(guān)于Internet下應(yīng)用程序編程技巧，這些技巧都是一些細(xì)微的方面,但是它卻可以給你的應(yīng)用程序添加重要的功能,將使你開(kāi)發(fā)Internet下的應(yīng)用程序事半功倍。

說(shuō)過(guò)開(kāi)場(chǎng)旁白后，首先介紹：設(shè)置系統(tǒng)默認(rèn)瀏覽器和系統(tǒng)默認(rèn)電子郵件收發(fā)軟件。

 

1.獲得默認(rèn)的internet瀏覽器地址函數(shù):

下面的函數(shù)是通過(guò)讀取注冊(cè)表的設(shè)置后,得到默認(rèn)Internet的瀏覽器所在地址

 

function GetDefaultShellHTTP : string;

var

reg : TRegistry;

 

begin

  Reg:=TRegistry.Create;

  Reg.RootKey:=HKEY_CLASSES_ROOT;

  if Reg.KeyExists('http\shell\open\command') then

  begin

    Reg.OpenKey('http\shell\open\command',false);

    Result:=Reg.ReadString('');

  end

  else

    Result:='';

  Reg.Free;

end;

 

 

 

 

2.設(shè)置internet瀏覽器

 

procedure SetDefaultShellHttp(CmdLine : string);

var

reg : TRegistry;

 

begin

  Reg:=TRegistry.Create;

  Reg.RootKey:=HKEY_CLASSES_ROOT; //注冊(cè)表的地址：

  Reg.OpenKey('http\shell\open\command',true);//注冊(cè)表的地址：

  Reg.WriteString('',CmdLine);

  Reg.Free;

end;

setDefaultshellhttp('"C:\PROGRA~1\INTERN~1\iexplorer.exe" -nohome');

 

 

 

 

3.獲得和設(shè)置默認(rèn)的E-Mail 收發(fā)軟件的函數(shù)

下面的函數(shù)是通過(guò)讀取注冊(cè)表的設(shè)置后,得到默認(rèn)E-mail收發(fā)軟件所在地址

function GetDefaultMail : string;

var

reg : TRegistry;

 

begin

  Reg:=TRegistry.Create;

  Reg.RootKey:=HKEY_CLASSES_ROOT;

  if Reg.KeyExists('Mailto\shell\open\command') then

  begin

    Reg.OpenKey('Mailto\shell\open\command',false);

    Result:=Reg.ReadString('');

  end

  else

    Result:='';

  Reg.Free;

end;

 

4.設(shè)置默認(rèn)郵件箱

procedure SetDefaultMail(CmdLine : string);

var

reg : TRegistry;

 

begin

  Reg:=TRegistry.Create;

  Reg.RootKey:=HKEY_CLASSES_ROOT;

  Reg.OpenKey('Mailto\shell\open\command',true);

  Reg.WriteString('',CmdLine);

  Reg.Free;

end;

使用

//SetDefaultMail('E:\FoxMail\FoxMail.exe -T "%1" -S "%2"');

 

 

 

 

5.是否早想有個(gè)域名轉(zhuǎn)換為IP地址的函數(shù)，現(xiàn)在我就給你一個(gè)

域名轉(zhuǎn)換為IP地址:

 

function GetIPName(Name: string): string;

var

  WSAData: TWSAData;

  HostEnt: PHostEnt;

begin

  WSAStartup(2, WSAData);

  HostEnt := gethostbyname(PChar(Name));

  with HostEnt^ do

    Result := Format('%d.%d.%d.%d', [Byte(h_addr^[0]),

      Byte(h_addr^[1]), Byte(h_addr^[2]), Byte(h_addr^[3])]);

  WSACleanup;

end; 

 

6.編寫(xiě)Internet軟件常常會(huì)遇到檢查用戶輸入的網(wǎng)址，E-mail地址等等，如何解決呢？

我這正好有寫(xiě)好的函數(shù)。

檢查一個(gè)URL是否有效

 

uses wininet; 

Function CheckUrl(url:string):boolean; //檢查一個(gè)URL是否有效函數(shù)

var 

hSession, hfile, hRequest: hInternet; 

dwindex,dwcodelen :dword; 

dwcode:array[1..20] of char; 

res : pchar; 

 

begin 

if pos('http://',lowercase(url))=0 then 

url := 'http://'+url; 

 Result := false; 

 hSession := InternetOpen('InetURL:/1.0', 

 INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0); 

 if assigned(hsession) then 

begin 

hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0); 

dwIndex := 0; 

dwCodeLen := 10; 

HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex); 

res := pchar(@dwcode); 

result:= (res ='200') or (res ='302'); //200,302未重定位標(biāo)志

if assigned(hfile) then 

InternetCloseHandle(hfile); 

InternetCloseHandle(hsession); 

end; 

  end;

如何處理E-mail地址,下面給你個(gè)E-mail地址處理函數(shù)

 

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;   

   procedure TForm1.Button1Click(Sender: TObject);  

begin   

 if isemail(Edit1.Text) then 

   begin  

    ShowMessage('eMail-Address!');

    end; 

 end;  

 

 

 

 

7,動(dòng)態(tài)改變DNS Server的地址
下面的函數(shù)可以添加 DNS Server的地址
如想添加202.100.100.65 202.10.10.10
SetDNSAddresses('202.100.100.65 202.10.10.10') ;
//注意: 各地址之間用一個(gè)空格隔開(kāi)

SetTDNSAddresses 定義如下：

procedure SetDNSAddresses( sIPs : string );
begin
// 如果是 Windows NT用下面的代碼
SaveStringToRegistry_LOCAL_MACHINE(
'SYSTEM\CurrentControlSet' +
'\Services\Tcpip\Parameters',
'NameServer',
sIPs );

// 如果你用的是Windows 95用下面的代碼

SaveStringToRegistry_LOCAL_MACHINE(
'SYSTEM\CurrentControlSet' +
'\Services\VxD\MSTCP',
'NameServer',
sIPs );
end;

其中 SaveStringToRegistry_LOCAL_MACHINE 定義：

uses Registry;

procedure SaveStringToRegistry_LOCAL_MACHINE(
sKey, sItem, sVal : string );
var
reg : TRegIniFile;
begin
reg := TRegIniFile.Create( '' );
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.WriteString( sKey, sItem, sVal + #0 );
reg.Free;
end;