談Delphi下Internet的程式設計技巧(一)
作者：lyboy99E-mail:[email protected]帶了很多的Internet應用程式控制,這使得我們開發Internet的應用程式可以輕鬆些,下面我將逐步介紹一些關於Internet下應用程式程式設計技巧，這些技巧都是一些細微的方面,但是它卻可以為你的應用程式添加重要的功能,將使你開發Internet下的應用程式事半功倍。說過開場旁白後，首先介紹：設定係統預設瀏覽器和系統預設電子郵件收發軟體。 1.取得預設的internet瀏覽器位址函數:下面的函數是透過讀取登錄檔的設定後,得到預設Internet的瀏覽器所在位址function GetDefaultShellHTTP : string;varreg : 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.設定internet瀏覽器PRocedure SetDefaultShellHttp (CmdLine : string);varreg : TRegistry;begin Reg:=TRegistry.Create; Reg.RootKey:=HKEY_CLASSES_ROOT; //登錄機碼的位址： Reg.OpenKey('http/shell/open/command',true);//登錄機碼的位址： Reg.WriteString('',CmdLine); Reg. Free;end;setDefaultshellhttp('"C:/PROGRA~1/INTERN~1/iexplorer.exe" -nohome');3.取得並設定預設的E-Mail收發軟體的函數下面的函數是透過讀取登錄檔的設定後,得到預設E-mail收發軟體所在位址function GetDefaultMail : string;varreg : 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.設定預設郵件箱procedure SetDefaultMail (CmdLine : string);varreg : 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.是否早想有個網域轉換成ip位址的函數，現在我就給你一個網域轉換成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.寫Internet軟體常常會遇到檢查使用者輸入的網址，E-mail位址等等，如何解決呢？我這正好有寫好的函數。檢查一個URL是否有效uses wininet; Function CheckUrl(url:string):boolean; //檢查一個URL是否有效函數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 := InternetsionOpend , pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0); dwIndex := 0; dwCodeLen := 10; HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex); res := pchar(@dw res ='302'); //200,302未重定位標誌if assigned(hfile) then InternetCloseHandle(hfile); InternetCloseHandle(hsession); end; end;
如何處理E-mail地址,下面給你個E-mail地址處理函數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,動態改變DNS Server的位址
下面的函數可以加入DNS Server的位址
如想新增202.100.100.65 202.10.10.10
SetDNSAddresses('202.100.100.65 202.10.10.10') ;
//注意: 各位址之間以一個空格隔開
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;