DELPHI 小结

//十六进制(S)-->>十进制(I)  [重写:Jey]
function hextoint(s: string): Integer; 
begin           //$代表16进制
  Result:=StrToInt('$'+s);
end;

//十进制转换为二进制字符串  [重写:Jey]
function inttoBin(i: integer): string;
begin
 while i <>0 do
 begin              //i mod 2取模,再使用format格式化
   result:=Format('%d'+result,[i mod 2]);
   i:=i div 2
 end
end;
//二进制(S)-->>十进制(D)    [重写:Jey]
uses Math;
function hextoint(s: string): Double;
begin
  while Length(s) <>0 do
  begin              //2^(长度-1)次方
    if s[1]='1' then  Result:=Result+power(2,Length(s)-1);
    s:=Copy(s,2,Length(s));
  end
end;
//十进制(I)-->>十六进制(S)
//D自带函数,Digits长度,一般设4.
function IntToHex(Value: Integer; Digits: Integer): string;

//数据(S)-->>二进制(S)
//任何数据都是以二进制形式存储的！ (转)
function conertde(s:string):string;
var
 i:integer;
begin
 for i:=1 to length(s) do
   result:=result+inttohex(ord(s[i]),2);
end; 






一、WSAStartup函数
int WSAStartup(
WORD wVersionRequested,
LPWSADATA lpWSAData
);
使 用Socket的程序在使用Socket之前必须调用WSAStartup函数。该函数的第一个参数指明程序请求使用的Socket版本，其中高位字节指 明副版本、低位字节指明主版本；操作系统利用第二个参数返回请求的Socket的版本信息。当一个应用程序调用WSAStartup函数时，操作系统根据 请求的Socket版本来搜索相应的Socket库，然后绑定找到的Socket库到该应用程序中。以后应用程序就可以调用所请求的Socket库中的其 它Socket函数了。该函数执行成功后返回0。
例：假如一个程序要使用2.1版本的Socket,那么程序代码如下
wVersionRequested = MAKEWORD( 2, 1 );
err = WSAStartup( wVersionRequested, &wsaData );

二、WSACleanup函数
int WSACleanup (void);
应用程序在完成对请求的Socket库的使用后，要调用WSACleanup函数来解除与Socket库的绑定并且释放Socket库所占用的系统资源。

三、socket函数
SOCKET socket(
int af,
int type,
int protocol
);
应 用程序调用socket函数来创建一个能够进行网络通信的套接字。第一个参数指定应用程序使用的通信协议的协议族，对于TCP/IP协议族，该参数置 PF_INET;第二个参数指定要创建的套接字类型，流套接字类型为SOCK_STREAM、数据报套接字类型为SOCK_DGRAM；第三个参数指定应 用程序所使用的通信协议。该函数如果调用成功就返回新创建的套接字的描述符，如果失败就返回INVALID_SOCKET。套接字描述符是一个整数类型的 值。每个进程的进程空间里都有一个套接字描述符表，该表中存放着套接字描述符和套接字数据结构的对应关系。该表中有一个字段存放新创建的套接字的描述符， 另一个字段存放套接字数据结构的地址，因此根据套接字描述符就可以找到其对应的套接字数据结构。每个进程在自己的进程空间里都有一个套接字描述符表但是套 接字数据结构都是在操作系统的内核缓冲里。下面是一个创建流套接字的例子：
struct protoent *ppe;
ppe=getprotobyname("tcp");
SOCKET ListenSocket=socket(PF_INET,SOCK_STREAM,ppe->p_proto);

四、closesocket函数
int closesocket(
SOCKET s
);
closesocket 函数用来关闭一个描述符为s套接字。由于每个进程中都有一个套接字描述符表，表中的每个套接字描述符都对应了一个位于操作系统缓冲区中的套接字数据结构， 因此有可能有几个套接字描述符指向同一个套接字数据结构。套接字数据结构中专门有一个字段存放该结构的被引用次数，即有多少个套接字描述符指向该结构。当 调用closesocket函数时，操作系统先检查套接字数据结构中的该字段的值，如果为1，就表明只有一个套接字描述符指向它，因此操作系统就先把s在 套接字描述符表中对应的那条表项清除，并且释放s对应的套接字数据结构；如果该字段大于1，那么操作系统仅仅清除s在套接字描述符表中的对应表项，并且把 s对应的套接字数据结构的引用次数减1。
closesocket函数如果执行成功就返回0，否则返回SOCKET_ERROR。

