談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
h
session, hfile, hRequest: hInternet;
dwindex,dwcodelen :d
Word;
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;
