Библиотека для работы с LAN

unit NetProcs;
interface
uses Classes, Windows;
type
 TAdapterStatus = record
 adapter_address: array [0..5] of Char;
 filler: array [1..4 * SizeOf(Char) + 19 * SizeOf(Word) + 3 * SizeOf(DWORD)] of Byte;
 end;
 THostInfo = record
 username: PWideChar;
 logon_domain: PWideChar;
 oth_domains: PWideChar;
 logon_server: PWideChar;
 end;
 { Возвращает TRUE если компьютер подключен к сети, иначе - FALSE }
function IsNetConnect: boolean;
{ Преобразует MAC адес в привычный xx-xx-xx-xx }
function AdapterToString(Adapter: TAdapterStatus): string;
{ Заполняет Addresses MAC-адресами компьютера с сетевым именем Machine.
 Возвращает число МАС адресов на компьютере }
function GetMacAddresses(const Machine: string;
 const Addresses: TStrings): Integer;
{ Возвращает LOGIN текущего пользователя на HOSTNAME компьютере }
function GetNetUser(HostName: WideString): THostInfo;
implementation
uses NB30, SysUtils;
function IsNetConnect: Boolean;
begin
 if GetSystemMetrics(SM_NETWORK) and $01 = $01 then
 Result := True
 else
 Result := False;
end;
function AdapterToString(Adapter: TAdapterStatus): string;
begin
 with Adapter do
 Result :=
 Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
 [Integer(adapter_address[0]), Integer(adapter_address[1]),
 Integer(adapter_address[2]), Integer(adapter_address[3]),
 Integer(adapter_address[4]), Integer(adapter_address[5])]);
end;
function GetMacAddresses(const Machine: string;
 const Addresses: TStrings): integer;
const
 NCBNAMSZ = 16; // absolute length of a net name
 MAX_LANA = 254; // lana's in range 0 to MAX_LANA inclusive
 NRC_GOODRET = $00; // good return
 NCBASTAT = $33; // NCB ADAPTER STATUS
 NCBRESET = $32; // NCB RESET
 NCBENUM = $37; // NCB ENUMERATE LANA NUMBERS
type
 PNCB = ^TNCB;
 TNCBPostProc = procedure(P: PNCB); stdcall;
 TNCB = record
 ncb_command: Byte;
 ncb_retcode: Byte;
 ncb_lsn: Byte;
 ncb_num: Byte;
 ncb_buffer: PChar;
 ncb_length: Word;
 ncb_callname: array [0..NCBNAMSZ - 1] of Char;
 ncb_name: array [0..NCBNAMSZ - 1] of Char;
 ncb_rto: Byte;
 ncb_sto: Byte;
 ncb_post: TNCBPostProc;
 ncb_lana_num: Byte;
 ncb_cmd_cplt: Byte;
 ncb_reserve: array [0..9] of Char;
 ncb_event: THandle;
 end;
 PLanaEnum = ^TLanaEnum;
 TLanaEnum = record
 length: Byte;
 lana: array [0..MAX_LANA] of Byte;
 end;
 ASTAT = record
 adapt: TAdapterStatus;
 namebuf: array [0..29] of TNameBuffer;
 end;
var
 NCB: TNCB;
 Enum: TLanaEnum;
 I: Integer;
 Adapter: ASTAT;
 MachineName: string;
begin
 Result := -1;
 Addresses.Clear;
 MachineName := UpperCase(Machine);
 if MachineName = then
 MachineName := '*';
 FillChar(NCB, SizeOf(NCB), #0);
 NCB.ncb_command := NCBENUM;
 NCB.ncb_buffer := Pointer(@Enum);
 NCB.ncb_length := SizeOf(Enum);
 if word(NetBios(@NCB)) = NRC_GOODRET then
 begin
 Result := Enum.Length;
 for I := 0 to Ord(Enum.Length) - 1 do
 begin
 FillChar(NCB, SizeOf(TNCB), #0);
 NCB.ncb_command := NCBRESET;
 NCB.ncb_lana_num := Enum.lana[I];
 if word(NetBios(@NCB)) = NRC_GOODRET then
 begin
 FillChar(NCB, SizeOf(TNCB), #0);
 NCB.ncb_command := NCBASTAT;
 NCB.ncb_lana_num := Enum.lana[i];
 StrLCopy(NCB.ncb_callname, PChar(MachineName), NCBNAMSZ);
 StrPCopy(@NCB.ncb_callname[Length(MachineName)],
 StringOfChar(' ', NCBNAMSZ - Length(MachineName)));
 NCB.ncb_buffer := PChar(@Adapter);
 NCB.ncb_length := SizeOf(Adapter);
 if word(NetBios(@NCB)) = NRC_GOODRET then
 Addresses.Add(AdapterToString(Adapter.adapt));
 end;
 end;
 end;
end;
function NetWkstaUserEnum(servername: PWideChar; level: DWord;
 var bufptr: Pointer; prefmaxlen: DWord;
 var entriesread: PDWord; var totalentries: PDWord;
 var resumehandle: PDWord
): LongInt; stdcall; external 'netapi32.dll' Name 'NetWkstaUserEnum';
function GetNetUser(HostName: WideString): THostInfo;
var
 Info: Pointer;
 ElTotal: PDWord;
 ElCount: PDWord;
 Resume: PDWord;
 Error: LongInt;
begin
 Resume := 0;
 NetWkstaUserEnum(PWideChar(HostName), 1, Info, 0,
 ElCount, ElTotal, Resume);
 Error := NetWkstaUserEnum(PWideChar(HostName), 1, Info, 256 * Integer(ElTotal),
 ElCount, ElTotal, Resume);
 case Error of
 ERROR_ACCESS_DENIED: Result.UserName := 'ERROR - ACCESS DENIED';
 ERROR_MORE_DATA: Result.UserName := 'ERROR - MORE DATA';
 ERROR_INVALID_LEVEL: Result.UserName := 'ERROR - INVALID LEVEL';
 else
 if Info <> nil then
 Result := THostInfo(info^)
 else
 begin
 Result.username := '???';
 Result.logon_domain := '???';
 Result.oth_domains := '???';
 Result.logon_server := '???';
 end;
 end;
end;
end.
Author: Alex
Source: http://www.delphikingdom.ru/
ID: 03304
Category:Связь