五、send函数
int send(
SOCKET s,
const char FAR *buf,
int len,
int flags
);
不 论是客户还是服务器应用程序都用send函数来向TCP连接的另一端发送数据。客户程序一般用send函数向服务器发送请求，而服务器则通常用send函 数来向客户程序发送应答。该函数的第一个参数指定发送端套接字描述符；第二个参数指明一个存放应用程序要发送数据的缓冲区；第三个参数指明实际要发送的数 据的字节数；第四个参数一般置0。这里只描述同步Socket的send函数的执行流程。当调用该函数时，send先比较待发送数据的长度len和套接字 s的发送缓冲区的长度，如果len大于s的发送缓冲区的长度，该函数返回SOCKET_ERROR；如果len小于或者等于s的发送缓冲区的长度，那么 send先检查协议是否正在发送s的发送缓冲中的数据，如果是就等待协议把数据发送完，如果协议还没有开始发送s的发送缓冲中的数据或者s的发送缓冲中没 有数据，那么send就比较s的发送缓冲区的剩余空间和len，如果len大于剩余空间大小send就一直等待协议把s的发送缓冲中的数据发送完，如果 len小于剩余空间大小send就仅仅把buf中的数据copy到剩余空间里（注意并不是send把s的发送缓冲中的数据传到连接的另一端的，而是协议传 的，send仅仅是把buf中的数据copy到s的发送缓冲区的剩余空间里）。如果send函数copy数据成功，就返回实际copy的字节数，如果 send在copy数据时出现错误，那么send就返回SOCKET_ERROR；如果send在等待协议传送数据时网络断开的话，那么send函数也返 回SOCKET_ERROR。要注意send函数把buf中的数据成功copy到s的发送缓冲的剩余空间里后它就返回了，但是此时这些数据并不一定马上被 传到连接的另一端。如果协议在后续的传送过程中出现网络错误的话，那么下一个Socket函数就会返回SOCKET_ERROR。（每一个除send外的 Socket函数在执行的最开始总要先等待套接字的发送缓冲中的数据被协议传送完毕才能继续，如果在等待时出现网络错误，那么该Socket函数就返回 SOCKET_ERROR）
注意：在Unix系统下，如果send在等待协议传送数据时网络断开的话，调用send的进程会接收到一个SIGPIPE信号，进程对该信号的默认处理是进程终止。

六、recv函数
int recv(
SOCKET s,
char FAR *buf,
int len,
int flags
);
不 论是客户还是服务器应用程序都用recv函数从TCP连接的另一端接收数据。该函数的第一个参数指定接收端套接字描述符；第二个参数指明一个缓冲区，该缓 冲区用来存放recv函数接收到的数据；第三个参数指明buf的长度；第四个参数一般置0。这里只描述同步Socket的recv函数的执行流程。当应用 程序调用recv函数时，recv先等待s的发送缓冲中的数据被协议传送完毕，如果协议在传送s的发送缓冲中的数据时出现网络错误，那么recv函数返回 SOCKET_ERROR，如果s的发送缓冲中没有数据或者数据被协议成功发送完毕后，recv先检查套接字s的接收缓冲区，如果s接收缓冲区中没有数据 或者协议正在接收数据，那么recv就一直等待，只到协议把数据接收完毕。当协议把数据接收完毕，recv函数就把s的接收缓冲中的数据copy到buf 中（注意协议接收到的数据可能大于buf的长度，所以在这种情况下要调用几次recv函数才能把s的接收缓冲中的数据copy完。recv函数仅仅是 copy数据，真正的接收数据是协议来完成的），recv函数返回其实际copy的字节数。如果recv在copy时出错，那么它返回 SOCKET_ERROR；如果recv函数在等待协议接收数据时网络中断了，那么它返回0。
注意：在Unix系统下，如果recv函数在等待协议接收数据时网络断开了，那么调用recv的进程会接收到一个SIGPIPE信号，进程对该信号的默认处理是进程终止。

七、bind函数
int bind(
SOCKET s,
const struct sockaddr FAR *name,
int namelen
);
当 创建了一个Socket以后，套接字数据结构中有一个默认的IP地址和默认的端口号。一个服务程序必须调用bind函数来给其绑定一个IP地址和一个特定 的端口号。客户程序一般不必调用bind函数来为其Socket绑定IP地址和断口号。该函数的第一个参数指定待绑定的Socket描述符；第二个参数指 定一个sockaddr结构，该结构是这样定义的：
struct sockaddr {
u_short sa_family;
char sa_data[14];
};
sa_family指定地址族，对于TCP/IP协议族的套接字，给其置AF_INET。当对TCP/IP协议族的套接字进行绑定时，我们通常使用另一个地址结构：
struct sockaddr_in {
short sin_family;
u_short sin_port;
struct in_addr sin_addr;
char sin_zero[8];
};
其 中sin_family置AF_INET；sin_port指明端口号；sin_addr结构体中只有一个唯一的字段s_addr，表示IP地址，该字段 是一个整数，一般用函数inet_addr（）把字符串形式的IP地址转换成unsigned long型的整数值后再置给s_addr。有的服务器是多宿主机，至少有两个网卡，那么运行在这样的服务器上的服务程序在为其Socket绑定IP地址时 可以把htonl(INADDR_ANY)置给s_addr，这样做的好处是不论哪个网段上的客户程序都能与该服务程序通信；如果只给运行在多宿主机上的 服务程序的Socket绑定一个固定的IP地址，那么就只有与该IP地址处于同一个网段上的客户程序才能与该服务程序通信。我们用0来填充 sin_zero数组，目的是让sockaddr_in结构的大小与sockaddr结构的大小一致。下面是一个bind函数调用的例子：
struct sockaddr_in saddr；
saddr.sin_family = AF_INET;
saddr.sin_port = htons(8888);
saddr.sin_addr.s_addr = htonl(INADDR_ANY);
bind(ListenSocket,(struct sockaddr *)&saddr,sizeof(saddr))；

