网络小工具 ShareView

本文由Lyris完成，首发于CSDN，作者保留中文版权。

未经许可，不得使用于任何商业用途。

如需联络请发邮件：chenwentao@gmail.com

unit NetMonConsts;

interface

uses Windows;

type

TShareInfo2 = packed record

shi2_netname: PWChar;

shi2_type: DWORD;

shi2_remark: PWChar;

shi2_permissions: DWORD;

shi2_max_uses: DWORD;

shi2_current_uses: DWORD;

shi2_path: PWChar;

shi2_passwd: PWChar;

end;

PShareInfo2 = ^TShareInfo2;

TShareInfo2Array = array[0..512] of TShareInfo2;

PShareInfo2Array = ^TShareInfo2Array;

type

TShareInfo50 = packed record

shi50_netname: array[0..12] of Char;

shi50_type: Byte;

shi50_flags: Word;

shi50_remark: PChar;

shi50_path: PChar;

shi50_rw_password: array[0..8] of Char;

shi50_ro_password: array[0..8] of Char;

end;

type

TSessionInfo502 = packed record

Sesi502_cname: PWideChar;

Sesi502_username: PWideChar;

Sesi502_num_opens: DWORD;

Sesi502_time: DWORD;

Sesi502_idle_time: DWORD;

Sesi502_user_flags: DWORD;

Sesi502_cltype_name: PWideChar;

Sesi502_transport: PWideChar;

end;

PSessionInfo502 = ^TSessionInfo502;

TSessionInfo502Array = array[0..512] of TSessionInfo502;

PSessionInfo502Array = ^TSessionInfo502Array;

type

TSessionInfo50 = packed record

Sesi50_cname: PChar;

Sesi50_username: PChar;

sesi50_key: Cardinal;

sesi50_num_conns: Word;

sesi50_num_opens: Word;

sesi50_time: Cardinal;

sesi50_idle_time: Cardinal;

sesi50_protocol: Byte;

pad1: Byte;

end;

type

TFileInfo3 = packed record

fi3_id: DWORD;

fi3_permissions: DWORD;

fi3_num_locks: DWORD;

fi3_pathname: PWChar;

fi3_username: PWChar;

end;

PFileInfo3 = ^TFileInfo3;

TFileInfo3Array = array[0..512] of TFileInfo3;

PFileInfo3Array = ^TFileInfo3Array;

type

TFileInfo50 = packed record

fi50_id: Cardinal;

fi50_permissions: WORD;

fi50_num_locks: WORD;

fi50_pathname: PChar;

fi50_username: PChar;

fi50_sharename: PChar;

end;

type

TMibIfRow = packed record

wszName: array[0..255] of WideChar;

dwIndex: DWORD;

dwType: DWORD;

dwMtu: DWORD;

dwSpeed: DWORD;

dwPhysAddrLen: DWORD;

bPhysAddr: array[0..7] of Byte;

dwAdminStatus: DWORD;

dwOperStatus: DWORD;

dwLastChange: DWORD;

dwInOctets: DWORD;

dwInUcastPkts: DWORD;

dwInNUCastPkts: DWORD;

dwInDiscards: DWORD;

dwInErrors: DWORD;

dwInUnknownProtos: DWORD;

dwOutOctets: DWORD;

dwOutUCastPkts: DWORD;

dwOutNUCastPkts: DWORD;

dwOutDiscards: DWORD;

dwOutErrors: DWORD;

dwOutQLen: DWORD;

dwDescrLen: DWORD;

bDescr: array[0..255] of Char;

end;

TMibIfArray = array[0..512] of TMibIfRow;

PMibIfRow = ^TMibIfRow;

PMibIfArray = ^TMibIfArray;

type

TMibIfTable = packed record

dwNumEntries: DWORD;

Table: TMibIfArray;

end;

PMibIfTable = ^TMibIfTable;

var

NetShareEnumNT: function(servername: PWChar;

level: DWORD;

bufptr: Pointer;

prefmaxlen: DWORD;

entriesread,

totalentries,

resume_handle: LPDWORD): DWORD; stdcall;

var

NetShareEnum: function(pszServer: PChar;

sLevel: Cardinal;

pbBuffer: Pchar;

cbBuffer: Cardinal;

pcEntriesRead,

pcTotalAvail: Pointer): DWORD; stdcall;

var

NetShareDelNT: function(servername: PWideChar;

netname: PWideChar;

reserved: DWORD): LongInt; stdcall;

var

NetShareDel: function(pszServer,

pszNetName: PChar;

usReserved: Word): DWORD; stdcall;

var

NetShareAddNT: function(servername: PWideChar;

level: DWORD;

buf: Pointer;

parm_err: LPDWORD): DWORD; stdcall;

var

NetShareAdd: function(pszServer: Pchar;

sLevel: Cardinal;

pbBuffer: PChar;

cbBuffer: Word): DWORD; stdcall;

var

NetSessionEnumNT: function(servername,

UncClientName,

username: PWChar;

level: DWORD;

bufptr: Pointer;

prefmaxlen: DWORD;

entriesread,

totalentries,

resume_handle: LPDWORD): DWORD; stdcall;

var

NetSessionEnum: function(pszServer: PChar;

sLevel: DWORD;

pbBuffer: Pointer;

cbBuffer: DWORD;

pcEntriesRead,

pcTotalAvial: Pointer): integer; stdcall;

var

NetSessionDelNT: function(ServerName,

UncClientName,

username: PWChar): DWORD; stdcall;

var

NetSessionDel: function(pszServer: PChar;

pszClientName: PChar;

sReserved: SmallInt): DWORD; stdcall;

var

NetFileEnumNT: function(servername,

basepath,

username: PWChar;

level: DWORD;

bufptr: Pointer;

prefmaxlen: DWORD;

entriesread,

totalentries,

resume_handle: LPDWORD): DWORD; stdcall;

var

NetFileEnum: function(pszServer,

pszBasePath: PChar;

sLevel: DWORD;

pbBuffer: Pointer;

cbBuffer: DWORD;

pcEntriesRead,

pcTotalAvail: pointer): integer; stdcall;

var

NetFileClose: function(ServerName: PWideChar;

FileId: DWORD): DWORD; stdcall;

var

NetFileClose2: function(pszServer: PChar;

ulFileId: LongWord): DWORD; stdcall;

var

GetIfTable: function(pIfTable: PMibIfTable;

pdwSize: PULONG;

bOrder: Boolean): DWORD; stdcall;

implementation

end.

unit NetMonUtils;

interface

uses Windows, Classes, NetMonConsts;

function IsNT(var Value: Boolean): Boolean;

procedure GetShares(SharesList: TStrings);

procedure CloseShare(ShareName: string);

procedure AddShare(ShareName, ShareDir: string);

procedure GetSessions(List: TStrings);

procedure CloseSession(SessionName: string);

procedure GetFiles(FilesList: TStrings);

procedure CloseFile(FileIndex: string);

procedure GetTrafficSets(TrafficsList: TStrings);

function IntegerToTimeStr(Value: Integer): string;

type

TShareInfo2Obj = class

private

Fshi2_netname: string;

Fshi2_path: string;

procedure Setshi2_netname(const Value: string);

procedure Setshi2_path(const Value: string);

public

constructor Create(ShareInfo2: TShareInfo2);

property shi2_netname: string read Fshi2_netname write Setshi2_netname;

property shi2_path: string read Fshi2_path write Setshi2_path;

end;

TShareInfo50Obj = class

private

Fshi50_netname: string;

Fshi50_path: string;

procedure Setshi50_netname(const Value: string);

procedure Setshi50_path(const Value: string);

public

constructor Create(ShareInfo50: TShareInfo50);

property shi50_netname: string read Fshi50_netname write Setshi50_netname;

property shi50_path: string read Fshi50_path write Setshi50_path;

end;

TSessionInfo502Obj = class

private

FSesi502_Time: DWord;

Fsesi502_idle_time: DWord;

FSesi502_num_opens: DWord;

FSesi502_cname: WideString;

FSesi502_username: WideString;

procedure SetSesi502_cname(const Value: WideString);

procedure Setsesi502_idle_time(const Value: DWord);

procedure SetSesi502_num_opens(const Value: DWord);

procedure SetSesi502_Time(const Value: DWord);

procedure SetSesi502_username(const Value: WideString);

public

constructor Create(SessionInfo502: TSessionInfo502);

property Sesi502_cname: WideString read FSesi502_cname write SetSesi502_cname;

property Sesi502_username: WideString read FSesi502_username write SetSesi502_username;

property Sesi502_num_opens: DWord read FSesi502_num_opens write SetSesi502_num_opens;

property Sesi502_Time: DWord read FSesi502_Time write SetSesi502_Time;

property sesi502_idle_time: DWord read Fsesi502_idle_time write Setsesi502_idle_time;

end;

