使用印度人编的一个叫NetUsers的东东,内有一点BUG,略改一下就可以了。
贴下去了:
-----------------------------------------------------------------
Unit NetUsers;InterfaceUses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;Type
  TNetUsers = Class(TComponent)
  Private
    fServer : String;
    Function GetUsers : Boolean;
  Protected
    Procedure SetServer(Server : String);
  Public
     List : TStringList;
     Constructor Create(Owner:TComponent); Override;
     Destructor Destroy; Override;
     Function GetServerList : Boolean;
     Function GetUserList : Boolean;
  Published
    Property Server :String Read fServer Write SetServer;
  End;  PnetResourceArr = ^TNetResource;Procedure Register;ImplementationProcedure TNetUsers.SetServer(Server : String);
Begin
  If fServer <> Server Then
    fServer := Server;
End;Constructor TNetUsers.Create(Owner:TComponent);
Begin
  Inherited Create(Owner);
  If Not (csDesigning in ComponentState) Then
  Begin
    List := TStringList.Create;
    List.Sorted := True;
  End;
End;Destructor TNetUsers.Destroy;
Begin
  If Not(csDesigning In ComponentState) Then
    List.Destroy;
  Inherited Destroy;
End;Function TNetUsers.GetServerList : Boolean;
Type
  {$H+}
  PMyRec = ^MyRec;
   MyRec = Record
             dwScope       : Integer;
             dwType        : Integer;
             dwDisplayType : Integer;
             dwUsage       : Integer;
             LocalName     : String;
             RemoteName    : String;
             Comment       : String;
             Provider      : String;
           End;
  {H-}
Var
  NetResource : TNetResource;
  TempRec     : PMyRec;
  Buf         : Pointer;
  Count,
  BufSize,
  Res         : DWORD;
  lphEnum     : THandle;
  p           : PNetResourceArr;
  i,
  j           : SmallInt;
  NetworkTypeList : TList;
Begin
  Result := False;
  NetworkTypeList := TList.Create;
  List.Clear;
  GetMem(Buf, 8192);
  Try
    Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
    If Res <> 0 Then Raise Exception(Res);
    Count := $FFFFFFFF;
    BufSize := 8192;
    Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
    If Res = ERROR_NO_MORE_ITEMS Then Exit;
    If (Res <> 0) Then Raise Exception(Res);
    P := PNetResourceArr(Buf);
    For I := 0 To Count - 1 Do
    Begin
      New(TempRec);
      TempRec^.dwScope := P^.dwScope;
      TempRec^.dwType := P^.dwType ;
      TempRec^.dwDisplayType := P^.dwDisplayType ;
      TempRec^.dwUsage := P^.dwUsage ;
      TempRec^.LocalName := StrPas(P^.lpLocalName);
      TempRec^.RemoteName := StrPas(P^.lpRemoteName);
      TempRec^.Comment := StrPas(P^.lpComment);
      TempRec^.Provider := StrPas(P^.lpProvider);
      NetworkTypeList.Add(TempRec);
      Inc(P);
    End;
    Res := WNetCloseEnum(lphEnum);
    If Res <> 0 Then Raise Exception(Res);
    For J := 0 To NetworkTypeList.Count-1 Do
    Begin
      TempRec := NetworkTypeList.Items[J];
      NetResource := TNetResource(TempRec^);
      Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
      If Res <> 0 Then Raise Exception(Res);
      While true Do
      Begin
        Count := $FFFFFFFF;
        BufSize := 8192;
        Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
        If Res = ERROR_NO_MORE_ITEMS Then Break;
        If (Res <> 0) Then Raise Exception(Res);
        P := PNetResourceArr(Buf);
        For I := 0 To Count - 1 Do
        Begin
          List.Add(P^.lpRemoteName);
          Inc(P);
        End;
      End;
    End;
    Res := WNetCloseEnum(lphEnum);
    If Res <> 0 Then Raise Exception(Res);
    Result := True;
    Finally
      FreeMem(Buf);
      NetworkTypeList.Destroy;
  End;
End;Function TNetUsers.GetUsers : Boolean;
Var
  NetResource : TNetResource;
  Buf         : Pointer;
  Count,
  BufSize,
  Res         : DWord;
  Ind         : Integer;
  lphEnum     : THandle;
  Temp        : PNetResourceArr;
Begin
  Result := False;
  List.Clear;
  GetMem(Buf, 8192);
  Try
    FillChar(NetResource, SizeOf(NetResource), 0);
    NetResource.lpRemoteName := @fServer[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 <> 0 Then Exit;
    While True Do
    Begin
      Count := $FFFFFFFF;
      BufSize := 8192;
      Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
      If Res = ERROR_NO_MORE_ITEMS Then Exit;
      If (Res <> 0) then Exit;
      Temp := PNetResourceArr(Buf);
      For Ind := 0 to Count - 1 do
      Begin
        List.Add(Temp^.lpRemoteName + 2); { Add all the network usernames to List StringList }
        Inc(Temp);
      End;
    End;
    Res := WNetCloseEnum(lphEnum);
    If Res <> 0 Then Raise Exception(Res);
    Result := True;
  Finally
    FreeMem(Buf);
  End;
End;Function TNetUsers.GetUserList : Boolean;
Var
  ServerList  : TStringList;
  TempInt,
  Ind         : Integer;
  {$IFDEF VER100}
  MaxLen      : Integer;
  {$ELSE}
  MaxLen      : Cardinal;
  {$ENDIF}
  Buf         : PChar;
  MachineName : String;
Begin
  Result := False;
  If fServer = '' Then
  Begin
    If GetServerList Then
    Begin
      ServerList := List;
      GetMem(Buf,255);
      MaxLen := 255;
      GetComputerName(Buf, MaxLen);
      MachineName := StrPas(Buf);
      Freemem(Buf,255);
      For Ind := 0 to ServerList.Count-1 Do
      Begin
        fServer := ServerList.Strings[Ind];
        If GetUsers Then
          If List.Find(MachineName, TempInt) Then
          Begin
            Result := True;
            Exit;
          End;
      End;
    End;
  End
  Else
    Result := GetUsers;  
End;Procedure Register;
Begin
  RegisterComponents('HVK Utility', [TNetUsers]);
End;End.