一些DELPHI的函数

最新推荐文章于 2024-05-29 08:40:02 发布

百炼成钢百忍成佛

最新推荐文章于 2024-05-29 08:40:02 发布

阅读量1.4k

点赞数 1

分类专栏： delphi 文章标签： delphi function string sqlserver 网络 list

delphi 专栏收录该内容

78 篇文章 1 订阅

订阅专栏

{=============================================================
功能: 网络函数库
==============================================================}
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