高分请教：怎么样用delphi判断我的跟另外机子是否连接上？

可以用ping
function ping(ipaddress:string):boolean;
var
icmp:Ticmp;
i:integer
begin
    icmp:=ticmp.Create;
    try
        icmp.Address :=ipaddress;
        i:=icmp.Ping;
    finally
        icmp.Destroy;
    end;
    if i=0 then
       result:=false
    else
       result:=true;
end;

在WIN关闭时，往往计算机会提示有哪些计算机与你的电脑连接，那么如何通过程序知道
有哪些计算机与自己的电脑连接？bbkxjy, 时间：2001-5-31 20:23:57, ID：549334
const
  MaxNetArrayItems = 512;
type
  TSessionInfo50 = packed record
    sesi50_cname: PChar;                   //remote computer name (connection id in Netware)
    sesi50_username: PChar;
    sesi50_key: DWORD;                     // used to delete session (not used in Netware)
    sesi50_num_conns: Word;
    sesi50_num_opens: Word;                //not available in Netware
    sesi50_time: DWORD;
    sesi50_idle_time: DWORD;               //not available in Netware
    sesi50_protocol: Char;
    padl: Char;
  end;  TNetSessionEnum = function (const pszServer: PChar; sLevel: SmallInt;
    pbBuffer: Pointer; cbBuffer: Word; var pcEntriesRead: Word;
    var pcTotalAvail: Word): DWORD; stdcall;
procedure GetNetSessions(ComputerNames: TStrings);
var
  SessionInfo: array[0..MaxNetArrayItems] of TSessionInfo50;
  EntriesRead, TotalAvail: Word;
  I: Integer;
  Str: string;
  NetSessionEnum: TNetSessionEnum;
  LibHandle: THandle;
begin
  ComputerNames.Clear;
  LibHandle := LoadLibrary('SVRAPI.DLL');
  if LibHandle <> 0 then
  begin
    try
      @NetSessionEnum := GetProcAddress(LibHandle, 'NetSessionEnum');
      if (@NetSessionEnum <> nil) then
        if NetSessionEnum(nil, 50, @SessionInfo, Sizeof(SessionInfo), EntriesRead, TotalAvail) = 0 then
        begin
          for I := 0 to EntriesRead - 1 do
          with SessionInfo[I] do
          begin
            SetString(Str, sesi50_cname, StrLen(sesi50_cname));
            ComputerNames.Add(Str);
          end;
        end;
    finally
      FreeLibrary(LibHandle);
    end;
  end;
end;
连接的计算机名存放在 ComputerNames 中.

扫描网络，看看有没有你想连接的机子名：
Function TFrm_main.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;Procedure TFrm_main.BitBtn_smClick(Sender: TObject);
Var
  strlist, userlist: TStringList;
  i, j: integer;
Begin
  strlist := TStringList.Create;
  userlist := TStringList.Create;
  If GetGroupList(strlist) Then
  Begin
    For i := 0 To strlist.Count - 1 Do //添加工作组
    Begin
      TreeView_fwq.Items[0].DeleteChildren;
      TreeView_fwq.Items.AddChild(TreeView_fwq.Items[0], strlist[i]);
      If GetUsers(strlist[i], userlist) Then
      Begin
        For j := 0 To userlist.Count - 1 Do
          TreeView_fwq.Items.AddChild(TreeView_fwq.Items[0].Item[i], userlist[j]);
      End;
    End;
  End;
  TreeView_fwq.FullExpand;
End;Function TFrm_main.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;

to:hero999(hero999) icmp这个use的时候会出错。说找不到

to:delphiseabird(沙鸥) 您这个方法我试了一下，有如下的问题：该函数是从网上邻居里读出工作组或者计算机名称的。而当网络断掉后突然连通后，该函数是测不到某台机子是否连接上的？不知道我说的对否？请继续指教。

查WNet*族API，该怎么做就有数了。

在Windows的System目录下，你可以找到Icmp.dll文件，该动态链接库提供了ICMP协议的所有功能

