谈Delphi下 数据挖掘研究院
谈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("httpshellopencommand") then
begin
Reg.OpenKey("httpshellopencommand",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("httpshellopencommand",true);//注册表的地址：
Reg.WriteString(",CmdLine);
Reg.Free;
end;
setDefaultshellhttp(""C:PROGRA~1INTERN~1iexplorer.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("Mailtoshellopencommand") then
begin
Reg.OpenKey("Mailtoshellopencommand",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("Mailtoshellopencommand",true); 数据挖掘研究院
Reg.WriteString(",CmdLine);
Reg.Free; 数据挖掘研究院
end;
使用
//SetDefaultMail("E:FoxMailFoxMail.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(
"SYSTEMCurrentControlSet" +
"ServicesTcpipParameters",
"NameServer",
sIPs );
// 如果你用的是Windows 95用下面的代码
SaveStringToRegistry_LOCAL_MACHINE(
"SYSTEMCurrentControlSet" +
"ServicesVxDMSTCP",
"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;