TSessionInfo50Obj = class

private

Fsesi50_num_opens: Integer;

Fsesi50_time: Integer;

Fsesi50_idle_time: Integer;

FSesi50_cname: WideString;

FSesi50_username: WideString;

procedure SetSesi50_cname(const Value: WideString);

procedure Setsesi50_idle_time(const Value: Integer);

procedure Setsesi50_num_opens(const Value: Integer);

procedure Setsesi50_time(const Value: Integer);

procedure SetSesi50_username(const Value: WideString);

public

constructor Create(SessionInfo50: TSessionInfo50);

property Sesi50_cname: WideString read FSesi50_cname write SetSesi50_cname;

property Sesi50_username: WideString read FSesi50_username write SetSesi50_username;

property sesi50_num_opens: Integer read Fsesi50_num_opens write Setsesi50_num_opens;

property sesi50_time: Integer read Fsesi50_time write Setsesi50_time;

property sesi50_idle_time: Integer read Fsesi50_idle_time write Setsesi50_idle_time;

end;

TFileInfo3Obj = class

private

Ffi3_permissions: DWord;

Ffi3_num_locks: DWord;

Ffi3_id: DWord;

Ffi3_pathname: WideString;

Ffi3_username: WideString;

procedure Setfi3_id(const Value: DWord);

procedure Setfi3_num_locks(const Value: DWord);

procedure Setfi3_pathname(const Value: WideString);

procedure Setfi3_permissions(const Value: DWord);

procedure Setfi3_username(const Value: WideString);

public

constructor Create(FileInfo3: TFileInfo3);

property fi3_id: DWord read Ffi3_id write Setfi3_id;

property fi3_permissions: DWord read Ffi3_permissions write Setfi3_permissions;

property fi3_num_locks: DWord read Ffi3_num_locks write Setfi3_num_locks;

property fi3_pathname: WideString read Ffi3_pathname write Setfi3_pathname;

property fi3_username: WideString read Ffi3_username write Setfi3_username;

end;

type

TFileInfo50Obj = class

private

Ffi50_id: Integer;

Ffi50_pathname: string;

Ffi50_username: string;

Ffi50_sharename: string;

Ffi50_permissions: WORD;

Ffi50_num_locks: WORD;

procedure Setfi50_id(const Value: Integer);

procedure Setfi50_num_locks(const Value: WORD);

procedure Setfi50_pathname(const Value: string);

procedure Setfi50_permissions(const Value: WORD);

procedure Setfi50_sharename(const Value: string);

procedure Setfi50_username(const Value: string);

public

constructor Create(FileInfo50: TFileInfo50);

property fi50_id: Integer read Ffi50_id write Setfi50_id;

property fi50_permissions: WORD read Ffi50_permissions write Setfi50_permissions;

property fi50_num_locks: WORD read Ffi50_num_locks write Setfi50_num_locks;

property fi50_pathname: string read Ffi50_pathname write Setfi50_pathname;

property fi50_username: string read Ffi50_username write Setfi50_username;

property fi50_sharename: string read Ffi50_sharename write Setfi50_sharename;

end;

type

TMAC = array[0..7] of Byte;

TTraffic = class

private

FMAC: string;

FdwOutOctets: Integer;

FdwInOctets: Integer;

FCaption: string;

procedure SetCaption(const Value: string);

procedure SetdwInOctets(const Value: Integer);

procedure SetdwOutOctets(const Value: Integer);

procedure SetMAC(const Value: string);

function GetMAC(Value: TMAC; Length: DWORD): string;

public

constructor Create(MibIfRow: TMibIfRow);

property Caption: string read FCaption write SetCaption;

property MAC: string read FMAC write SetMAC;

property dwInOctets: Integer read FdwInOctets write SetdwInOctets;

property dwOutOctets: Integer read FdwOutOctets write SetdwOutOctets;

end;

implementation

uses SysUtils;

function IsNT(var Value: Boolean): Boolean;

var Ver: TOSVersionInfo;

BRes: Boolean;

begin

Ver.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

BRes := GetVersionEx(Ver);

if not BRes then

begin

Result := False;

Exit;

end else

Result := True;

case Ver.dwPlatformId of

VER_PLATFORM_WIN32_NT: Value := True;

VER_PLATFORM_WIN32_WINDOWS: Value := False;

VER_PLATFORM_WIN32s: Result := False

end;

procedure GetShares(SharesList: TStrings);

var

i: Integer;

FLibHandle: THandle;

ShareNT: PShareInfo2Array;

entriesread, totalentries: DWORD; //<= Win NT

Share: array[0..512] of TShareInfo50;

pcEntriesRead, pcTotalAvail: Word; //<= Windows 9x-Me

OS: Boolean;

begin

if not IsNT(OS) then Exit;

if OS then begin

FLibHandle := LoadLibrary('NETAPI32.DLL');

if FLibHandle = 0 then Exit;

@NetShareEnumNT := GetProcAddress(FLibHandle, 'NetShareEnum');

if not Assigned(NetShareEnumNT) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

ShareNT := nil;

if NetShareEnumNT(nil, 2, @ShareNT, DWORD(-1),

@entriesread, @totalentries, nil) <> 0 then

begin

FreeLibrary(FLibHandle);

Exit;

end;

if entriesread > 0 then

for i := 0 to entriesread - 1 do

SharesList.AddObject(string(ShareNT^[i].shi2_netname), TShareInfo2Obj.Create(ShareNT^[i]));

end else begin

FLibHandle := LoadLibrary('SVRAPI.DLL');

if FLibHandle = 0 then Exit;

@NetShareEnum := GetProcAddress(FLibHandle, 'NetShareEnum');

if not Assigned(NetShareEnum) then

FreeLibrary(FLibHandle);

Exit;

if NetShareEnum(nil, 50, @Share, SizeOf(Share),

@pcEntriesRead, @pcTotalAvail) <> 0 then

begin

FreeLibrary(FLibHandle);

Exit;

end;

if pcEntriesRead > 0 then

for i := 0 to pcEntriesRead - 1 do

SharesList.AddObject(string(Share[i].shi50_netname), TShareInfo50Obj.Create(Share[i]));

end;

FreeLibrary(FLibHandle);

end;

procedure CloseShare(ShareName: string);

var

OS: Boolean;

FLibHandle: THandle;

Name9x: array[0..12] of Char;

NameNT: PWChar;

i: Integer;

begin

if not IsNT(OS) then Exit;

if OS then begin

FLibHandle := LoadLibrary('NETAPI32.DLL');

if FLibHandle = 0 then Exit;

@NetShareDelNT := GetProcAddress(FLibHandle, 'NetShareDel');

if not Assigned(NetShareDelNT) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

i := SizeOf(WideChar) * 256;

GetMem(NameNT, i);

StringToWideChar(ShareName, NameNT, i);

NetShareDelNT(nil, NameNT, 0);

FreeMem(NameNT);

end else begin

FLibHandle := LoadLibrary('SVRAPI.DLL');

if FLibHandle = 0 then Exit;

@NetShareDel := GetProcAddress(FLibHandle, 'NetShareDel');

if not Assigned(NetShareDel) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

