Библиотека для работы с LAN
Оформил: DeeCo
Автор: Alex
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 .
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Библиотека для работы с LAN", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:
Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи , в сообщение обязательно указывайте название или ссылку на статью!