八、listen函数
int listen( SOCKET s, int backlog );
服务程序可以调用listen函数使其流套接字s处于监听状态。处于监听状态的流套接字s将维护一个客户连接请求队列，该队列最多容纳backlog个客户连接请求。假如该函数执行成功，则返回0；如果执行失败，则返回SOCKET_ERROR。

九、accept函数
SOCKET accept(
SOCKET s,
struct sockaddr FAR *addr,
int FAR *addrlen
);
服 务程序调用accept函数从处于监听状态的流套接字s的客户连接请求队列中取出排在最前的一个客户请求，并且创建一个新的套接字来与客户套接字创建连接 通道，如果连接成功，就返回新创建的套接字的描述符，以后与客户套接字交换数据的是新创建的套接字；如果失败就返回INVALID_SOCKET。该函数 的第一个参数指定处于监听状态的流套接字；操作系统利用第二个参数来返回连接客户的地址结构；操作系统利用第三个参数来返回地址结构addr的长度。下面 是一个调用accept的例子：
struct sockaddr_in ServerSocketAddr;
int addrlen;
addrlen=sizeof(ServerSocketAddr);
ServerSocket=accept(ListenSocket,(struct sockaddr *)&ServerSocketAddr,&addrlen);

十、connect函数
int connect(
SOCKET s,
const struct sockaddr FAR *name,
int namelen
);
客户程序调用connect函数来使客户Socket s与监听于name所指定的计算机的特定端口上的服务Socket进行连接。如果连接成功，connect返回0；如果失败则返回SOCKET_ERROR。下面是一个例子：
struct sockaddr_in daddr;
memset((void *)&daddr,0,sizeof(daddr));
daddr.sin_family=AF_INET;
daddr.sin_port=htons(8888);
daddr.sin_addr.s_addr=inet_addr("133.197.22.4");
connect(ClientSocket,(struct sockaddr *)&daddr,sizeof(daddr))；



MessageBox对话框是比较常用的一个信息对话框，其不仅能够定义显示的信息内容、信息提示图标，而且可以定义按钮组合及对话框的标题，是一个功能齐全的信息对话框信息提示图标，而且可以定义按钮组合及对话框的标题，是一个功能齐全的信息对框。
　1、函数原型及参数
　function MessageBox(hWnd: HWND; Text, Caption: PChar; Type: Word): Integer;
　hWnd：对话框父窗口句柄，对话框显示在Delphi窗体内，可使用窗体的Handle属性，否则可用0，使其直接作为桌面窗口的子窗口。
　Text：欲显示的信息字符串。
　Caption：对话框标题字符串。
　Type：对话框类型常量。
　该函数的返回值为整数，用于对话框按钮的识别。
　2、类型常量
　对话框的类型常量可由按钮组合、缺省按钮、显示图标、运行模式四种常量组合而成。
　（1）按钮组合常量
　MB_OK = $00000000;　　　　　　　　　//一个确定按钮
　MB_OKCANCEL = $00000001;　　　　　　//一个确定按钮，一个取消按钮
　MB_ABORTRETRYIGNORE = $00000002;　　//一个异常终止按钮，一个重试按钮，一个忽略按钮
　MB_YESNOCANCEL = $00000003;　　　　 //一个是按钮，一个否按钮，一个取消按钮
　MB_YESNO = $00000004;　　　　　　　 //一个是按钮，一个否按钮
　MB_RETRYCANCEL = $00000005;　　　　 //一个重试按钮，一个取消按钮
　（2）缺省按钮常量
　MB_DEFBUTTON1 = $00000000;　　　　　//第一个按钮为缺省按钮
　MB_DEFBUTTON2 = $00000100;　　　　　//第二个按钮为缺省按钮
　MB_DEFBUTTON3 = $00000200;　　　　　//第三个按钮为缺省按钮
　MB_DEFBUTTON4 = $00000300;　　　　　//第四个按钮为缺省按钮
　（3）图标常量
　MB_ICONHAND = $00000010;　　　　　　　 //“×”号图标
　MB_ICONQUESTION = $00000020;　　　　　 //“？”号图标
　MB_ICONEXCLAMATION = $00000030;　　　　//“！”号图标
　MB_ICONASTERISK = $00000040;　　　　　 //“i”图标
　MB_USERICON = $00000080;　　　　　　　 //用户图标
　MB_ICONWARNING = MB_ICONEXCLAMATION;　 //“！”号图标
　MB_ICONERROR = MB_ICONHAND;　　　　　　//“×”号图标
　MB_ICONINFORMATION = MB_ICONASTERISK;　//“i”图标
　MB_ICONSTOP = MB_ICONHAND;　　　　　　 //“×”号图标
　（4）运行模式常量
　MB_APPLMODAL = $00000000;　　　　//应用程序模式，在未结束对话框前也能切换到另一应用程序
　MB_SYSTEMMODAL = $00001000;　　　//系统模式，必须结束对话框后，才能做其他操作
　MB_TASKMODAL = $00002000;　　　　//任务模式，在未结束对话框前也能切换到另一应用程序
　MB_HELP = $00004000;　　　　　　 //Help Button
　3、函数返回值
　0　　　　　　　　　　　 //对话框建立失败
　idOk = 1　　　　　　　　//按确定按钮
　idCancel = 2　　　　　　//按取消按钮
　idAbout = 3　　　　　　 //按异常终止按钮
　idRetry = 4　　　　　　 //按重试按钮
　idIgnore = 5　　　　　　//按忽略按钮
　idYes = 6　　　　　　　 //按是按钮
　idNo = 7　　　　　　　　//按否按钮



