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

Previous  Top  Next

    
 

 

 

Code:

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

 

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

©Drkb::03304