unit icmp;interface{$IFDEF VER80}// This source file is *NOT* compatible with Delphi 1 because it uses// Win 32 features.{$ENDIF}usesWindows, SysUtils, Classes, WinSock;constIcmpVersion = 102;IcmpDLL = 'icmp.dll';// IP status codes returned to transports and user IOCTLs.IP_SUCCESS = 0;IP_STATUS_BASE = 11000;IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1);IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2);IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3);IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4);IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5);IP_NO_RESOURCES = (IP_STATUS_BASE + 6);IP_BAD_OPTION = (IP_STATUS_BASE + 7);IP_HW_ERROR = (IP_STATUS_BASE + 8);IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9);IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10);IP_BAD_REQ = (IP_STATUS_BASE + 11);IP_BAD_ROUTE = (IP_STATUS_BASE + 12);IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13);IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14);IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15);IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16);IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17);IP_BAD_DESTINATION = (IP_STATUS_BASE + 18);// status codes passed up on status indications.IP_ADDR_DELETED = (IP_STATUS_BASE + 19);IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20);IP_MTU_CHANGE = (IP_STATUS_BASE + 21);IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50);MAX_IP_STATUS = IP_GENERAL_FAILURE;IP_PENDING = (IP_STATUS_BASE + 255);// IP header flagsIP_FLAG_DF = $02; // Don't fragment this packet.// IP Option TypesIP_OPT_EOL = $00; // End of list optionIP_OPT_NOP = $01; // No operationIP_OPT_SECURITY = $82; // Security option.IP_OPT_LSRR = $83; // Loose source route.IP_OPT_SSRR = $89; // Strict source route.IP_OPT_RR = $07; // Record route.IP_OPT_TS = $44; // Timestamp.IP_OPT_SID = $88; // Stream ID (obsolete)MAX_OPT_SIZE = $40;type// IP typesTIPAddr = DWORD; // An IP address.TIPMask = DWORD; // An IP subnet mask.TIPStatus = DWORD; // Status code returned from IP APIs.PIPOptionInformation = ^TIPOptionInformation;TIPOptionInformation = packed recordTTL: 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 bufferend;PIcmpEchoReply = ^TIcmpEchoReply;TIcmpEchoReply = packed recordAddress: TIPAddr; // Replying addressStatus: DWord; // IP status valueRTT: DWord; // Round Trip Time in millisecondsDataSize: Word; // Reply data sizeReserved: Word; // ReservedData: Pointer; // Pointer to reply data bufferOptions: TIPOptionInformation; // Reply optionsend;// IcmpCreateFile:// Opens a handle on which ICMP Echo Requests can be issued.// Arguments:// None.// Return Value:// An open file handle or INVALID_HANDLE_VALUE. Extended error information// is available by calling GetLastError().TIcmpCreateFile = function: THandle; stdcall;// IcmpCloseHandle:// Closes a handle opened by ICMPOpenFile.// Arguments:// IcmpHandle - The handle to close.// Return Value:// TRUE if the handle was closed successfully, otherwise FALSE. Extended// error information is available by calling GetLastError().TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;// IcmpSendEcho:// Sends an ICMP Echo request and returns one or more replies. The// call returns when the timeout has expired or the reply buffer// is filled.// Arguments:// IcmpHandle - An open handle returned by ICMPCreateFile.// DestinationAddress - The destination of the echo request.// RequestData - A buffer containing the data to send in the// request.// RequestSize - The number of bytes in the request data buffer.// RequestOptions - Pointer to the IP header options for the request.// May be NULL.// ReplyBuffer - A buffer to hold any replies to the request.// On return, the buffer will contain an array of// ICMP_ECHO_REPLY structures followed by options// and data. The buffer should be large enough to// hold at least one ICMP_ECHO_REPLY structure// and 8 bytes of data - this is the size of// an ICMP error message.// ReplySize - The size in bytes of the reply buffer.// Timeout - The time in milliseconds to wait for replies.// Return Value:// Returns the number of replies received and stored in ReplyBuffer. If// the return value is zero, extended error information is available// via GetLastError().TIcmpSendEcho = function(IcmpHandle: THandle;DestinationAddress: TIPAddr;RequestData: Pointer;RequestSize: Word;RequestOptions: PIPOptionInformation;ReplyBuffer: Pointer;ReplySize: DWord;Timeout: DWord): DWord; stdcall;// Event handler type declaration for TICMP.OnDisplay event.TICMPDisplay = procedure(Sender: TObject; Msg : String) of object;TICMPReply = procedure(Sender: TObject; Error : Integer) of object;// The object wich encapsulate the ICMP.DLLTICMP = class(TObject)privatehICMPdll : HModule; // Handle for ICMP.DLLIcmpCreateFile : TIcmpCreateFile;IcmpCloseHandle : TIcmpCloseHandle;IcmpSendEcho : TIcmpSendEcho;hICMP : THandle; // Handle for the ICMP CallsFReply : TIcmpEchoReply; // ICMP Echo reply bufferFAddress : String; // Address givenFHostName : String; // Dotted IP of host (output)FHostIP : String; // Name of host (Output)FIPAddress : TIPAddr; // Address of host to contactFSize : Integer; // Packet size (default to 56)FTimeOut : Integer; // Timeout (default to 4000mS)FTTL : Integer; // Time To Live (for send)FOnDisplay : TICMPDisplay; // Event handler to displayFOnEchoRequest : TNotifyEvent;FOnEchoReply : TICMPReply;FLastError : DWORD; // After sending ICMP packetFAddrResolved : Boolean;procedure ResolveAddr;publicconstructor Create; virtual;destructor Destroy; override;function Ping : Integer;procedure SetAddress(Value : String);function GetErrorString : String;property Address : String read FAddress write SetAddress;property Size : Integer read FSize write FSize;property Timeout : Integer read FTimeout write FTimeout;property Reply : TIcmpEchoReply read FReply;property TTL : Integer read FTTL write FTTL;property ErrorCode : DWORD read FLastError;property ErrorString : String read GetErrorString;property HostName : String read FHostName;property HostIP : String read FHostIP;property OnDisplay : TICMPDisplay read FOnDisplay write FOnDisplay;property OnEchoRequest : TNotifyEvent read FOnEchoRequestwrite FOnEchoRequest;property OnEchoReply : TICMPReply read FOnEchoReplywrite FOnEchoReply;end;TICMPException = class(Exception);