◇[DELPHI]转换函数的定义及说明
datetimetofiledate (datetime:Tdatetime):longint; 将Tdatetime格式的日期时间值转换成DOS格式的日期时间值
datetimetostr (datetime:Tdatetime):string; 将Tdatatime格式变量转换成字符串，如果datetime参数不包含日期值，返回字符串日期显示成为00/00/00，如果datetime参数 中没有时间值，返回字符串中的时间部分显示成为00：00：00 AM
datetimetostring (var result string;
const format:string;
datetime:Tdatetime); 根据给定的格式字符串转换时间和日期值，result为结果字符串，format为转换格式字符串，datetime为日期时间值
datetostr (date:Tdatetime) 使用shortdateformat全局变量定义的格式字符串将date参数转换成对应的字符串
floattodecimal (var result:Tfloatrec;value:
extended;precision,decimals:
integer); 将浮点数转换成十进制表示
floattostr (value:extended):string 将浮点数value转换成字符串格式，该转换使用普通数字格式，转换的有效位数为15位。
floattotext (buffer:pchar;value:extended;
format:Tfloatformat;precision,
digits:integer):integer; 用给定的格式、精度和小数将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函数返回值为存储到buffer中的字符位数，buffer是非0结果的字符串缓冲区。
floattotextfmt (buffer:pchar;value:extended;
format:pchar):integer 用给定的格式将浮点值value转换成十进制表示形式，转换结果存放于buffer参数中，函数返回值为存储到buffer中的字符位数。
inttohex (value:longint;digits:integer):
string; 将给定的数值value转换成十六进制的字符串。参数digits给出转换结果字符串包含的数字位数。
inttostr (value:longint):string 将整数转换成十进制形式字符串
strtodate (const S:string):Tdatetime 将字符串转换成日期值，S必须包含一个合法的格式日期的字符串。
strtodatetime (const S:string):Tdatetime 将字符串S转换成日期时间格式，S必须具有MM/DD/YY HH：MM：SS[AM|PM]格式，其中日期和时间分隔符与系统时期时间常量设置相关。如果没有指定AM或PM信息，表示使用24小时制。
strtofloat (const S:string):extended; 将给定的字符串转换成浮点数，字符串具有如下格式：
[+|-]nnn…[.]nnn…[<+|-><E|e><+|->nnnn]
strtoint (const S:string):longint 将数字字符串转换成整数，字符串可以是十进制或十六进制格式，如果字符串不是一个合法的数字字符串，系统发生ECONVERTERROR异常
strtointdef (const S:string;default:
longint):longint; 将字符串S转换成数字，如果不能将S转换成数字，strtointdef函数返回参数default的值。
strtotime (const S:string):Tdatetime 将字符串S转换成TDATETIME值，S具有HH：MM：SS[AM|PM]格式，实际的格式与系统的时间相关的全局变量有关。
timetostr (time:Tdatetime):string; 将参数TIME转换成字符串。转换结果字符串的格式与系统的时间相关常量的设置有关。

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;

{=================================================================
  功  能: 返回网络中的共享资源
  参  数:
          ipaddr: 机器ip
          list: 需要填充的list
  返回值: 成功:  true,并填充list 失败: false;
  备 注:
     wnetopenenum function starts an enumeration of network
     resources or existing connections.
     wnetenumresource function continues a network-resource
     enumeration started by the wnetopenenum function.
  版 本:
     1.0  2002/10/03 07:30:00
=================================================================}
function getuserresource(ipaddr: string; var list: tstringlist): boolean;
type
  tnetresourcearray = ^tnetresource;//网络类型的数组
var
  i: integer;
  buf: pointer;
  temp: tnetresourcearray;
  lphenum: thandle;
  netresource: tnetresource;
  count,bufsize,res: dword;
