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.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"');

 

  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;

 

 

下面介绍Delphi中的TWebBrowser控件的常用使用方法和技巧。从Delphi5开始,TwebBrowser组件中封装有MS IE AcitveX控件,并从Netmasters中替换了THTML组件。Delphi5没有全部加入TwebBrowser控件,我们可以先卸去原有的TwebBrowser组件后从新按安装MS IE ActiveX控件 ;方法是首先:选择Component菜单 -> Install Packages ,选择Internet Explorer Components 选项后,按

Remove按钮 ,将原TwebBrowser控件卸载掉,然后再 ,选择 Import ActiveX Control菜单,选择Microsoft internet controls(version 1.1)项后,Install , 安装后你会发现在ActiveX组件菜单中多了WebBrowse_V1 和WebBrowse二个控件。

以TWebBrowser(IE5浏览器控件)为例,介绍以下控件的常用的属性。
有些属性在TwebBrowser_V1控件中没有,是TwebBrowser控件中新增的,我在下面的列表中已经注明。
TwebBrowser控件常用属性表:

属性:

介绍:

 

GoBack

后退到上一个页面

GoForward

前进到下一个页面

GoHome

调用默认的主页页面

GoSearch

调用默认的搜索页面






Navigate(const URL: WideString;

var Flags, TargetFrameName, PostData,

Headers: OleVariant)

调用指定页面,具体参数如下:

URL:指定页面的URL。Flags:

   Word类型,作用还不清楚,可设为0。

TargetFrameName:WideString,

打开页面所在的Frame,为空字符串时在当前的

Frame中打开;TargetFrameName

指定的Frame存在时在Frame中打开;

TargetFrameName指定的Frame

不存在时则新建一个窗口打开,此时就相当

于调用外部的IE浏览器了。

PostData:boolean,是否允许发送数据。

Headers:WideString,

要发送的URL请求的头部数据

Refresh

刷新当前页面

Stop

停止调用或打开当前页面

LocationName属性(WideString)

当前位置的名称

LocationURL属性(WideString)

当前位置的URL

Busy属性(Boolean),

是否正忙

Visible: 属性(Boolean)

浏览器窗口是否可见

StatusBar属性(Boolean)

是否显示状态栏,TWebBrowser新增

StatusText: 属性(WideString)

状态栏内容,TWebBrowser新增

ToolBar: 属性(SYSINT)

工具栏中的内容,TWebBrowser新增

MenuBar: 属性(Boolean)

是否显示菜单条,TWebBrowser新增

 

FullScreen: 属性(Boolean)

是否全屏显示,TWebBrowser新增

Offline: 属性(Boolean)

是否脱机浏览,TWebBrowser新增

AddressBar: 属性(Boolean)

是否显示地址栏,TWebBrowser新增

 

 



TwebBrowser常见事件表:

OnStatusTextChange = procedure

(Sender: TObject; const Text: WideString)

of object;

在状态栏提示信息变化时发生,参数Text为当前状态栏提示信息,我们可以根据该信息来更新我们自己的状态栏提示信息或处理其它的事务

OnProgressChange = procedure(Sender: TObject; Progress, ProgressMax: Integer) of object;

在打开页面的进度变化时发生,参数Progress为当前进度,ProgressMax为总进度,可以根据这两个参数来更新状态栏提示信息或处理其它的事务

OnCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object;

当执行新的命令时发生,Command为命令标识,Enable为是否允许执行该命令.

OnTitleChange = procedure(Sender: TObject; const Text: WideString) of object;

在页面的标题发生变化时发生,Text为当前标题



OnPropertyChange = procedure(Sender: TObject; const Property_: WideString) of object;

在页面的属性发生变化时发生,Property_为属性名称 OnDownloadComplete: TNotifyEvent

在下载页面完成后发生
OnDownloadBegin: TNotifyEvent

在下载页面开始前发生.

 

 

 介绍过TwebBrowser控件的属性后,我在给大家介绍一下应用TwebBrowser控件的一些编程技巧。 

 

1.显示一个GIF动画

如果你找不到显示GIF动画的控件,下面的一个函数可以解决你的燃眉之急

procedure ShowGIF( GIFFileName : String );

var

   TargetFrameName,PostData,Heads,Flags : OleVariant;

   URL : widestring;

begin

 

 TargetFrameName := '';{指定Frame的空字符串时,

则在当前Frame中打开动画文件}

 PostData := false;{不发送数据}

 Heads := '';{Header信息为空}

 Flags := 0;{Flags设为0}

 URL := GIFFileName;

 with formGIF.webbrowser do{在指定窗口中的

IE浏览器控件中显示动画}

  begin

   navigate(URL,Flags,TargetFrameName

,PostData,Heads);{显示动画文件}

  end;

end;

 

 

2.删除IE的历史记录

很想知道如何实现删除IE的历史记录的吧,下面一段程序事例将介绍如何编写

uses wininet;

 

procedure TForm1.Button1Click(Sender: TObject);

var

posted on 2009-01-04 11:51  诸葛朦朦  阅读(654)  评论(0编辑  收藏  举报