Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007
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;{record}
 
 
function IsNetConnect : Boolean;
 
{Возвращает TRUE если компьютер подключен к сети, иначе - FALSE}
 
 
function AdapterToString(Adapter: TAdapterStatus): string;
 
{Преобразует MAC адес в привычный xx-xx-xx-xx}
 
 
function GetMacAddresses(const Machine: string;
                           
const Addresses: TStrings): Integer;
 
{Заполняет Addresses MAC-адресами компьютера с сетевым именем  Machine.
   
Возвращает число МАС адресов на компьютере}
 
 
function GetNetUser(HostName: WideString): THostInfo;
 
{Возвращает LOGIN текущего пользователя на HOSTNAME компьютере}
 
implementation
 
uses NB30
, SysUtils;
 
function IsNetConnect : Boolean;
begin
 
if GetSystemMetrics(SM_NETWORK) AND $01 = $01
 
then Result:= True
 
else Result:= False;
end;{function}
 
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}
 
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}
 
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;{if}
   
end;{case}
end; {function}
 
end.

Автор: Alex

Взято с сайта https://www.delphikingdom.ru/