一些DELPHI的函数

{=============================================================

功 能: 网络函数库

==============================================================}

unit Net;

interface

uses

SysUtils

,Windows

,dialogs

,winsock

,Classes

,ComObj

,WinInet;

//得到本机的局域网Ip地址

Function GetLocalIp(var LocalIp:string): Boolean;

//通过Ip返回机器名

Function GetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;

//获取网络中SQLServer列表

Function GetSQLServerList(var List: Tstringlist): Boolean;

//获取网络中的所有网络类型

Function GetNetList(var List: Tstringlist): Boolean;

//获取网络中的工作组

Function GetGroupList(var List: TStringList): Boolean;

//获取工作组中所有计算机

Function GetUsers(GroupName: string; var List: TStringList): Boolean;

//获取网络中的资源

Function GetUserResource(IpAddr: string; var List: TStringList): Boolean;

//映射网络驱动器

Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean;

//检测网络状态

Function CheckNet(IpAddr:string): Boolean;

//检测机器是否登入网络

Function CheckMacAttachNet: Boolean;

//判断Ip协议有没有安装 这个函数有问题

Function IsIPInstalled : boolean;

//检测机器是否上网

Function InternetConnected: Boolean;

implementation

{=================================================================

功 能: 检测机器是否登入网络

参 数: 无

返回值: 成功: True 失败: False

备 注:

版 本:

1.0 2002/10/03 09:55:00

=================================================================}

Function CheckMacAttachNet: Boolean;

begin

Result := False;

if GetSystemMetrics(SM_NETWORK) <> 0 then

Result := True;

end;

{=================================================================

功 能: 返回本机的局域网Ip地址

参 数: 无

返回值: 成功: True, 并填充LocalIp 失败: False

备 注:

版 本:

1.0 2002/10/02 21:05:00

=================================================================}

function GetLocalIP(var LocalIp: string): Boolean;

var

HostEnt: PHostEnt;

Ip: string;

addr: pchar;

Buffer: array [0..63] of char;

GInitData: TWSADATA;

begin

Result := False;

try

WSAStartup(2, GInitData);

GetHostName(Buffer, SizeOf(Buffer));

HostEnt := GetHostByName(buffer);

if HostEnt = nil then Exit;

addr := HostEnt^.h_addr_list^;

ip := Format('%d.%d.%d.%d', [byte(addr [0]),

byte (addr [1]), byte (addr [2]), byte (addr [3])]);

LocalIp := Ip;

Result := True;

finally

WSACleanup;

end;

end;

{=================================================================

功 能: 通过Ip返回机器名

参 数:

IpAddr: 想要得到名字的Ip

返回值: 成功: 机器名 失败: ''

备 注:

inet_addr function converts a string containing an Internet

Protocol dotted address into an in_addr.

版 本:

1.0 2002/10/02 22:09:00

=================================================================}

function GetNameByIPAddr(IPAddr : String;var MacName:String): Boolean;

var

SockAddrIn: TSockAddrIn;

HostEnt: PHostEnt;

WSAData: TWSAData;

begin

Result := False;

if IpAddr = '' then exit;

try

WSAStartup(2, WSAData);

SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));

HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);

if HostEnt <> nil then

MacName := StrPas(Hostent^.h_name);

Result := True;

finally

WSACleanup;

end;

end;

{=================================================================

功 能: 返回网络中SQLServer列表

参 数:

List: 需要填充的List

返回值: 成功: True,并填充List 失败 False

备 注:

版 本:

1.0 2002/10/02 22:44:00

=================================================================}

Function GetSQLServerList(var List: Tstringlist): boolean;

var

i: integer;

sRetValue: String;

SQLServer: Variant;

ServerList: Variant;

begin

Result := False;

List.Clear;

try

SQLServer := CreateOleObject('SQLDMO.Application');

ServerList := SQLServer.ListAvailableSQLServers;

for i := 1 to Serverlist.Count do

list.Add (Serverlist.item(i));

Result := True;

Finally

SQLServer := NULL;

ServerList := NULL;

end;

end;

{=================================================================

功 能: 判断Ip协议有没有安装

参 数: 无

返回值: 成功: True 失败: False;

备 注: 该函数还有问题

版 本:

1.0 2002/10/02 21:05:00

=================================================================}

Function IsIPInstalled : boolean;

var

WSData: TWSAData;

ProtoEnt: PProtoEnt;

begin

Result := True;

try

if WSAStartup(2,WSData) = 0 then

begin

ProtoEnt := GetProtoByName('IP');

if ProtoEnt = nil then

Result := False

end;

finally

WSACleanup;

end;

end;
1、用HTTP从网站下载文件：

方法一，用IdHttp：

procedure TForm1.Button1Click(Sender: Tobject);

var

fs: TFileStream;

begin

fs := TFileStream.Create('c:\aaa.htm', fmCreate);

IdHTTP1.Get('http://www.abc.com/aaa.shtml', fs);

fs.Free;

end;

方法二：

uses

UrlMon

function DownloadFile(Source, Dest: string): Boolean;

begin

try

Result := UrlDownloadToFile(nil, Pchar(source), Pchar(Dest), 0, nil) = 0;

except

Result := False;

end;

end;

procedure TForm1.Button1Click(Sender: Tobject);

begin

if DownloadFile(edit1.Text, edit2.Text) then

ShowMessage('下载成功')

else ShowMessage('下载失败');

end;

2、网络邻居复制文件：

uses shellapi;

copyfile(pchar('newfile.txt'),pchar('//computer/direct/targer.txt'),false);

3、取得WINDOWS目录：

方法一：

uses shellapi;

var windir:array[0..255] of char;

getwindowsdirectory(windir,sizeof(windir));

方法二：

从注册表中读取，位置：

HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion

SystemRoot键，取得如：C:\WINDOWS

4、对文件、目录进行操作：

Chdir('c:\abcdir');转到目录

Mkdir('dirname');建立目录

Rmdir('dirname');删除目录

GetCurrentDir;//取当前目录名，无'\'

Getdir(0,s);//取工作目录名s:='c:\abcdir';

Deletfile('abc.txt');//删除文件

Renamefile('old.txt','new.txt');//文件更名

ExtractFilename(filelistbox1.filename);//取文件名

ExtractFileExt(filelistbox1.filename);//取文件后缀

5、取得系统运行的进程名：

var hCurrentWindow:HWnd;szText:array[0..254] of char;

begin

hCurrentWindow:=Getwindow(handle,GW_HWndFrist);

while hCurrentWindow <> 0 do

begin

if Getwindowtext(hcurrnetwindow,@sztext,255)>0 then listbox1.items.add(strpas(@sztext));

hCurrentWindow:=Getwindow(hCurrentwindow,GW_HWndNext);

end;

end;

6、操作Cookie：

response.cookies("name").domain:='http://www.aaa.com';

with response.cookies.add do

begin

name:='username';

value:='username';

end;

7、按键接受消息：

OnCreate事件中处理：Application.OnMessage:=MyOnMessage;

procedure Tform1.MyOnMessage(var MSG:TMSG;var Handle:Boolean);

begin

if msg.message=256 then … //ANY键

if msg.message=112 then … //F1

if msg.message=113 then … //F2

end;

8、判断拨号网络是开还是关：

if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then

showmessage('在线!')

else showmessage('不在线!');

9、IP到域名的转换：

function GetDomainName(Ip:string):string;

var

pH:Phostent;

data:twsadata;

ii:dword;

begin

WSAStartup($101, Data);

ii:=inet_addr(pchar(ip));

pH:=gethostbyaddr(@ii,sizeof(ii),PF_INET);

if (ph<>nil) then

result:=pH.h_name

else

result:='';

WSACleanup;

end;

10、解除interbase默认只能连5个客户端的限制：

必须硬盘安装，如果是用的光盘，需要把光盘上IB6\SERVER目录COPY到硬盘，然后从硬盘安装。在SERVER目录下，记录ib_license.dat文件中的ID及KEY，再把下面这个ib_license.dat文件覆盖掉SERVER目录中的同名文件，然后开始安装，填写ID和KEY时用记录下的ID及KEY。

Ib_license.dat：

PRODUCT INTERBASE, OPTIONS QR, VERSION WI-V6.0, CERTIFICATE 100, ID VAR-10472, KEY a8-2-22-0, COMMENT InterBase Remote Client

PRODUCT INTERBASE, OPTIONS DEIQR, VERSION WI-V6.0, CERTIFICATE 50, USERS 2, ID VAR-13505, KEY 68-10-22-0PRODUCT INTERBASE, OPTIONS QR, VERSION WI-V6.0, CERTIFICATE 100, ID VAR-10472, KEY a8-2-22-1, COMMENT InterBase Remote Client

PRODUCT INTERBASE, OPTIONS DEIQRSW, VERSION WI-V6.0, CERTIFICATE 56, ID VAR-12345, KEY f7-13-a6-4

PRODUCT INTERBASE, OPTIONS R, VERSION WI-V6.0, CERTIFICATE 52, ID VAR-12347, KEY 1f-1-22-0

PRODUCT INTERBASE, OPTIONS DEIQR, VERSION WI-V6.0, CERTIFICATE 50, USERS 2, ID VAR-12348, KEY 3e-10-22-0

PRODUCT INTERBASE, OPTIONS S, VERSION WI-V6.0, CERTIFICATE 53, ID VAR-12349, KEY 2e-1-44-0

PRODUCT INTERBASE, OPTIONS D, VERSION WI-V6.0, CERTIFICATE 54, ID VAR-12350, KEY eb-1-0-0

PRODUCT INTERBASE, OPTIONS W, VERSION WI-V6.0, CERTIFICATE 60, ID VAR-12351, KEY 1a-1-40-4

PRODUCT INTERBASE, OPTIONS C3, VERSION WI-V6.0, CERTIFICATE 70, ID VAR-12353, KEY be-1-11-10

PRODUCT INTERBASE, OPTIONS A, VERSION WI-V6.0, CERTIFICATE 71, ID VAR-12354, KEY 87-1-0-0

PRODUCT INTERBASE, OPTIONS F, VERSION WI-V6.0, CERTIFICATE 72, ID VAR-12344, KEY 7c-f-0-0

PRODUCT INTERBASE, OPTIONS F, VERSION WI-V6.0, CERTIFICATE 72, ID VAR-99999, KEY ff-2-0-0

PRODUCT INTERBASE, OPTIONS 2, VERSION WI-V6.0, CERTIFICATE 73, ID VAR-11111, KEY 20-1-0-88

PRODUCT INTERBASE, OPTIONS P, VERSION WI-V6.0, CERTIFICATE 74, ID VAR-22222, KEY 10-82-8-0

PRODUCT INTERBASE, OPTIONS Y, VERSION WI-V6.0, CERTIFICATE 81, ID VAR-44444, KEY d3-3-0-11

PRODUCT INTERBASE, OPTIONS 5, VERSION WI-V6.0, CERTIFICATE 82, ID VAR-55555, KEY a5-3-0-40

PRODUCT INTERBASE, OPTIONS T, VERSION WI-V6.0, CERTIFICATE 83, ID VAR-66666, KEY f7-3-88-0

今日试左下【GetSystemMetrics(SM_NETWORK) <> 0】好似无论开停网卡，返回值都系$3，估计这个API函数用在以太网上不适合，可能拨号网络会返回正确值