begin
  result := false;
  list.clear;
  if copy(ipaddr,0,2) <> '\\' then
    ipaddr := '\\'+ipaddr;   //填充ip地址信息
  fillchar(netresource, sizeof(netresource), 0);//初始化网络层次信息
  netresource.lpremotename := @ipaddr[1];//指定计算机名称
  //获取指定计算机的网络资源句柄
  res := wnetopenenum( resource_globalnet, resourcetype_any,
                      resourceusage_connectable, @netresource,lphenum);
  if res <> no_error then exit;//执行失败
  while true do//列举指定工作组的网络资源
  begin
    count := $ffffffff;//不限资源数目
    bufsize := 8192;//缓冲区大小设置为8k
    getmem(buf, bufsize);//申请内存，用于获取工作组信息
    //获取指定计算机的网络资源名称
    res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
    if res = error_no_more_items then break;//资源列举完毕
    if (res <> no_error) then exit;//执行失败
    temp := tnetresourcearray(buf);
    for i := 0 to count - 1 do
    begin
       //获取指定计算机中的共享资源名称，+2表示删除"\\"，
       //如\\192.168.0.1 => 192.168.0.1
       list.add(temp^.lpremotename + 2);
       inc(temp);
    end;
  end;
  res := wnetcloseenum(lphenum);//关闭一次列举
  if res <> no_error then exit;//执行失败
  result := true;
  freemem(buf);
end;

{=================================================================
  功  能: 返回网络中的工作组
  参  数:
          list: 需要填充的list
  返回值: 成功:  true,并填充list 失败: false;
  备  注:
  版  本:
     1.0  2002/10/03 08:00:00
=================================================================}
function getgrouplist( var list : tstringlist ) : boolean;
type
  tnetresourcearray = ^tnetresource;//网络类型的数组
var
  netresource: tnetresource;
  buf: pointer;
  count,bufsize,res: dword;
  lphenum: thandle;
  p: tnetresourcearray;
  i,j: smallint;
  networktypelist: tlist;
begin
  result := false;
  networktypelist := tlist.create;
  list.clear;
  //获取整个网络中的文件资源的句柄，lphenum为返回名柄
  res := wnetopenenum( resource_globalnet, resourcetype_disk,
                       resourceusage_container, nil,lphenum);
  if res <> no_error then exit;//raise exception(res);//执行失败
  //获取整个网络中的网络类型信息
  count := $ffffffff;//不限资源数目
  bufsize := 8192;//缓冲区大小设置为8k
  getmem(buf, bufsize);//申请内存，用于获取工作组信息
  res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
     //资源列举完毕                    //执行失败
  if ( res = error_no_more_items ) or (res <> no_error ) then exit;
  p := tnetresourcearray(buf);
  for i := 0 to count - 1 do//记录各个网络类型的信息
  begin
    networktypelist.add(p);
    inc(p);
  end;
  res := wnetcloseenum(lphenum);//关闭一次列举
  if res <> no_error then exit;
  for j := 0 to networktypelist.count-1 do //列出各个网络类型中的所有工作组名称
  begin//列出一个网络类型中的所有工作组名称
    netresource := tnetresource(networktypelist.items[j]^);//网络类型信息
    //获取某个网络类型的文件资源的句柄，netresource为网络类型信息，lphenum为返回名柄
    res := wnetopenenum(resource_globalnet, resourcetype_disk,
                        resourceusage_container, @netresource,lphenum);
    if res <> no_error then break;//执行失败
    while true do//列举一个网络类型的所有工作组的信息
    begin
      count := $ffffffff;//不限资源数目
      bufsize := 8192;//缓冲区大小设置为8k
      getmem(buf, bufsize);//申请内存，用于获取工作组信息
      //获取一个网络类型的文件资源信息，
      res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
          //资源列举完毕                   //执行失败
      if ( res = error_no_more_items ) or (res <> no_error)  then break;
      p := tnetresourcearray(buf);
      for i := 0 to count - 1 do//列举各个工作组的信息
      begin
        list.add( strpas( p^.lpremotename ));//取得一个工作组的名称
        inc(p);
      end;
    end;
    res := wnetcloseenum(lphenum);//关闭一次列举
    if res <> no_error then break;//执行失败
  end;
  result := true;
  freemem(buf);
  networktypelist.destroy;
end;

{=================================================================
  功  能: 列举工作组中所有的计算机
  参  数:
          list: 需要填充的list
  返回值: 成功:  true,并填充list 失败: false;
  备  注:
  版  本:
     1.0  2002/10/03 08:00:00
=================================================================}
function getusers(groupname: string; var list: tstringlist): boolean;
type
  tnetresourcearray = ^tnetresource;//网络类型的数组
var
  i: integer;
  buf: pointer;
  temp: tnetresourcearray;
  lphenum: thandle;
  netresource: tnetresource;
  count,bufsize,res: dword;
