type
TForm1 = class(TForm)
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function NetApiBufferFree(Buffer: Pointer): LongWord; stdcall;
external 'netapi32.dll';
function NetSessionEnum(ServerName, UncClientName,UserName: PWideChar;
Level: DWord; var Buffer: Pointer;PrefMaxLen: DWord;
var EntriesRead,TotalEntries,ResumeHandle: DWord): LongWord; stdcall;external 'netapi32.dll';
implementation
uses WinSock;
const
MAX_PREFERRED_LENGTH = DWord(-1);
type
PSessionInfo502 = ^TSessionInfo502;
TSessionInfo502 = packed record
sesi502_cname : PWideChar;
sesi502_username : PWideChar;
sesi502_num_opens : LongWord;
sesi502_time : LongWord;
sesi502_idle_time : LongWord;
sesi502_user_flags : LongWord;
sesi502_cltype_name : PWideChar;
sesi502_transport : PWideChar;
end;
function GetIPByName(Name: string; var Ip: string): Boolean;
var
wsdata : TWSAData;
hostName : array [0..255] of char;
hostEnt : PHostEnt;
addr : PChar;
begin
WSAStartup ($0101, wsdata);
try
gethostname (hostName, sizeof (hostName));
StrPCopy(hostName, Name);
hostEnt := gethostbyname (hostName);
if Assigned (hostEnt) then
if Assigned (hostEnt^.h_addr_list) then begin
addr := hostEnt^.h_addr_list^;
if Assigned (addr) then begin
IP := Format ('%d.%d.%d.%d', [byte (addr [0]),
byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result := True;
end
else
Result := False;
end
else
Result := False
else begin
Result := False;
end;
finally
WSACleanup;
end
end;
procedure ListLoggedOnUsers(aStringGrid: TStringGrid; const aServer:string);
var
EntriesRead : DWord;
I : Integer;
ResumeHandle : DWord;
Rslt : LongWord;
SessionInfo,
P : PSessionInfo502;
TotalEntries : DWord;
TotalSoFar : LongWord;
CName : PWideChar;
aString : string;
intIPAdres : integer;
strIPAdres : string;
begin
ResumeHandle := 0;
TotalSoFar := 0;
aStringGrid.RowCount := 2;
aStringGrid.Cells[0, 0] := 'User';
aStringGrid.Cells[1, 0] := 'Computer';
aStringGrid.Cells[2, 0] := 'ActiveTime';
aStringGrid.Cells[3, 0] := 'Connections';
aStringGrid.ColWidths[3] := 70;
aStringGrid.Cells[4, 0] := 'IP Adress';
aStringGrid.Cells[5, 0] := 'Client Type';
aStringGrid.ColWidths[5] := 140;
aStringGrid.Cells[0, 1] := 'Nobody';
aStringGrid.Cells[1, 1] := 'has';
aStringGrid.Cells[2, 1] := 'Logged';
aStringGrid.Cells[3, 1] := 'in';
aStringGrid.Cells[4, 1] := 'right';
aStringGrid.Cells[5, 1] := 'now...';
aString := aServer;
CName := StringToOleStr(aString);
repeat
Rslt := NetSessionEnum(CName,NIL,NIL,502,Pointer(SessionInfo),
MAX_PREFERRED_LENGTH,EntriesRead,TotalEntries,ResumeHandle);
if Rslt <> 0 then
raise Exception.CreateFmt('Network API error %d', [Rslt]);
P := SessionInfo;
for I := 0 to EntriesRead - 1 do begin
if WideCharToString(P.sesi502_username) <> '' then begin
aStringGrid.Cells[0, aStringGrid.RowCount - 1] :=
WideCharToString(P.sesi502_username);//连接你机器的用户名
aStringGrid.Cells[1, aStringGrid.RowCount - 1] :=
WideCharToString(P.sesi502_cname);//机器名
aStringGrid.Cells[2, aStringGrid.RowCount - 1] :=
IntToStr(P.sesi502_time);//连接时间 秒
aStringGrid.Cells[3, aStringGrid.RowCount - 1] :=
IntToStr(P.sesi502_num_opens);//打开数
//获取连接的IP
if GetIPByName(P.sesi502_cname,strIPAdres) then
aStringGrid.Cells[4, aStringGrid.RowCount - 1] :=strIPAdres;
aStringGrid.Cells[5, aStringGrid.RowCount - 1] :=
WideCharToString(P.sesi502_cltype_name);//连接人的操作系统
aStringGrid.RowCount := aStringGrid.RowCount + 1;
end;
Inc(LongWord(P), SizeOf(TSessionInfo502))
end;
Inc(TotalSoFar, EntriesRead);
until TotalSoFar >= TotalEntries;
aStringGrid.RowCount := aStringGrid.RowCount - 1;
Rslt := NetApiBufferFree(SessionInfo);
if Rslt <> 0 then
raise Exception.CreateFmt('Network API error %d', [Rslt])
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
ListLoggedOnUsers(stringgrid1,'etsoft');//这里etsoft是你的机器名，我在填LocalHost时出错呵：（
end;