implementation{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{Create Class,Class Name is ICMP }
constructor TICMP.Create;varWSAData: TWSAData;begin hICMP := INVALID_HANDLE_VALUE; FSize := 56; FTTL := 64; FTimeOut := 100;// initialise winsock if WSAStartup($101, WSAData) <> 0 then raise TICMPException.Create('Error initialising Winsock');// register the icmp.dll stuff hICMPdll := LoadLibrary(icmpDLL); if hICMPdll = 0 then raise TICMPException.Create('Unable to register ' + icmpDLL); @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile'); @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle'); @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho'); if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then raise TICMPException.Create('Error loading dll functions'); hICMP := IcmpCreateFile; if hICMP = INVALID_HANDLE_VALUE then raise TICMPException.Create('Unable to get ping handle');end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{Destroy Class ICMP}
destructor TICMP.Destroy;begin if hICMP <> INVALID_HANDLE_VALUE then IcmpCloseHandle(hICMP); if hICMPdll <> 0 then FreeLibrary(hICMPdll); WSACleanup; inherited Destroy;end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}function MinInteger(X, Y: Integer): Integer;begin if X >= Y then Result := Y else Result := X;end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}procedure TICMP.ResolveAddr;varPhe : PHostEnt; // HostEntry buffer for name lookupbegin// Convert host address to IP address FIPAddress := inet_addr(PChar(FAddress)); if FIPAddress <> INADDR_NONE then// Was a numeric dotted address let it in this format FHostName := FAddress else begin// Not a numeric dotted address, try to resolve by name Phe := GetHostByName(PChar(FAddress)); if Phe = nil then begin FLastError := GetLastError; if Assigned(FOnDisplay) then FOnDisplay(Self, 'Unable to resolve ' + FAddress); Exit; end; FIPAddress := longint(plongint(Phe^.h_addr_list^)^); FHostName := Phe^.h_name; end; FHostIP := StrPas(inet_ntoa(TInAddr(FIPAddress))); FAddrResolved := TRUE;end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}procedure TICMP.SetAddress(Value : String);begin// Only change if needed (could take a long time) if FAddress = Value then Exit; FAddress := Value; FAddrResolved := FALSE;// ResolveAddr;end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}function TICMP.GetErrorString : String;begin case FLastError of IP_SUCCESS: Result := 'No error'; IP_BUF_TOO_SMALL: Result := 'Buffer too small'; IP_DEST_NET_UNREACHABLE: Result := 'Destination network unreachable'; IP_DEST_HOST_UNREACHABLE: Result := 'Destination host unreachable'; IP_DEST_PROT_UNREACHABLE: Result := 'Destination protocol unreachable'; IP_DEST_PORT_UNREACHABLE: Result := 'Destination port unreachable'; IP_NO_RESOURCES: Result := 'No resources'; IP_BAD_OPTION: Result := 'Bad option'; IP_HW_ERROR: Result := 'Hardware error'; IP_PACKET_TOO_BIG: Result := 'Packet too big'; IP_REQ_TIMED_OUT: Result := 'Request timed out'; IP_BAD_REQ: Result := 'Bad request'; IP_BAD_ROUTE: Result := 'Bad route'; IP_TTL_EXPIRED_TRANSIT: Result := 'TTL expired in transit'; IP_TTL_EXPIRED_REASSEM: Result := 'TTL expired in reassembly'; IP_PARAM_PROBLEM: Result := 'Parameter problem'; IP_SOURCE_QUENCH: Result := 'Source quench'; IP_OPTION_TOO_BIG: Result := 'Option too big'; IP_BAD_DESTINATION: Result := 'Bad Destination'; IP_ADDR_DELETED: Result := 'Address deleted'; IP_SPEC_MTU_CHANGE: Result := 'Spec MTU change'; IP_MTU_CHANGE: Result := 'MTU change'; IP_GENERAL_FAILURE: Result := 'General failure'; IP_PENDING: Result := 'Pending'; else Result := 'ICMP error #' + IntToStr(FLastError); end;end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}function TICMP.Ping : Integer;varBufferSize: Integer;pReqData, pData: Pointer;pIPE: PIcmpEchoReply; // ICMP Echo reply bufferIPOpt: TIPOptionInformation; // IP Options for packet to sendMsg: String;begin Result := 0; FLastError := 0; if not FAddrResolved then ResolveAddr; if FIPAddress = INADDR_NONE then begin FLastError := IP_BAD_DESTINATION; if Assigned(FOnDisplay) then FOnDisplay(Self, 'Invalid host address'); Exit; end;// Allocate space for data buffer space BufferSize := SizeOf(TICMPEchoReply) + FSize; GetMem(pReqData, FSize); GetMem(pData, FSize); GetMem(pIPE, BufferSize); try// Fill data buffer with some data bytes FillChar(pReqData^, FSize, $20); Msg := 'Pinging from Delphi code written by F. Piette'; Move(Msg[1], pReqData^, MinInteger(FSize, Length(Msg))); pIPE^.Data := pData; FillChar(pIPE^, SizeOf(pIPE^), 0); if Assigned(FOnEchoRequest) then FOnEchoRequest(Self); FillChar(IPOpt, SizeOf(IPOpt), 0); IPOpt.TTL := FTTL; Result := IcmpSendEcho(hICMP, FIPAddress, pReqData, FSize, @IPOpt, pIPE, BufferSize, FTimeOut); FLastError := GetLastError; FReply := pIPE^; if Assigned(FOnEchoReply) then FOnEchoReply(Self, Result); finally// Free those buffers FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData); end;end;end.

调试易

高分请教：怎么样用delphi判断我的跟另外机子是否连接上？

解决方案 »