begin
  result := false;
  list.clear;
  fillchar(netresource, sizeof(netresource), 0);//初始化网络层次信息
  netresource.lpremotename := @groupname[1];//指定工作组名称
  netresource.dwdisplaytype := resourcedisplaytype_server;//类型为服务器（工作组）
  netresource.dwusage := resourceusage_container;
  netresource.dwscope := resourcetype_disk;//列举文件资源信息
  //获取指定工作组的网络资源句柄
  res := wnetopenenum( resource_globalnet, resourcetype_disk,
                        resourceusage_container, @netresource,lphenum);
  if res <> no_error then exit; //执行失败
  while true do//列举指定工作组的网络资源
  begin
    count := $ffffffff;//不限资源数目
    bufsize := 8192;//缓冲区大小设置为8k
    getmem(buf, bufsize);//申请内存，用于获取工作组信息
    //获取计算机名称
    res := wnetenumresource(lphenum, count, pointer(buf), bufsize);
    if res = error_no_more_items then break;//资源列举完毕
    if (res <> no_error) then exit;//执行失败
    temp := tnetresourcearray(buf);
    for i := 0 to count - 1 do//列举工作组的计算机名称
    begin
      //获取工作组的计算机名称，+2表示删除"\\"，如\\wangfajun=>wangfajun
      list.add(temp^.lpremotename + 2);
      inc(temp);
    end;
  end;
  res := wnetcloseenum(lphenum);//关闭一次列举
  if res <> no_error then exit;//执行失败
  result := true;
  freemem(buf);
end;

{=================================================================
  功  能: 列举所有网络类型
  参  数:
          list: 需要填充的list
  返回值: 成功:  true,并填充list 失败: false;
  备 注:
  版 本:
     1.0  2002/10/03 08:54:00
=================================================================}
function getnetlist(var list: tstringlist): boolean;
type
  tnetresourcearray = ^tnetresource;//网络类型的数组
var
  p: tnetresourcearray;
  buf: pointer;
  i: smallint;
  lphenum: thandle;
  netresource: tnetresource;
  count,bufsize,res: dword;
begin
  result := false;
  list.clear;
  res := wnetopenenum( resource_globalnet, resourcetype_disk,
                      resourceusage_container, nil,lphenum);
  if res <> no_error then exit;//执行失败
  count := $ffffffff;//不限资源数目
  bufsize := 8192;//缓冲区大小设置为8k
  getmem(buf, bufsize);//申请内存，用于获取工作组信息
  res := wnetenumresource(lphenum, count, pointer(buf), bufsize);//获取网络类型信息
      //资源列举完毕                    //执行失败
  if ( res = error_no_more_items ) or (res <> no_error ) then exit;
  p := tnetresourcearra

{=================================================================
  功  能: 映射网络驱动器
  参  数:
          netpath: 想要映射的网络路径
          password: 访问密码
          localpath 本地路径
  返回值: 成功:  true  失败: false;
  备 注:
  版 本:
     1.0  2002/10/03 09:24:00
=================================================================}
function netaddconnection(netpath: pchar; password: pchar
                          ;localpath: pchar): boolean;
var
  res: dword;
begin
  result := false;
  res := wnetaddconnection(netpath,password,localpath);
  if res <> no_error then exit;
  result := true;
end;

{=================================================================
  功  能:  检测网络状态
  参  数:
          ipaddr: 被测试网络上主机的ip地址或名称，建议使用ip
  返回值: 成功:  true  失败: false;
  备 注:
  版 本:
     1.0  2002/10/03 09:40:00
=================================================================}
function checknet(ipaddr: string): boolean;
type
  pipoptioninformation = ^tipoptioninformation;
  tipoptioninformation = packed record
     ttl:         byte;      // time to live (used for traceroute)
     tos:         byte;      // type of service (usually 0)
     flags:       byte;      // ip header flags (usually 0)
     optionssize: byte;      // size of options data (usually 0, max 40)
     optionsdata: pchar;     // options data buffer
  end;

  picmpechoreply = ^ticmpechoreply;
  ticmpechoreply = packed record
     address:       dword;                // replying address
     status:        dword;                // ip status value (see below)
     rtt:           dword;                // round trip time in milliseconds
     datasize:      word;                 // reply data size
     reserved:      word;
     data:          pointer;              // pointer to reply data buffer
     options:       tipoptioninformation; // reply options
  end;

  ticmpcreatefile = function: thandle; stdcall;
  ticmpclosehandle = function(icmphandle: thandle): boolean; stdcall;
  ticmpsendecho = function(
     icmphandle:          thandle;
     destinationaddress:  dword;
     requestdata:         pointer;
     requestsize:         word;
     requestoptions:      pipoptioninformation;
     replybuffer:         pointer;
     replysize:           dword;
     timeout:             dword
  ): dword; stdcall;

const
  size = 32;
  timeout = 1000;
var
  wsadata: twsadata;
  address: dword;                     // address of host to contact
  hostname, hostip: string;           // name and dotted ip of host to contact
  phe: phostent;                      // hostentry buffer for name lookup
  buffersize, npkts: integer;
  preqdata, pdata: pointer;
  pipe: picmpechoreply;               // icmp echo reply buffer
  ipopt: tipoptioninformation;        // ip options for packet to send
const
  icmpdll = 'icmp.dll';
var
  hicmplib: hmodule;
  icmpcreatefile : ticmpcreatefile;
  icmpclosehandle: ticmpclosehandle;
  icmpsendecho:    ticmpsendecho;
  hicmp: thandle;                     // handle for the icmp calls