FillChar(Name9x, SizeOf(Name9x), #0);

move(ShareName[1], Name9x[0], Length(ShareName));

NetShareDel(nil, @Name9x, 0);

end;

FreeLibrary(FLibHandle);

end;

procedure AddShare(ShareName, ShareDir: string);

const

STYPE_DISKTREE = 0;

ACCESS_ALL = 258;

SHI50F_FULL = 258;

var

FLibHandle: THandle;

Share9x: TShareInfo50;

ShareNT: TShareInfo2;

TmpDirNT, TmpNameNT: PWChar;

OS: Boolean;

TmpLength: Integer;

begin

if not IsNT(OS) then Exit;

if OS then begin

FLibHandle := LoadLibrary('NETAPI32.DLL');

if FLibHandle = 0 then Exit;

@NetShareAddNT := GetProcAddress(FLibHandle, 'NetShareAdd');

if not Assigned(NetShareAddNT) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

TmpLength := SizeOF(WideChar) * 256;

GetMem(TmpNameNT, TmpLength);

StringToWideChar(ShareName, TmpNameNT, TmpLength);

ShareNT.shi2_netname := TmpNameNT;

ShareNT.shi2_type := STYPE_DISKTREE;

ShareNT.shi2_remark := '';

ShareNT.shi2_permissions := ACCESS_ALL;

ShareNT.shi2_max_uses := DWORD(-1);

ShareNT.shi2_current_uses := 0;

GetMem(TmpDirNT, TmpLength);

StringToWideChar(ShareDir, TmpDirNT, TmpLength);

ShareNT.shi2_path := TmpDirNT;

ShareNT.shi2_passwd := '';

NetShareAddNT(nil, 2, @ShareNT, nil);

FreeMem(TmpNameNT);

FreeMem(TmpDirNT);

end else begin

FLibHandle := LoadLibrary('SVRAPI.DLL');

if FLibHandle = 0 then Exit;

@NetShareAdd := GetProcAddress(FLibHandle, 'NetShareAdd');

if not Assigned(NetShareAdd) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

FillChar(Share9x.shi50_netname, SizeOf(Share9x.shi50_netname), #0);

move(ShareName[1], Share9x.shi50_netname[0], Length(ShareName));

Share9x.shi50_type := STYPE_DISKTREE;

Share9x.shi50_flags := SHI50F_FULL;

FillChar(Share9x.shi50_remark,

SizeOf(Share9x.shi50_remark), #0);

FillChar(Share9x.shi50_path,

SizeOf(Share9x.shi50_path), #0);

Share9x.shi50_path := PAnsiChar(ShareDir);

FillChar(Share9x.shi50_rw_password,

SizeOf(Share9x.shi50_rw_password), #0);

FillChar(Share9x.shi50_ro_password,

SizeOf(Share9x.shi50_ro_password), #0);

NetShareAdd(nil, 50, @Share9x, SizeOf(Share9x));

end;

FreeLibrary(FLibHandle);

end;

procedure GetSessions(List: TStrings);

var

OS: Boolean;

FLibHandle: THandle;

SessionInfo50: array[0..512] of TSessionInfo50;

SessionInfo502: PSessionInfo502Array;

TotalEntries, EntriesReadNT: DWORD;

EntriesRead, TotalAvial: Word;

i: integer;

begin

List.Clear;

if not IsNT(OS) then Exit;

if OS then begin

FLibHandle := LoadLibrary('NETAPI32.DLL');

if FLibHandle = 0 then Exit;

@NetSessionEnumNT := GetProcAddress(FLibHandle, 'NetSessionEnum');

if not Assigned(NetSessionEnumNT) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

SessionInfo502 := nil;

if NetSessionEnumNT(nil, nil, nil, 502, @SessionInfo502, DWORD(-1), @entriesreadNT, @totalentries, nil) = 0 then

for i := 0 to EntriesReadNT - 1 do

List.AddObject(string(SessionInfo502^[i].sesi502_cname), TSessionInfo502Obj.Create(SessionInfo502^[i]));

end else begin

FLibHandle := LoadLibrary('SVRAPI.DLL');

if FLibHandle = 0 then Exit;

@NetSessionEnum := GetProcAddress(FLibHandle, 'NetSessionEnum');

if not Assigned(NetSessionEnum) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

if NetSessionEnum(nil, 50, @SessionInfo50, SizeOf(SessionInfo50), @EntriesRead, @TotalAvial) = 0 then

for i := 0 to EntriesRead - 1 do

List.AddObject(string(SessionInfo50[i].Sesi50_cname), TSessionInfo50Obj.Create(SessionInfo50[i]));

end;

FreeLibrary(FLibHandle);

end;

procedure CloseSession(SessionName: string);

var

OS: Boolean;

FLibHandle: THandle;

CNameNT: PWideChar;

CName9x: PAnsiChar;

Key: SmallInt;

begin

if not IsNT(OS) then Exit;

if OS then begin

FLibHandle := LoadLibrary('NETAPI32.DLL');

if FLibHandle = 0 then Exit;

@NetSessionDelNT := GetProcAddress(FLibHandle, 'NetSessionDel');

if not Assigned(NetSessionDelNT) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

CNameNT := PWChar(WideString('\\' + SessionName));

NetSessionDelNT(nil, CNameNT, nil);

end else begin

FLibHandle := LoadLibrary('SVRAPI.DLL');

if FLibHandle = 0 then Exit;

@NetSessionDel := GetProcAddress(FLibHandle, 'NetSessionDel');

if not Assigned(NetSessionDel) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

CName9x := PAnsiChar(SessionName);

// key := SessionCloseKey[i];

// NetSessionDel(nil,CName9x,Key);

end;

FreeLibrary(FLibHandle);

end;

procedure GetFiles(FilesList: TStrings);

var

OS: Boolean;

FLibHandle: THandle;

FileInfoNT: PFileInfo3Array;

FileInfo9x: array[0..512] of TFileInfo50;

TotalEntries, EntriesReadNT: DWORD;

EntriesRead, TotalAvial: Word;

i: integer;

begin

if not IsNT(OS) then Exit;

FilesList.Clear;

if OS then begin

FLibHandle := LoadLibrary('NETAPI32.DLL');

if FLibHandle = 0 then Exit;

@NetFileEnumNT := GetProcAddress(FLibHandle, 'NetFileEnum');

if not Assigned(NetFileEnumNT) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

FileInfoNT := nil;

if NetFileEnumNT(nil, nil, nil, 3, @FileInfoNT, DWORD(-1), @entriesreadNT, @totalentries, nil) = 0 then

for i := 0 to EntriesReadNT - 1 do

FilesList.AddObject(string(IntToStr(FileInfoNT^[i].fi3_id)), TFileInfo3Obj.Create(FileInfoNT^[i]));

end else begin

FLibHandle := LoadLibrary('SVRAPI.DLL');

if FLibHandle = 0 then Exit;

@NetFileEnum := GetProcAddress(FLibHandle, 'NetFileEnum');

if not Assigned(NetFileEnum) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

if NetFileEnum(nil, nil, 50, @FileInfo9x, SizeOf(FileInfo9x), @EntriesRead, @TotalAvial) = 0 then

for i := 0 to EntriesRead - 1 do

FilesList.AddObject(IntToStr(FileInfo9x[i].fi50_id), TFileInfo50Obj.Create(FileInfo9x[i]));

end;

FreeLibrary(FLibHandle);

end;

procedure CloseFile(FileIndex: string);

var

OS: Boolean;

FLibHandle: THandle;

begin

if not IsNT(OS) then Exit;

if OS then begin //暑?潆? NT

FLibHandle := LoadLibrary('NETAPI32.DLL');

if FLibHandle = 0 then Exit;

@NetFileClose := GetProcAddress(FLibHandle, 'NetFileClose');

if not Assigned(NetFileClose) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

NetFileClose(nil, StrToInt(FileIndex));

end else begin

FLibHandle := LoadLibrary('SVRAPI.DLL');

if FLibHandle = 0 then Exit;

@NetFileClose2 := GetProcAddress(FLibHandle, 'NetFileClose2');

if not Assigned(NetFileClose2) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

NetFileClose2(nil, StrToInt(FileIndex));

end;

FreeLibrary(FLibHandle);

end;

procedure GetTrafficSets(TrafficsList: TStrings);

var

FLibHandle : THandle;

Table: TMibIfTable;

i : integer;

Size : integer;

begin

TrafficsList.Clear;

FLibHandle := LoadLibrary('IPHLPAPI.DLL');

if FLibHandle = 0 then Exit;

@GetIfTable := GetProcAddress(FLibHandle, 'GetIfTable');

if not Assigned(GetIfTable) then

begin

FreeLibrary(FLibHandle);

Exit;

end;

Size := SizeOf(Table);

if GetIfTable(@Table, @Size, false ) = 0 then

for i:= 0 to Table.dwNumEntries-1 do

TrafficsList.AddObject(Table.Table[i].bDescr, TTraffic.Create(Table.Table[i]));

FreeLibrary(FLibHandle);

end;

function IntegerToTimeStr(Value: Integer): string;

var d, h, m, s: Real;

begin

d := 0;

h := 0;

m := 0;

s := Value;

if s > 59 then begin

m := int(s / 60);

s := s - (m * 60);

end;

if m > 59 then begin

h := int(m / 60);

m := m - (h * 60);

end;

if h > 23 then begin

d := int(h / 24);

h := h - (d * 24);

end;

Result := '';

if (d > 0) then Result := Result + floattostr(d) + ' d. ';

if (h < 9) then Result := Result + '0' + floattostr(h) + ':' else Result := Result + floattostr(h) + ':';

if (m < 9) then Result := Result + '0' + floattostr(m) + ':' else Result := Result + floattostr(m) + ':';

if (s < 9) then Result := Result + '0' + floattostr(s) else Result := Result + floattostr(s);

end;

{ TSessionInfo50Obj }

constructor TSessionInfo50Obj.Create(SessionInfo50: TSessionInfo50);

begin

FSesi50_cname := SessionInfo50.Sesi50_cname;

FSesi50_username := SessionInfo50.Sesi50_username;

end;

procedure TSessionInfo50Obj.SetSesi50_cname(const Value: WideString);

begin

FSesi50_cname := Value;

end;

procedure TSessionInfo50Obj.Setsesi50_idle_time(const Value: Integer);

begin

Fsesi50_idle_time := Value;

end;

procedure TSessionInfo50Obj.Setsesi50_num_opens(const Value: Integer);

begin

Fsesi50_num_opens := Value;

end;

procedure TSessionInfo50Obj.Setsesi50_time(const Value: Integer);

begin

Fsesi50_time := Value;

end;

procedure TSessionInfo50Obj.SetSesi50_username(const Value: WideString);

begin

FSesi50_username := Value;

end;

{ TSessionInfo502Obj }

constructor TSessionInfo502Obj.Create(SessionInfo502: TSessionInfo502);

begin

FSesi502_cname := SessionInfo502.Sesi502_cname;

FSesi502_username := SessionInfo502.Sesi502_username;

FSesi502_num_opens := SessionInfo502.Sesi502_num_opens;

FSesi502_Time := SessionInfo502.Sesi502_time;

Fsesi502_idle_time := SessionInfo502.Sesi502_idle_time;

end;

procedure TSessionInfo502Obj.SetSesi502_cname(const Value: WideString);

begin

FSesi502_cname := Value;

end;

procedure TSessionInfo502Obj.Setsesi502_idle_time(const Value: DWord);

begin

Fsesi502_idle_time := Value;

end;

procedure TSessionInfo502Obj.SetSesi502_num_opens(const Value: DWord);

begin

FSesi502_num_opens := Value;

end;

procedure TSessionInfo502Obj.SetSesi502_Time(const Value: DWord);

begin

FSesi502_Time := Value;

end;

procedure TSessionInfo502Obj.SetSesi502_username(const Value: WideString);

begin

FSesi502_username := Value;

end;

{ TFileInfo3Obj }

constructor TFileInfo3Obj.Create(FileInfo3: TFileInfo3);

begin

Ffi3_id := FileInfo3.fi3_id;

Ffi3_permissions := FileInfo3.fi3_permissions;

Ffi3_num_locks := FileInfo3.fi3_num_locks;

Ffi3_pathname := FileInfo3.fi3_pathname;

Ffi3_username := FileInfo3.fi3_username;

end;

procedure TFileInfo3Obj.Setfi3_id(const Value: DWord);

begin

Ffi3_id := Value;

end;

procedure TFileInfo3Obj.Setfi3_num_locks(const Value: DWord);

begin

Ffi3_num_locks := Value;

end;

procedure TFileInfo3Obj.Setfi3_pathname(const Value: WideString);

begin

Ffi3_pathname := Value;

end;

procedure TFileInfo3Obj.Setfi3_permissions(const Value: DWord);

begin

Ffi3_permissions := Value;

end;

procedure TFileInfo3Obj.Setfi3_username(const Value: WideString);

begin

Ffi3_username := Value;

end;

{ TFileInfo50Obj }

constructor TFileInfo50Obj.Create(FileInfo50: TFileInfo50);

begin

Ffi50_id := FileInfo50.fi50_id;

Ffi50_permissions := FileInfo50.fi50_permissions;

Ffi50_num_locks := FileInfo50.fi50_num_locks;

Ffi50_pathname := FileInfo50.fi50_pathname;

Ffi50_username := FileInfo50.fi50_username;

Ffi50_sharename := FileInfo50.fi50_sharename;

end;

procedure TFileInfo50Obj.Setfi50_id(const Value: Integer);

begin

Ffi50_id := Value;

end;

procedure TFileInfo50Obj.Setfi50_num_locks(const Value: WORD);

begin

Ffi50_num_locks := Value;

end;

procedure TFileInfo50Obj.Setfi50_pathname(const Value: string);

begin

Ffi50_pathname := Value;

end;

procedure TFileInfo50Obj.Setfi50_permissions(const Value: WORD);

begin

Ffi50_permissions := Value;

end;

procedure TFileInfo50Obj.Setfi50_sharename(const Value: string);

begin

Ffi50_sharename := Value;

end;

procedure TFileInfo50Obj.Setfi50_username(const Value: string);

begin

Ffi50_username := Value;

end;

{ TTraffic }

constructor TTraffic.Create(MibIfRow: TMibIfRow);

begin

FCaption := string(MibIfRow.bDescr);

FMAC := GetMAC(TMAC(MibIfRow.bPhysAddr), MibIfRow.dwPhysAddrLen);

FdwInOctets := MibIfRow.dwInOctets;

FdwOutOctets := MibIfRow.dwOutOctets;

end;

procedure TTraffic.SetCaption(const Value: string);

begin

FCaption := Value;

end;

procedure TTraffic.SetdwInOctets(const Value: Integer);

begin

FdwInOctets := Value;

end;

procedure TTraffic.SetdwOutOctets(const Value: Integer);

begin

FdwOutOctets := Value;

end;

procedure TTraffic.SetMAC(const Value: string);

begin

FMAC := Value;

end;

function TTraffic.GetMAC(Value: TMAC; Length: DWORD): string;

var

i: Integer;

begin

if Length = 0 then Result := '00-00-00-00-00-00' else

begin

Result := '';

for i := 0 to Length - 2 do

Result := Result + IntToHex(Value[i], 2) + '-';

Result := Result + IntToHex(Value[Length - 1], 2);

end;

{ TSessionInfo2Obj }

constructor TShareInfo2Obj.Create(ShareInfo2: TShareInfo2);

begin

Fshi2_netname := ShareInfo2.shi2_netname;

Fshi2_path := ShareInfo2.shi2_path;

end;

procedure TShareInfo2Obj.Setshi2_netname(const Value: string);

begin

Fshi2_netname := Value;

end;

procedure TShareInfo2Obj.Setshi2_path(const Value: string);

begin

Fshi2_path := Value;

end;

{ TShareInfo50Obj }

constructor TShareInfo50Obj.Create(ShareInfo50: TShareInfo50);

begin

Fshi50_netname := ShareInfo50.shi50_netname;

Fshi50_path := ShareInfo50.shi50_path;

end;

procedure TShareInfo50Obj.Setshi50_netname(const Value: string);

begin

Fshi50_netname := Value;

end;

procedure TShareInfo50Obj.Setshi50_path(const Value: string);

begin

Fshi50_path := Value;

end;

end.

unit NetSendUtils;

interface

uses Classes, Windows;

procedure GetNetGroupNameList(Names: TStrings);

procedure GetComputerNameList(GroupName: string; Names: TStrings);

implementation

procedure GetNetGroupNameList(Names: TStrings);

var

lphEnum: THandle;

Buf1, Buf2: Pointer;

Count, BufSize, Res: DWORD;

P: ^TNetResource;

I, J: Integer;

List: TList;

NetResource: TNetResource;

begin

//获取整个网络中的文件资源的句柄，lphEnum为返回名柄

Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

RESOURCEUSAGE_CONTAINER, nil, lphEnum);

if Res <> NO_ERROR then

Exit; //执行失败

//获取整个网络中的网络类型信息

Count := $FFFFFFFF; //不限资源数目

BufSize := 8192; //缓冲区大小设置为8K

GetMem(Buf1, BufSize); //申请内存，用于获取工作组信息

List := TList.Create;

try

Res := WNetEnumResource(lphEnum, Count, Pointer(Buf1), BufSize);

if (Res = ERROR_NO_MORE_ITEMS) or (Res <> NO_ERROR) then

Exit; //资源列举完毕或者执行失败

P := Buf1;

for I := 0 to Count - 1 do

begin

List.Add(p);

Inc(P);

end;

Res := WNetCloseEnum(lphEnum); //关闭一次列举

if Res <> NO_ERROR then exit;

for I := 0 to List.Count -1 do

begin

NetResource := TNetResource(List.Items[I]^);

Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,

RESOURCEUSAGE_CONTAINER, @NetResource, lphEnum);

if Res <> NO_ERROR then break; //执行失败

Names.Clear;

while True do

begin

Count := $FFFFFFFF; //不限资源数目

GetMem(Buf2, BufSize); //申请内存，用于获取工作组信息

try

Res := WNetEnumResource(lphEnum, Count, Pointer(Buf2), BufSize); //获取一个网络类型的文件资源信息

if (Res = ERROR_NO_MORE_ITEMS) or (Res <> NO_ERROR) then

Break; //资源列举完毕或者执行失败

P := Buf2;

for J := 0 to Count - 1 do //列举各个工作组的信息

begin

Names.Add(P^.lpRemoteName);

Inc(P);

end;

finally

FreeMem(Buf2, BufSize);

end;

finally

FreeMem(Buf1, BufSize);

List.Free;

end;

procedure GetComputerNameList(GroupName: string;Names: TStrings);

var

NetResource: TNetResource;

P: ^TNetResource;

lphEnum: THandle;

Buf1: Pointer;

Count, BufSize, Res: DWORD;

I: Integer;

begin

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; //执行失败

Names.Clear;

while True do //列举指定工作组的网络资源

begin

Count := $FFFFFFFF; //不限资源数目

BufSize := 8192; //缓冲区大小设置为8K

GetMem(Buf1, BufSize); //申请内存，用于获取工作组信息

try

Res := WNetEnumResource(lphEnum, Count, Pointer(Buf1), BufSize);

if Res = ERROR_NO_MORE_ITEMS then break; //资源列举完毕

if (Res <> NO_ERROR) then Exit; //执行失败

P := Buf1;

for I := 0 to Count - 1 do //列举工作组的计算机名称

begin

Names.Add(P^.lpRemoteName + 2);

Inc(P);

end;

finally

FreeMem(Buf1);

end;

end.

unit MainFrm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ImgList, StdCtrls, ExtCtrls, ComCtrls, ToolWin, Menus, ActnList, TrayIcon;

type

TMainForm = class(TForm)

StatusBar1: TStatusBar;

ToolBar1: TToolBar;

ToolButton1: TToolButton;

ToolButton2: TToolButton;

TreeImageList: TImageList;

Panel1: TPanel;

Panel2: TPanel;

gbxTraffic: TGroupBox;

bvlTraffic: TBevel;

lvTraffic: TListView;

gbxShares: TGroupBox;

gbxSessions: TGroupBox;

bvlSessions: TBevel;

lvSessions: TListView;

pmShare: TPopupMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

pmSession: TPopupMenu;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

Splitter1: TSplitter;

PnlMsg: TPanel;

Splitter2: TSplitter;

Splitter3: TSplitter;

PnlClnt: TPanel;

PnlClntTop: TPanel;

PnlClntBtm: TPanel;

BtnOk: TButton;

BtnClose: TButton;

GroupBox1: TGroupBox;

MemoContents: TMemo;

Splitter4: TSplitter;

GroupBox2: TGroupBox;

Label1: TLabel;

EdToName: TEdit;

Label2: TLabel;

EdFrom: TEdit;

Panel3: TPanel;

TvComputer: TTreeView;

pmTraffic: TPopupMenu;

N8: TMenuItem;

ActionList1: TActionList;

ShareRefreshAction: TAction;

ShareCloseAction: TAction;

ShareAddAction: TAction;

SessionRefreshAction: TAction;

SessionCloseAction: TAction;

NetImageList: TImageList;

TrafficRefreshAction: TAction;

Bevel1: TBevel;

LvShares: TListView;

Timer1: TTimer;

FileRefreshAction: TAction;

FileCloseAction: TAction;

pmFiles: TPopupMenu;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

Splitter6: TSplitter;

GroupBox3: TGroupBox;

Bevel2: TBevel;

LvFiles: TListView;

N12: TMenuItem;

N13: TMenuItem;

N14: TMenuItem;

N15: TMenuItem;

pmTree: TPopupMenu;

N16: TMenuItem;

PopupMenu1: TPopupMenu;

N17: TMenuItem;

N18: TMenuItem;

N19: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure TvComputerClick(Sender: TObject);

procedure BtnCloseClick(Sender: TObject);

procedure BtnOkClick(Sender: TObject);

procedure EdToNameChange(Sender: TObject);

procedure ShareRefreshActionExecute(Sender: TObject);

procedure ShareCloseActionExecute(Sender: TObject);

procedure LvSharesMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure ShareAddActionExecute(Sender: TObject);

procedure SessionRefreshActionExecute(Sender: TObject);

procedure SessionCloseActionExecute(Sender: TObject);

procedure TrafficRefreshActionExecute(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure FileRefreshActionExecute(Sender: TObject);

procedure lvSessionsMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure LvFilesMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FileCloseActionExecute(Sender: TObject);

procedure N13Click(Sender: TObject);

procedure N15Click(Sender: TObject);

procedure N16Click(Sender: TObject);

procedure N19Click(Sender: TObject);

procedure N17Click(Sender: TObject);

procedure TvComputerContextPopup(Sender: TObject; MousePos: TPoint;

var Handled: Boolean);

private

{ Private declarations }

procedure WMSysCommand(var Msg: TMessage); message WM_SYSCOMMAND;

procedure WMHotkeyHandle(var Msg: Tmessage); message WM_HOTKEY;

public

{ Public declarations }

FRootNode, FCurNode: TTreeNode;

FSendToNames: TStrings;

TrayNotifyIcon1: TTrayNotifyIcon;

HotKeyid: Integer;

procedure ShowMainForm(Sender: TObject);

end;

var

MainForm: TMainForm;

implementation

uses MultInst, NetUtils, SendPopupMsg, NetMonUtils, ShlObj, LKQDialogs, ShellAPI, Clipbrd;

{$R *.DFM}

procedure TMainForm.FormActivate(Sender: TObject);

begin

FRootNode := TvComputer.Items.add(TvComputer.topitem, '整个网络');

FRootNode.imageindex := 0;

TvComputer.SetFocus;

end;

procedure TMainForm.TvComputerClick(Sender: TObject);

var

SelectedNode, Node: TTreeNode;

Strs: TStrings;

I: Integer;

begin

if TvComputer.Selected = nil then

Exit;

SelectedNode := TvComputer.Selected;

Strs := TStringList.Create;

try

if SelectedNode.Level = 0 then

begin

if SelectedNode.count = 0 then

begin

GetNetGroupNameList(Strs);

for I := 0 to Strs.Count - 1 do

begin

Node := TvComputer.Items.AddChild(FRootNode, Strs[I]);

Node.ImageIndex := 1;

Node.SelectedIndex := 1;

end;

if SelectedNode.level = 1 then

begin

if SelectedNode.count = 0 then

begin

GetComputerNameList(SelectedNode.Text, Strs);

for I := 0 to Strs.Count - 1 do

begin

Node := TvComputer.Items.AddChild(SelectedNode, Strs[I]);

Node.ImageIndex := 2;

Node.SelectedIndex := 4;

end;

if SelectedNode.level = 2 then

begin

if FSendToNames.IndexOf(SelectedNode.Parent.Text + '*') <> -1 then Exit;

if FSendToNames.IndexOf(SelectedNode.Text) = -1 then

FSendToNames.Add(SelectedNode.Text);

EdToName.Text := FSendToNames.CommaText;

end;

finally

Strs.Free;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

FSendToNames := TStringList.Create;

SetWindowLong(EdToName.Handle, GWL_STYLE,

GetWindowLong(EdToName.Handle, GWL_STYLE) or

ES_UPPERCASE);

SetWindowLong(EdFrom.Handle, GWL_STYLE,

GetWindowLong(EdFrom.Handle, GWL_STYLE) or

ES_UPPERCASE);

TrayNotifyIcon1 := TTrayNotifyIcon.Create(Self);

with TrayNotifyIcon1 do

begin

Icon := Application.Icon;

Hint := Application.Title;

OnDblClick := ShowMainForm;

PopupMenu := PopupMenu1;

HideTask := False;

IconVisible := True;

end;

Hotkeyid := GlobalAddAtom('UserDefineHotKey') - $C000;

RegisterHotkey(Handle, Hotkeyid, MOD_CONTROL, VK_RETURN);

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

FSendToNames.Free;

TrayNotifyIcon1.Free;

UnRegisterhotkey(Handle, Hotkeyid);

DeleteAtom(HotKeyID);

end;

procedure TMainForm.BtnCloseClick(Sender: TObject);

begin

Application.Terminate;

end;

procedure TMainForm.BtnOkClick(Sender: TObject);

var

I, J: Integer;

begin

StatusBar1.SimpleText := '';

for I := 0 to FSendToNames.Count - 1 do

begin

J := SendTextMessage(FSendToNames[I], EdFrom.Text, MemoContents.Lines.Text);

if J <> 0 then

StatusBar1.SimpleText := StatusBar1.SimpleText + FSendToNames[I] + ' ';

end;

if StatusBar1.SimpleText <> '' then StatusBar1.SimpleText := StatusBar1.SimpleText + '没有收到';

end;

procedure TMainForm.EdToNameChange(Sender: TObject);

var

NameList: TStrings;

I: Integer;

begin

NameList := TStringList.Create;

try

NameList.CommaText := EdToName.Text;

for I := (FSendToNames.Count - 1) downto 0 do

begin

if NameList.IndexOf(FSendToNames[I]) = -1 then

FSendToNames.Delete(I);

end;

if EdToName.Text <> FSendToNames.CommaText then

begin

FSendToNames.Assign(NameList);

EdToName.Text := FSendToNames.CommaText;

end;

finally

NameList.Free;

end;

btnOK.Enabled := Trim(EdToName.Text) <> '';

end;

procedure TMainForm.ShareRefreshActionExecute(Sender: TObject);

var

List: TStrings;

I: Integer;

OS: Boolean;

ShareInfo2Obj: TShareInfo2Obj;

begin

if not IsNT(OS) then Exit;

List := TStringList.Create;

try

GetShares(List);

LvShares.Items.BeginUpdate;

try

LvShares.Items.Clear;

for I := 0 to List.Count - 1 do

begin

ShareInfo2Obj := TShareInfo2Obj(List.Objects[I]);

if ShareInfo2Obj <> nil then

begin

with LvShares.Items.Add do

begin

Caption := List[I];

SubItems.Add(ShareInfo2Obj.shi2_path);

end;

finally

LvShares.Items.EndUpdate;

end;

finally

List.Free;

end;

procedure TMainForm.ShareCloseActionExecute(Sender: TObject);

begin

if (LvShares.Items.Count = 0) or (LvShares.Selected = nil) then

Exit;

if Application.MessageBox('确实要关闭该共享吗？', '提示', MB_YESNO + MB_ICONQUESTION) <> ID_YES then

Exit;

CloseShare(LvShares.Selected.Caption);

LvShares.Items.Delete(LvShares.Selected.Index);

end;

procedure TMainForm.LvSharesMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

ShareCloseAction.Enabled := (LvShares.Items.Count <> 0) and (LvShares.Selected <> nil);

N13.Enabled := ShareCloseAction.Enabled;

end;

function SelectDirectory: string;

var

lpItemID: PItemIDList;

BrowseInfo: TBrowseInfo;

DisplayName: array[0..MAX_PATH] of Char;

TempPath: array[0..MAX_PATH] of Char;

begin

FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);

BrowseInfo.hwndOwner := MainForm.Handle;

BrowseInfo.pszDisplayName := @DisplayName;

BrowseInfo.lpszTitle := '请选择共享目录:';

BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;

lpItemID := SHBrowseForFolder(BrowseInfo);

if Assigned(lpItemId) then begin

SHGetPathFromIDList(lpItemID, TempPath);

GlobalFreePtr(lpItemID);

end else Result := '';

Result := string(TempPath);

end;

procedure TMainForm.TvComputerContextPopup(Sender: TObject;

MousePos: TPoint; var Handled: Boolean);

begin

FCurNode := TvComputer.GetNodeAt(MousePos.X, MousePos.Y);

if FCurNode <> nil then

N16.Enabled := FCurNode.Level = 1;

end;

procedure TMainForm.ShareAddActionExecute(Sender: TObject);

var

Name, Dir: string;

begin

if Sys_SelectDirectory(Self.Handle, Dir, '请选择共享目录：', True) then

begin

Name := InputBox('输入', '请输入共享名称', ExtractFileName(Dir));

AddShare(Name, Dir);

with LvShares.Items.Add do

begin

Caption := Name;

SubItems.Add(Dir);

end;

procedure TMainForm.SessionRefreshActionExecute(Sender: TObject);

var

List: TStrings;

I: Integer;

OS: Boolean;

SessionInfo502Obj: TSessionInfo502Obj;

begin

if not IsNT(OS) then Exit;

List := TStringList.Create;

try

GetSessions(List);

lvSessions.Items.Clear;

for I := 0 to List.Count - 1 do

begin

SessionInfo502Obj := TSessionInfo502Obj(List.Objects[I]);

if SessionInfo502Obj <> nil then

begin

with lvSessions.Items.Add do

begin

Caption := List[I];

SubItems.Add(SessionInfo502Obj.Sesi502_username);

SubItems.Add(IntToStr(SessionInfo502Obj.Sesi502_num_opens));

SubItems.Add(IntegerToTimeStr(SessionInfo502Obj.Sesi502_Time));

SubItems.Add(IntegerToTimeStr(SessionInfo502Obj.sesi502_idle_time));

end;

finally

List.Free;

end;

procedure TMainForm.SessionCloseActionExecute(Sender: TObject);

begin

if (lvSessions.Items.Count = 0) or (lvSessions.Selected = nil) then

Exit;

if Application.MessageBox('确实要关闭该会话吗？', '提示', MB_YESNO + MB_ICONQUESTION) <> ID_YES then

Exit;

CloseSession(lvSessions.Selected.Caption);

lvSessions.Items.Delete(lvSessions.Selected.Index);

end;

procedure TMainForm.TrafficRefreshActionExecute(Sender: TObject);

var

List: TStrings;

I: Integer;

OS: Boolean;

Traffic: TTraffic;

begin

if not IsNT(OS) then Exit;

List := TStringList.Create;

try

GetTrafficSets(List);

lvTraffic.Items.BeginUpdate;

try

lvTraffic.Items.Clear;

for I := 0 to List.Count - 1 do

begin

Traffic := TTraffic(List.Objects[I]);

if Traffic <> nil then

begin

with lvTraffic.Items.Add do

begin

Caption := List[I];

SubItems.Add(Traffic.MAC);

SubItems.Add(IntToStr(Traffic.dwInOctets));

end;

finally

lvTraffic.Items.EndUpdate;

end;

finally

List.Free;

end;

procedure TMainForm.Timer1Timer(Sender: TObject);

begin

ShareRefreshActionExecute(nil);

SessionRefreshActionExecute(nil);

TrafficRefreshActionExecute(nil);

FileRefreshActionExecute(nil);

if LvFiles.Items.Count <> 0 then

ShowMainForm(nil);

end;

procedure TMainForm.FormShow(Sender: TObject);

begin

ShareRefreshActionExecute(nil);

SessionRefreshActionExecute(nil);

TrafficRefreshActionExecute(nil);

FileRefreshActionExecute(nil);

Timer1.Enabled := True;

end;

procedure TMainForm.FileRefreshActionExecute(Sender: TObject);

var

List: TStrings;

I: Integer;

OS: Boolean;

FileInfo3Obj: TFileInfo3Obj;

begin

if not IsNT(OS) then Exit;

List := TStringList.Create;

try

GetFiles(List);

lvFiles.Items.BeginUpdate;

try

lvFiles.Items.Clear;

for I := 0 to List.Count - 1 do

begin

FileInfo3Obj := TFileInfo3Obj(List.Objects[I]);

if FileInfo3Obj <> nil then

begin

with lvFiles.Items.Add do

begin

Caption := List[I];

SubItems.Add(FileInfo3Obj.fi3_pathname);

SubItems.Add(FileInfo3Obj.fi3_username);

end;

finally

lvFiles.Items.EndUpdate;

end;

finally

List.Free;

end;

procedure TMainForm.lvSessionsMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

SessionCloseAction.Enabled := (lvSessions.Items.Count <> 0) and (lvSessions.Selected <> nil);

N15.Enabled := SessionCloseAction.Enabled;

end;

procedure TMainForm.LvFilesMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

FileCloseAction.Enabled := (LvFiles.Items.Count <> 0) and (LvFiles.Selected <> nil);

end;

procedure TMainForm.FileCloseActionExecute(Sender: TObject);

begin

if (lvFiles.Items.Count = 0) or (lvFiles.Selected = nil) then

Exit;

if Application.MessageBox('确实要关闭该会话吗？', '提示', MB_YESNO + MB_ICONQUESTION) <> ID_YES then

Exit;

CloseFile(lvFiles.Selected.Caption);

lvFiles.Items.Delete(lvFiles.Selected.Index);

end;

procedure TMainForm.N13Click(Sender: TObject);

var

Path: string;

begin

if LvShares.Selected <> nil then

begin

Path := LvShares.Selected.SubItems[0];

ShellExecute(0, 'explore', PChar(Path),

nil, nil, SW_NORMAL);

end;

procedure TMainForm.N15Click(Sender: TObject);

var

Name: string;

begin

if LvSessions.Selected <> nil then

begin

Name := LvSessions.Selected.SubItems[0];

Clipboard.AsText := Name

end;

procedure TMainForm.N16Click(Sender: TObject);

begin

if FSendToNames.IndexOf(FCurNode.Text + '*') = -1 then

FSendToNames.Add(FCurNode.Text + '*');

EdToName.Text := EdToName.Text + FCurNode.Text + '*';

end;

procedure TMainForm.N19Click(Sender: TObject);

begin

Application.Terminate;

end;

procedure TMainForm.N17Click(Sender: TObject);

begin

ShowMainForm(nil);

end;

procedure TMainForm.ShowMainForm(Sender: TObject);

begin

TrayNotifyIcon1.HideTask := False;

end;

procedure TMainForm.WMSysCommand(var Msg: TMessage);

begin

if (Msg.WParam = SC_CLOSE) then

Msg.WParam := SC_MINIMIZE;

inherited;

if (Msg.WParam = SC_MINIMIZE) then

TrayNotifyIcon1.HideTask := True;

end;

procedure TMainForm.WMHotkeyHandle(var Msg: Tmessage);

begin

if (Msg.LParamHi = VK_RETURN) and (Msg.lparamLo = MOD_CONTROL) then

begin

if BtnOk.Enabled then

BtnOkClick(nil);

Msg.Result := 1;

end;

end.

界面dfm文件

object MainForm: TMainForm

Left = 64

Top = 98

Width = 921

Height = 577

Color = clBtnFace

Font.Charset = GB2312_CHARSET

Font.Color = clWindowText

Font.Height = -12

Font.Name = '宋体'

Font.Style = []

OldCreateOrder = False

WindowState = wsMaximized

OnActivate = FormActivate

OnCreate = FormCreate

OnDestroy = FormDestroy

OnShow = FormShow

PixelsPerInch = 96

TextHeight = 12

object Splitter2: TSplitter

Left = 0

Top = 233

Width = 913

Height = 3

Cursor = crVSplit

Align = alTop

end

object Splitter3: TSplitter

Left = 0

Top = 446

Width = 913

Height = 3

Cursor = crVSplit

Align = alBottom

end

object StatusBar1: TStatusBar

Left = 0

Top = 531

Width = 913

Height = 19

Panels = <>

SimplePanel = False

end

object ToolBar1: TToolBar

Left = 0

Top = 0

Width = 913

Height = 41

Caption = 'ToolBar1'

TabOrder = 1

Visible = False

object ToolButton1: TToolButton

Left = 0

Top = 2

Caption = 'ToolButton1'

ImageIndex = 0

end

object ToolButton2: TToolButton

Left = 23

Top = 2

Caption = 'ToolButton2'

ImageIndex = 1

end

object Panel1: TPanel

Left = 0

Top = 41

Width = 913

Height = 192

Align = alTop

Caption = 'Panel1'

TabOrder = 2

object Splitter1: TSplitter

Left = 249

Top = 1

Width = 3

Height = 190

Cursor = crHSplit

end

object Splitter6: TSplitter

Left = 641

Top = 1

Width = 3

Height = 190

Cursor = crHSplit

end

object gbxShares: TGroupBox

Left = 1

Top = 1

Width = 248

Height = 190

Align = alLeft

Caption = '共享文件'

TabOrder = 0

object Bevel1: TBevel

Left = 2

Top = 14

Width = 244

Height = 2

Align = alTop

end

object LvShares: TListView

Left = 2

Top = 16

Width = 244

Height = 172

Align = alClient

BorderStyle = bsNone

Columns = <

item

Caption = '名称'

Width = 80

end

item

AutoSize = True

Caption = '文件夹路径'

end>

ColumnClick = False

RowSelect = True

PopupMenu = pmShare

TabOrder = 0

ViewStyle = vsReport

OnMouseDown = LvSharesMouseDown

end

object gbxSessions: TGroupBox

Left = 252

Top = 1

Width = 389

Height = 190

Align = alLeft

Caption = '会话'

TabOrder = 1

object bvlSessions: TBevel

Left = 2

Top = 14

Width = 385

Height = 2

Align = alTop

end

object lvSessions: TListView

Left = 2

Top = 16

Width = 385

Height = 172

Align = alClient

BorderStyle = bsNone

Columns = <

item

Caption = '计算机名'

Width = 70

end

item

Caption = '用户名'

Width = 70

end

item

Alignment = taRightJustify

Caption = '打开连接数'

Width = 100

end

item

Caption = '连接时间'

Width = 70

end

item

AutoSize = True

Caption = '空闲时间'

end>

ColumnClick = False

RowSelect = True

PopupMenu = pmSession

TabOrder = 0

ViewStyle = vsReport

OnMouseDown = lvSessionsMouseDown

end

object GroupBox3: TGroupBox

Left = 644

Top = 1

Width = 268

Height = 190

Align = alClient

Caption = '活动文件'

TabOrder = 2

object Bevel2: TBevel

Left = 2

Top = 14

Width = 264

Height = 2

Align = alTop

end

object LvFiles: TListView

Left = 2

Top = 16

Width = 264

Height = 172

Align = alClient

BorderStyle = bsNone

Columns = <

item

Caption = '序号'

end

item

Caption = '文件路径'

Width = 200

end

item

AutoSize = True

Caption = '用户名称'

end>

ColumnClick = False

RowSelect = True

PopupMenu = pmFiles

TabOrder = 0

ViewStyle = vsReport

OnMouseDown = LvFilesMouseDown

end

object Panel2: TPanel

Left = 0

Top = 449

Width = 913

Height = 82

Align = alBottom

Caption = 'Panel2'

TabOrder = 3

object gbxTraffic: TGroupBox

Left = 1

Top = 1

Width = 911

Height = 80

Align = alClient

Caption = '适配器'

TabOrder = 0

object bvlTraffic: TBevel

Left = 2

Top = 14

Width = 907

Height = 2

Align = alTop

end

object lvTraffic: TListView

Left = 2

Top = 16

Width = 907

Height = 62

Align = alClient

BorderStyle = bsNone

Columns = <

item

Caption = '设备名称'

Width = 300

end

item

Caption = '地址(MAC)'

Width = 300

end

item

Alignment = taRightJustify

Caption = '接收'

Width = 100

end

item

Alignment = taRightJustify

AutoSize = True

Caption = '发送'

end>

ColumnClick = False

RowSelect = True

PopupMenu = pmTraffic

TabOrder = 0

ViewStyle = vsReport

end

object PnlMsg: TPanel

Left = 0

Top = 236

Width = 913

Height = 210

Align = alClient

Caption = 'PnlMsg'

TabOrder = 4

object Splitter4: TSplitter

Left = 249

Top = 1

Width = 3

Height = 208

Cursor = crHSplit

end

object PnlClnt: TPanel

Left = 252

Top = 1

Width = 660

Height = 208

Align = alClient

BevelOuter = bvNone

Caption = 'PnlClnt'

TabOrder = 0

object PnlClntTop: TPanel

Left = 0

Top = 0

Width = 660

Height = 68

Align = alTop

BevelOuter = bvNone

TabOrder = 0

object GroupBox2: TGroupBox

Left = 0

Top = 0

Width = 660

Height = 68

Align = alClient

Caption = '信息发送'

TabOrder = 0

object Label1: TLabel

Left = 7

Top = 15

Width = 48

Height = 12

Caption = '发送到：'

end

object Label2: TLabel

Left = 7

Top = 39

Width = 60

Height = 12

Caption = '本机器名：'

end

object EdToName: TEdit

Left = 66

Top = 10

Width = 586

Height = 20

Anchors = [akLeft, akTop, akRight]

TabOrder = 0

OnChange = EdToNameChange

end

object EdFrom: TEdit

Left = 66

Top = 35

Width = 588

Height = 20

Anchors = [akLeft, akTop, akRight]

TabOrder = 1

end

object PnlClntBtm: TPanel

Left = 0

Top = 175

Width = 660

Height = 33

Align = alBottom

BevelInner = bvLowered

BevelOuter = bvNone

TabOrder = 1

object BtnOk: TButton

Left = 500

Top = 5

Width = 75

Height = 23

Anchors = [akTop, akRight]

Caption = '发送(&O)'

Default = True

Enabled = False

TabOrder = 0

end

object BtnClose: TButton

Left = 580

Top = 5

Width = 75

Height = 23

Anchors = [akTop, akRight]

Caption = '退出(&Q)'

TabOrder = 1

OnClick = BtnCloseClick

end

object GroupBox1: TGroupBox

Left = 0

Top = 68

Width = 660

Height = 107

Align = alClient

Caption = '内容：'

TabOrder = 2

object MemoContents: TMemo

Left = 2

Top = 14

Width = 656

Height = 91

Align = alClient

TabOrder = 0

end

object Panel3: TPanel

Left = 1

Top = 1

Width = 248

Height = 208

Align = alLeft

Caption = 'Panel3'

TabOrder = 1

object TvComputer: TTreeView

Left = 1

Top = 1

Width = 246

Height = 206

Align = alClient

Images = TreeImageList

Indent = 19

PopupMenu = pmTree

ReadOnly = True

TabOrder = 0

OnClick = TvComputerClick

OnContextPopup = TvComputerContextPopup

end

object TreeImageList: TImageList

Left = 168

Top = 320

Bitmap = {

494C010108000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600

0000000000003600000028000000400000003000000001002000000000000030

0000000000000000000000000000000000000000000000000000000000000000

0000F9F5F600E3CED600D1ADBB00C394A600B8859900C192A400D0ACBA00E3CE

D600F9F5F6000000000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000007349

5A0073495A0073495A009C757300000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

000000000000000000000000000000000000000000000000000000000000ECDE

E300CFABB900BE8C9F00C090A300C091A400C091A300BD8C9F00BA869A00B781

9600CDA8B700ECDEE30000000000000000000000000000000000000000000000

0000FBD4D100F6958E00F1605500EE3B2D00EE3B2D00F1605500F6958E00FBD4

D1000000000000000000000000000000000000000000BDA6A500DECFCE00DED3

D600DECBCE00D6C3C600D6B6B500B586840073495A0000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000ECDEE400CBA4

B300C395A700C79DAE00CAA3B300CBA5B300CBA3B200C79DAD00C295A600BC8B

9E00B7829700C69CAC00ECDEE30000000000000000000000000000000000F8AA

A400F0554900EE392B00EE3B2E00EE392B00ED332500ED2C1D00ED2C1D00F04F

4200F8AAA400000000000000000000000000C6AEAD00E7E7E700E7E7E700DEDF

DE00DED3D600CEB2B5009C929400AD7D7B00CEA2A50073495A00000000000000

0000000000000000000000000000000000000000000000000000000000000000

00000000000000000000000000000000000000000000F9F5F600D1AFBD00C498

A900CCA5B400D2AFBD00D5B6C200D7B9C500D5B6C300D1AFBD00CBA4B400C498

A900BD8B9E00B7819600CDA8B700F9F5F6000000000000000000F8ACA600F04A

3E00F04E4100F1584C00F15B5000F0574C00F04E4100EF403200ED322300ED2C

1D00EE382900F8AAA4000000000000000000E7E7E700F7F3F700F7F3F700E7E7

E700DED7D600E7D7D600AD868400AD868400CEA6A5009C696B00000000009C75

730073495A000000000000000000000000000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000E4D0D800C294A600CBA5

B300D4B4C100DBC0CA00DFC8D100E2CCD400E0C8D100DBC0CA00D4B4C100CBA5

B300C294A600BA869B00B7819600E3CED60000000000FCD5D200F2645900F15B

4F00F26E6400F37B7100F3807600F37B7200F36E6300F15B4F00EF453800ED32

2300ED2C1D00F04F4200FBD4D10000000000CEB2B500F7F3F700F7EFEF00EFEB

EF00D6BEBD00D6AAAD00BD797B00BD717300CEA6A5009C696B00D6B2B500D6B2

B500ADA2A5009C75730073495A00000000000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000D4B4C000C79EAD00D2AF

BC00DBC0CA00E3CFD700EBDAE100EDE0E500EADAE100E4CFD700DBC0CB00D2B0

BD00C79DAD00BD8C9F00B7819600D0ACBA0000000000F79F9900F15B5000F376

6D00F58D8400F69C9400F7A19A00F69C9400F58D8400F3776D00F05B4F00EF40

3200ED2C1D00ED2C1D00F6958E000000000000000000DEB6B500F7CB9C00D69A

9C00C68E8C00C6757300C66D6B00CE696B00DECBCE00DEC3C600DEBABD00D6A2

A500B59E9C00B59E9C00ADA2A50073495A000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000C89FB000CAA2B200D6B6

C200DFC9D200EBDBE000F4EBEE00F8F2F400F4EBEE00EADBE100DFC8D100D5B7

C300CAA3B200C090A300B8829700C192A40000000000F37A7000F36E6400F58D

8500F7A6A000F9BCB700FAC4C000F9BCB700F7A7A100F48D8500F36F6400F04E

4200EE332500ED2C1D00F16055000000000000000000D6AEAD00FFA21000FFAA

2100FFB64A00DEAAAD00C66D6B00B5696B00DEC3C600CE9E9C00D6A2A500D6B2

B500AD8684009C696B00B592940073495A000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000C294A400CBA5B300D7B9

C500E1CCD400EDDFE500F8F3F40000000000F8F2F400EDE0E400E2CBD400D7B9

C500CBA5B300C192A300B8849700B883980000000000F1635900F37A7200F69B

9400F9BCB700FBD9D600FCE7E400FBD9D600F9BCB700F69C9500F37B7200F057

4B00EE392B00ED2C1D00EE3B2D000000000000000000D6B2B500FFB63100FFB6

3900FFBA3900FFBA3900FFB63900EFB66B00CE797B00DEAAAD00DEBABD00CEAA

AD00BD8E8C00AD7D7B00B586840073495A000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000C99FAF00CBA3B200D6B6

C300E0C8D200EADBE100F3EBEE00F7F2F400F4EBEE00EADBE100E0C8D200D5B6

C300CAA2B200BF90A300B8829700C192A40000000000F2675C00F47F7700F6A0

9A00F9C5C100FCE6E500FEFEFE00FDE6E400F9C5C100F6A19A00F37F7600F15B

4F00EE3B2E00ED2C1D00EE3B2D000000000000000000CEA6A500FFBE4A00FFC3

5200FFC75200FFC75A00FFC35200FFBE4A00FFBA4200CE696B00DEBABD00D6A2

A500BD8E8C00CE9A9C00B582840073495A000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000D4B4C000C79DAD00D2AF

BD00DBC0CB00E4CFD700EBDBE100EDE0E500EADBE000E4CFD700DBC0CB00D1B0

BD00C79DAD00BD8C9F00B7819600D0ACBA0000000000F4817800F47B7200F69B

9400F9BCB700FBD9D700FCE6E500FBDAD700F9BCB700F69C9400F37B7200F057

4C00EE392B00ED2C1D00F16055000000000000000000C6A28400FFCB5A00FFCF

6B00FFD36B00FFD36B00FFCF6B00FFCB6300FFC35200CE828400DEBABD00D6A2

A500BD8A8C00AD7D7B00AD75730073495A000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000E5D0D800C294A600CBA5

B400D4B4C100DBC0CB00E0C8D100E1CBD400E0C8D100DBC0CB00D4B4C000CCA5

B400C295A700BA869A00B7819600E3CED60000000000F7A6A000F26E6400F48C

8500F7A7A100F8BCB700F9C4C100F9BCB700F7A6A000F58D8500F36E6400F04E

4100ED342500ED2C1D00F6958E0000000000D6B6B500DEA67300FFD37300FFDB

7B00FFDF8400FFDF8C00FFDB8400FFD77B00FFCB6300CE969400DEBABD00D6A2

A500BD8E8C00C68E8C00B582840073495A000000000000000000000000000000

00000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000

FF000000000000000000000000000000000000000000F9F5F600D1AFBD00C498

A900CBA5B400D2AFBD00D6B6C200D7B9C400D6B6C300D1B0BD00CBA5B400C498

A900BD8B9E00B7819600CDA8B700F9F5F60000000000FCD8D500F3766C00F377

6D00F58D8400F69C9500F7A09A00F69B9400F48D8500F3776D00F15B5000EF40

3300ED2C1D00F04F4200FBD4D10000000000D6B6B500FFD37300FFDF8400FFE3

9400FFEB9C00FFEBA500FFE79C00FFE38C00FFD77B00D6AEAD00DEBABD00CE96

9400C6757300AD6D6B00AD75730073495A000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000ECDEE400CBA4

B300C294A600C89DAD00CAA3B200CBA4B400CBA3B200C79DAE00C394A700BD8B

9E00B7829700C69CAC00ECDEE300000000000000000000000000F9B4AF00F264

5A00F26E6400F47B7100F37F7600F37B7100F26E6400F15B4F00EF453800ED32

2300EE382900F8AAA4000000000000000000F7EFEF00FFDB7B00FFE39400FFEF

AD00FFF3B500FFF7BD00FFF3AD00FFEB9C00FFDF8C00E7C3C600EFDBDE00FFFB

FF00DEAAAD00CE696B00CE6D6B0073495A000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

000000000000000000000000000000000000000000000000000000000000ECDE

E300CFACBA00BE8C9F00C090A200C191A400C090A300BE8C9F00BB869B00B781

9600CDA8B700ECDEE3000000000000000000000000000000000000000000F8B2

AD00F26A6100F1574B00F15B5000F0584C00F04E4100EE403200ED312300F04F

4200F8AAA400000000000000000000000000EFEBEF009C929400BD9E9400D6C3

AD00FFFFCE00FFFFCE00FFFBC600FFEFAD00EFC78C00EFCFCE00EFCFCE00EFCF

CE00EFCFCE00D6AEAD00D6AEAD00000000000000000000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

0000F9F5F600E3CED600D0AEBB00C294A600B9849A00C192A400D0ACBA00E3CE

D600F9F5F6000000000000000000000000000000000000000000000000000000

0000FBD5D300F69C9500F26B6100EF473A00EF413300F1605500F6958E00FBD4

D10000000000000000000000000000000000D6B6B500D6B6B500C6BABD00DED3

D600DECBCE00BDA6A500AD868400B59A8C00C6A28400BD929400000000000000

0000000000000000000000000000000000000000000000000000000000000000

000000000000D6B6B500D6B6B500D6B6B500D6B6B50000000000000000000000

0000000000000000000000000000000000000000000000000000000000000000

0000C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6C600C6C6

C600000000000000000000000000000000000000000000000000000000000000

000000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF

0000000000000000000000000000000000000000000000000000000000000000

0000FF000000FF000000FF000000FF000000FF000000FF000000FF000000FF00

0000000000000000000000000000000000000000000000000000000000000000

0000FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00

FF00000000000000000000000000000000000000000000000000000000000000