谈Delphi下Internet的编程技巧(一)

谈Delphi下Internet的编程技巧(一) 作者:lyboy99 E-mail:lyboy99@sina.com Delphi带了很多的Internet应用编程控件,这使得我们开发Internet的应用程序可以轻松些,下面我将逐步介绍一些关于Internet下应用程序编程技巧，这些技巧都是一些细微的方面,但是它却可以给你的应用程序添加重要的功能,将使你开发Internet下的应用程序事半功倍。 说过开场旁白后，首先介绍：设置系统默认浏览器和系统默认电子邮件收发软件。 1.获得默认的internet浏览器地址函数: 下面的函数是通过读取注册表的设置后,得到默认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.设置internet浏览器 procedure SetDefaultShellHttp(CmdLine : string); var reg : 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; 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.设置默认邮件箱 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.是否早想有个域名转换为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 := 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未重定位标志 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; 作者Blog：http://blog.csdn.net/lyboy99/