begin
  // initialise winsock
  result:=true;
  if wsastartup(2,wsadata) <> 0 then begin
     result:=false;
     halt;
  end;
  // register the icmp.dll stuff
  hicmplib := loadlibrary(icmpdll);
  if hicmplib <> null then begin
    @icmpcreatefile := getprocaddress(hicmplib, 'icmpcreatefile');
    @icmpclosehandle:= getprocaddress(hicmplib, 'icmpclosehandle');
    @icmpsendecho:= getprocaddress(hicmplib, 'icmpsendecho');
    if (@icmpcreatefile = nil) or (@icmpclosehandle = nil) or (@icmpsendecho = nil) then begin
        result:=false;
        halt;
    end;
    hicmp := icmpcreatefile;
    if hicmp = invalid_handle_value then begin
      result:=false;
      halt;
    end;
  end else begin
    result:=false;
    halt;
  end;
// ------------------------------------------------------------
  address := inet_addr(pchar(ipaddr));
  if (address = inaddr_none) then begin
    phe := gethostbyname(pchar(ipaddr));
    if phe = nil then result:=false
    else begin
      address := longint(plongint(phe^.h_addr_list^)^);
      hostname := phe^.h_name;
      hostip := strpas(inet_ntoa(tinaddr(address)));
    end;
  end
  else begin
    phe := gethostbyaddr(@address, 4, pf_inet);
    if phe = nil then result:=false;
  end;

  if address = inaddr_none then
  begin
     result:=false;
  end;
  // get some data buffer space and put something in the packet to send
  buffersize := sizeof(ticmpechoreply) + size;
  getmem(preqdata, size);
  getmem(pdata, size);
  getmem(pipe, buffersize);
  fillchar(preqdata^, size, $aa);
  pipe^.data := pdata;

    // finally send the packet
  fillchar(ipopt, sizeof(ipopt), 0);
  ipopt.ttl := 64;
  npkts := icmpsendecho(hicmp, address, preqdata, size,
                        @ipopt, pipe, buffersize, timeout);
  if npkts = 0 then result:=false;

  // free those buffers
  freemem(pipe); freemem(pdata); freemem(preqdata);

// --------------------------------------------------------------
  icmpclosehandle(hicmp);
  freelibrary(hicmplib);
  // free winsock
  if wsacleanup <> 0 then result:=false;
end;


{=================================================================
  功  能:  检测计算机是否上网
  参  数:  无
  返回值:  成功:  true  失败: false;
  备 注:   uses wininet
  版 本:
     1.0  2002/10/07 13:33:00
=================================================================}
function internetconnected: boolean;
const
  // local system uses a modem to connect to the internet.
  internet_connection_modem      = 1;
  // local system uses a local area network to connect to the internet.
  internet_connection_lan        = 2;
  // local system uses a proxy server to connect to the internet.
  internet_connection_proxy      = 4;
  // local system's modem is busy with a non-internet connection.
  internet_connection_modem_busy = 8;
var
  dwconnectiontypes : dword;
begin
  dwconnectiontypes := internet_connection_modem+ internet_connection_lan
  + internet_connection_proxy;
  result := internetgetconnectedstate(@dwconnectiontypes, 0);
end;

end.
//错误信息常量
unit head;

interface
const
  c_err_getlocalip       = '获取本地ip失败';
  c_err_getnamebyipaddr  = '获取主机名失败';
  c_err_getsqlserverlist = '获取sqlserver服务器失败';
  c_err_getuserresource  = '获取共享资失败';
  c_err_getgrouplist     = '获取所有工作组失败';
  c_err_getgroupusers    = '获取工作组中所有计算机失败';
  c_err_getnetlist       = '获取所有网络类型失败';
  c_err_checknet         = '网络不通';
  c_err_checkattachnet   = '未登入网络';
  c_err_internetconnected ='没有上网';
 
  c_txt_checknetsuccess  = '网络畅通';
  c_txt_checkattachnetsuccess = '已登入网络';
  c_txt_internetconnected ='上网了';

implementation

end.



得到WINDOWS的SYSTEM路径:
   方法:
            var
                 MySysPath : PCHAR ;
            begin
                    GetMem(MySysPath,255);
                    GetSystemDirectory(MySysPath,255);
            end;
   注:MySysPath为SYSTEM路径

得到程序的路径
 ExtractFileDir(Application.Exename);

察看文件是否存在
 FileExists(FileName:String):Boolean;

改变文件扩展名
 ChangeFileExt(FileName:String)

得到文件的扩展名
 ExtractFileExt(FileName:String):String;

如何取得Windows的临时文件目录?
适合版本:Delphi 3,2.0,1.0

Windows 95 & NT都指定了放置临时文件的目录，然而，用户能改变临时目录的位置而不使用缺省的目录。这篇文章的目的是告诉你如何得到Windows 95 & NT当前的临时目录位置。这个Windows API函数 GetTempPath就是解决这个问题的。其函数原形为:

DWORD GetTempPath(DWORD nBufferLength, LPTSTR lpBuffer);

下面的例子示范如何使用：

function GetTempDirectory: String;
var
TempDir: array[0..255] of Char;
begin
GetTempPath(255, @TempDir);
Result := StrPas(TempDir);
end;

备注：临时目录的确定原则：
1,如果有TMP环境变量则临时目录为TMP指定的目录
2,如果没有TMP环境变量而有TEMP环境变量，则为TEMP变量指定的目录
3,如果TMP和TEMP都没有定义，则取当前目录为临时目录

程序不出现在任务栏
　　一般Windows 95运行程序时都会在任务栏上出现按钮，如果你的程序是一个监视程序，那么出现按钮就不是明智之举了。要实现该功能就要在OnCreate事件里利用到API函数SetWindowLong
procedure TForm1.FormCreate(sender:TObject);
begin
SetWindowLong(Application,Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

改计算机名

改变计算机在网络中的名字，重新启动后才生效
SetComputerName('Hello World');

控制热启动
要使系统的热启动键（Ctrl+Alt+Del）失效，使用以下语句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
要恢复系统的热启动键（Ctrl+Alt+Del），使用以下语句
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);

临时路径
有时需要Windows的临时路径来做备份等工作，那么就要知道路径在哪，下面的程序帮你忙：
var aa:pchar;
begin
GetTempPath(20,aa); file://返回路径名
edit1.text:=aa;
end;

返回程序执行参数
　　有关 Delphi 传入应用程式的命令列参数, 请参考以下的说明：
用ParamCount函数取得命令参数的个数:
呼叫 ParamStr(0), 传回执行档的档名(含路径)
呼叫 ParamStr(n), 传回第ｎ个参数的内容
procedure TForm1.FormCreate(Sender: TObject);
var
sFileName: string;
begin
if ParamCount > 0 then begin (* 有执行参数传入 *)
sFileName := ParamStr(1); (* 取得参数内容 *)
if FileExists(sFileName) then
Memo1.Lines.LoadFromFile(sFileName)
else
Application.MessageBox('找不到指定的档案', '讯息', 48);
end;
end;

关闭Windows
控制WINDOWS的开关：如关闭WINDOWS，重新启动WINDOWS等, ExitWindowsEx(UINT uFlags,DWORD dwReserved);是实现这一功能的API函数
首先定义常数
const
EWX_FORCE=4; file://关闭所有程序并以其他用户身份登录
EWX_LOGOFF=0; file://重新启动计算机并切换到MS-DOS方式
EWX_REBOOT=2; file://重新启动计算机
EWX_SHUTDOWN=1;//关闭计算机
运行时给How赋值，让他等于EWX_SHUTDOWN或其他，调用以下语句
ExitWindowsEx(How,0);

关闭外部应用程序
如何在 Delphi 应用程序中, 去关闭外部已开启的应用程序？
下面给出一段在 Delphi 中关闭"计算器"程序为例：
var
HWndCalculator : HWnd;
begin
// find the exist calculator window
HWndCalculator := Winprocs.FindWindow(nil, '计算器'); // close the exist Calculator
if HWndCalculator <> 0 then
SendMessage(HWndCalculator, WM_CLOSE, 0, 0);
end;

得到执行程序的目录
　　SysUtils 单元中有 ExtractFileDir 与 ExtractFilePath两个类似的函数, 用哪一个?没有太大的关系。
　　不过有以下的差别: ExtractFilePath 传回值的最後一个字元是反斜杠"／"。
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(ExtractFileDir(Application.Exename));
// ie: c:\temp
ShowMessage(ExtractFilePath(Application.Exename));
// ie: c:\temp\
end;
相同点： 如果执行文件在根目录下(如：C:\SAMPLE.EXE)的话, 两者的传回值相同， 且最后一个字符都是"／"。

使用GetFileVersionInfo 得到版本信息的例子 
Samples Using GetFileVersionInfo?
回答1:
 procedure GetBuildInfo(var V1, V2, V3, V4: Word);
 var
   VerInfoSize: DWORD;
   VerInfo: Pointer;
   VerValueSize: DWORD;
   VerValue: PVSFixedFileInfo;
   Dummy: DWORD;
 begin
 VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
 GetMem(VerInfo, VerInfoSize);
 GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
 VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
 with VerValue^ do
   begin
   V1 := dwFileVersionMS shr 16;
   V2 := dwFileVersionMS and $FFFF;
   V3 := dwFileVersionLS shr 16;
   V4 := dwFileVersionLS and $FFFF;
   end;
 FreeMem(VerInfo, VerInfoSize);
 end;

treeview 右键选中
procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  TreeNode: TTreeNode;
  l_lPARAM: LPARAM;
begin
  if Button <> mbRight then Exit;
  TreeNode := TreeView1.GetNodeAt(x, y);
  if TreeNode <> nil then
  begin
    TreeView1.Selected := TreeNode;
    l_Lparam := x + (y shl 16);
    sendmessage(Treeview1.Handle, WM_LBUTTONDOWN, MK_LBUTTON, L_lparam);
    sendmessage(Treeview1.Handle, WM_LBUTTONUP, MK_LBUTTON, L_lparam);
  end;

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有