Получение списка серверов в локальной сети

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Алексей Вуколов

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Получение списка серверов в локальной сети

Класс-оболочка для функции NetServerEnum.

Примечание. Проверялось только под WinNT/Win2000 (ничего другого под рукой нет).

Методы

——————

Create( AServer, ADomain : string; AServerMask : longint );

AServer — имя сервера, на котором выполняется функция;

ADomain — имя домена, для которого запрашивается список серверов;

AServerMask — флаги, задающие, список серверов какого типа следует получить.

Этот параметр представляет собой набор флагов SV_TYPE_XXXX. подробнее —

в исходнике и справке по функции WinAPI NetServerEnum.

Refresh.

Обновление списка серверов. Автоматически вызывается при создании класса,

а также при присвоении значения свойству ServerMask.

Свойства

——————

Servers[ index : integer ] : TServerInfo

Список объектов TServerInfo, содержащих информацию о найденных серверах

— имя, версию, флаги.

Count : integer

Количество найденных серверов

ServerMask : longint

Маска поиска серверов. См. описание параметра AServerMask в конструкторе.

Зависимости: Classes

Автор: vuk

Copyright: Алексей Вуколов

Дата: 26 апреля 2002 г.

***************************************************** }

unit NetSrvList;

interface

uses Classes;

const

SV_TYPE_WORKSTATION = $00000001; // All LAN Manager workstations

SV_TYPE_SERVER = $00000002; // All LAN Manager servers

SV_TYPE_SQLSERVER = $00000004; // Any server running with Microsoft SQL Server

SV_TYPE_DOMAIN_CTRL = $00000008; // Primary domain controller

SV_TYPE_DOMAIN_BAKCTRL = $00000010; // Backup domain controller

SV_TYPE_TIMESOURCE = $00000020; // Server running the Timesource service

SV_TYPE_AFP = $00000040; // Apple File Protocol servers

SV_TYPE_NOVELL = $00000080; // Novell servers

SV_TYPE_DOMAIN_MEMBER = $00000100; // LAN Manager 2.x Domain Member

SV_TYPE_LOCAL_LIST_ONLY = $40000000; // Servers maintained by the browser

SV_TYPE_PRINT = $00000200; // Server sharing print queue

SV_TYPE_DIALIN = $00000400; // Server running dial-in service

SV_TYPE_XENIX_SERVER = $00000800; // Xenix server

SV_TYPE_MFPN = $00004000; // Microsoft File and Print for Netware

SV_TYPE_NT = $00001000; // Windows NT (either Workstation or Server)

SV_TYPE_WFW = $00002000; // Server running Windows for Workgroups

SV_TYPE_SERVER_NT = $00008000; // Windows NT non-DC server

SV_TYPE_POTENTIAL_BROWSER = $00010000;

// Server that can run the Browser service

SV_TYPE_BACKUP_BROWSER = $00020000;

// Server running a Browser service as backup

SV_TYPE_MASTER_BROWSER = $00040000;

// Server running the master Browser service

SV_TYPE_DOMAIN_MASTER = $00080000; // Server running the domain master Browser

SV_TYPE_DOMAIN_ENUM = $80000000; // Primary Domain

SV_TYPE_WINDOWS = $00400000; // Windows 95 or later

SV_TYPE_ALL = $FFFFFFFF; // All servers

type

TServerInfo = class(TObject)

svr_Platform_ID: integer;

svr_Name: WideString;

svr_Version_Major,

svr_Version_Minor,

svr_Type: integer;

svr_Comment: WideString;

end;

TServerList = class(TObject)

protected

FList: TList;

FServer, FDomain: WideString;

FServerMask: longint;

procedure Clear;

function GetServer(Index: integer): TServerInfo;

function GetCount: integer;

procedure SetServerMask(const Value: longint);

public

constructor Create(AServer, ADomain: string; AServerMask: longint);

destructor Destroy; override;

procedure Refresh;

property Servers[index: integer]: TServerInfo read GetServer; default;

property Count: integer read GetCount;

property ServerMask: longint read FServerMask write SetServerMask;

end;

implementation

uses

Sysutils;

type

TServer_Info_101 = record

svr_Platform_ID: integer;

svr_Name: PWideChar;

svr_Version_Major,

svr_Version_Minor,

svr_Type: integer;

svr_Comment: PWideChar;

end;

TServer_Infos_101 = array[1..($1FFFFFFF div SizeOf(TServer_Info_101))] of

TServer_Info_101;

function NetServerEnum(ServerName: PWideChar; Level: longint;

var BufPtr: pointer; PrefMaxLen: longint;

var EntriesRead, TotalEntries: longint;

ServType: longint; Domain: PWideChar;

var ResumeHandle: integer): longint;

stdcall; external ‘netapi32.dll’ name ‘NetServerEnum’;

constructor TServerList.Create(AServer, ADomain: string; AServerMask: longint);

begin

inherited Create;

Flist := TList.Create;

FServer := Aserver;

FDomain := ADomain;

FServerMask := AServerMask;

Refresh;

end;

destructor TServerList.Destroy;

begin

Clear;

FList.Free;

inherited Destroy;

end;

function TServerList.GetServer(Index: integer): TServerInfo;

begin

Result := TServerInfo(FList[Index]);

end;

function TServerList.GetCount: integer;

begin

Result := FList.Count;

end;

procedure TServerList.Clear;

var

i: integer;

begin

for i := 0 to FList.Count — 1 do

Servers[i].Free;

Flist.Clear;

end;

procedure TServerList.Refresh;

var

EntRead, EntTotal, Resume, i: integer;

Info: integer;

Itm: TServerInfo;

Data: pointer;

pServer, pDomain: PWideChar;

begin

if FServer » then

pServer := PWideChar(FServer)

else

pServer := nil;

if FDomain » then

pDomain := PWideChar(FDomain)

else

pDomain := nil;

Clear;

Info := NetServerEnum(pServer, 101, Data, -1, EntRead, EntTotal,

FServerMask, pDomain, Resume);

if Info = 0 then

for i := 1 to EntRead do

begin

Itm := TServerInfo.Create;

with TServer_Infos_101(Data^)[i] do

begin

Itm.svr_Platform_ID := svr_Platform_ID;

Itm.svr_Name := svr_Name;

Itm.svr_Version_Major := svr_Version_Major;

Itm.svr_Version_Minor := svr_Version_Minor;

Itm.svr_Type := svr_Type;

Itm.svr_Comment := svr_Comment;

end;

FList.Add(Itm);

end

else

raise Exception.Create(‘Cannot get server list’);

end;

procedure TServerList.SetServerMask(const Value: longint);

begin

FServerMask := Value;

Refresh;

end;

end.

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);

var

List: TServerList;

i: integer;

begin

List := TServerList.Create(», », SV_TYPE_ALL);

for i := 0 to List.Count — 1 do

with List[i] do

Memo1.Lines.Add(Format(‘%s %s %d.%d %s %x’,

[svr_Name, #9, svr_Version_Major, svr_Version_Minor, #9, svr_Type]));

end;

{/codecitation}

Получение сетевого имени пользователя

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Защита от «дурака» спасает только от неизобретательного дурака.

Вы можете попробовать этот код. Я без проблем использовал его под Netware LAN в течение долгого времени. Работа программы зависит от наличия NWCALLS.DLL на машине пользователя, но если он использовал сеть хоть раз, данная библиотека должна присутствовать на его машине.

unit GetLogin;

{

Данный модуль инкапсулирует несколько внешних

функций библиотеки NWCALLS.DLL

Создан на основе кода Григория Трубецкого

Модуль содержит функции, возвращающие Netware User ID

и полное имя пользователя.

}

interface

uses

SysUtils, Messages, Dialogs;

function GetUserLogin: string;

function GetUserFullName(SomeUser: string): string;

implementation

type

NWTimeStamp = record

Year: byte;

Month: byte;

Day: byte;

Hour: byte;

Minute: byte;

Second: byte;

DayOfWeek: byte;

end;

{Netware API — требуется NWCALLS.DLL}

function NWGetDefaultConnectionID(var Connection: word): word;

far; external ‘NWCALLS’;

function NWGetConnectionNumber(Connection: word; var ConnectionNumber:

word): word;

far; external ‘NWCALLS’;

function NWGetConnectionInformation(Connection: word;

ConnectionNumber: word;

ObjectName: pchar;

var ObjectType: word;

var ObjectID: word;

var LoginTime: NWTimeStamp): word;

far; external ‘NWCALLS’;

function NWReadPropertyValue(Connection: word;

ObjectName: pChar;

ObjectType: word;

PropertyName: pChar;

DataSetIndex: byte;

DataBuffer: pChar;

var More: byte;

var Flags: byte): word;

far; external ‘NWCALLS’;

{ конец секции работы с Netware API }

function GetUserLogin: string;

var

ConnectionID: word;

ConnectionNumber: word;

RC: word;

Name: array[0..50] of Char;

ObjectType: word;

ObjectID: word;

LoginTime: NWTimeStamp;

begin

RC := NWGetDefaultConnectionID(ConnectionID);

RC := NWGetConnectionNumber(ConnectionID, ConnectionNumber);

RC := NWGetConnectionInformation(ConnectionID,

ConnectionNumber,

Name,

ObjectType,

ObjectID,

LoginTime);

Result := StrPas(Name);

end;

function GetUserFullName(SomeUser: string): string;

{Реально имя пользователя является свойством ‘IDENTIFICATON’.

Вы должны вызывать NWReadPropertyValue с параметрами (между прочим) вашего ConnectionID,

имени объекта (такое же, как и логин пользователя, сетевое имя которого мы пытаемся узнать)

и свойство name, которое нам необходимо получить, в нашем случае ‘IDENTIFICATION’

(это и есть искомая величина — полное имя пользователя).}

var

ConnectionID: word;

RC: word;

Name: array[0..50] of Char;

ObjectType: word;

PropName: array[0..14] of Char;

DataSetIndex: byte;

FullName: array[0..127] of Char;

More: byte;

Flags: byte;

begin

RC := NWGetDefaultConnectionID(ConnectionID);

ObjectType := 256; {пользователь}

StrPCopy(PropName, ‘IDENTIFICATION’);

DataSetIndex := 1;

StrPCopy(Name, SomeUser);

RC := NWReadPropertyValue(ConnectionID,

Name,

ObjectType,

PropName,

DataSetIndex,

FullName,

More,

Flags);

if RC = 35324 then

MessageDlg(‘Пользователь ‘ SomeUser ‘ на этом сервере не обнаружен!’,

mtError, [mbOK], 0);

Result := StrPas(FullName);

end;

end.

{/codecitation}

Показать диалог выбора компьютера

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

— Дорогой, ты кого больше любишь? Меня или эту дурацкую штуку, за которой ты проводить целый, св#лочь!!!

— Ну, киса, как ты можешь сравнивать неодушевленный предмет с компьютером?!

{

The «Choose Computer» is a dialog provided by network services

(NTLANMAN.DLL) for Windows 2k/NT/XP

to display the servers and their computers.

}

type

TServerBrowseDialogA0 = function(hwnd: HWND; pchBuffer: Pointer; cchBufSize: DWORD): bool;

stdcall;

function ShowServerDialog(AHandle: THandle): string;

var

ServerBrowseDialogA0: TServerBrowseDialogA0;

LANMAN_DLL: DWORD;

buffer: array[0..1024] of char;

bLoadLib: Boolean;

begin

LANMAN_DLL := GetModuleHandle(‘NTLANMAN.DLL’);

if LANMAN_DLL = 0 then

begin

LANMAN_DLL := LoadLibrary(‘NTLANMAN.DLL’);

bLoadLib := True;

end;

if LANMAN_DLL 0 then

begin @ServerBrowseDialogA0 := GetProcAddress(LANMAN_DLL, ‘ServerBrowseDialogA0’);

DialogBox(HInstance, MAKEINTRESOURCE(101), AHandle, nil);

ServerBrowseDialogA0(AHandle, @buffer, 1024);

if buffer[0] = ‘\’ then

begin

Result := buffer;

end;

if bLoadLib then

FreeLibrary(LANMAN_DLL);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

label1.Caption := ShowServerDialog(Form1.Handle);

end;

{/codecitation}

Перечислить сетевые соединения

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Речь сисадмина к девушке, пришедшей регистрироваться на сервере:

— С точки зрения сетевой безопасности вы представляете собой потенциальную дырку.

{

From the MS-DOS prompt, you can enumerate the network

connections (drives) by using the following command:

net use

Programmatically, you would call WNetOpenEnum() to start

the enumeration of connected resources and

WNetEnumResources() to continue the enumeration.

The following sample code enumerates the network connections:

}

procedure TForm1.Button1Click(Sender: TObject);

var

i, dwResult: DWORD;

hEnum: THandle;

lpnrDrv: PNETRESOURCE;

s: string;

const

cbBuffer: DWORD = 16384;

cEntries: DWORD = $FFFFFFFF;

begin

dwResult := WNetOpenEnum(RESOURCE_CONNECTED,

RESOURCETYPE_ANY,

0,

nil,

hEnum);

if (dwResult NO_ERROR) then

begin

ShowMessage(‘Cannot enumerate network drives.’);

Exit;

end;

s := »;

repeat

lpnrDrv := PNETRESOURCE(GlobalAlloc(GPTR, cbBuffer));

dwResult := WNetEnumResource(hEnum, cEntries, lpnrDrv, cbBuffer);

if (dwResult = NO_ERROR) then

begin

s := ‘Network drives:’#13#10;

for i := 0 to cEntries — 1 do

begin

if lpnrDrv^.lpLocalName nil then

s := s lpnrDrv^.lpLocalName #9 lpnrDrv^.lpRemoteName;

Inc(lpnrDrv);

end;

end

else if dwResult ERROR_NO_MORE_ITEMS then

begin

s := s ‘Cannot complete network drive enumeration’;

GlobalFree(HGLOBAL(lpnrDrv));

break;

end;

GlobalFree(HGLOBAL(lpnrDrv));

until (dwResult = ERROR_NO_MORE_ITEMS);

WNetCloseEnum(hEnum);

if s = » then s := ‘No network connections.’;

ShowMessage(s);

end;

{***********************************************************************

FindComp Unit from

Fatih Olcer

fatiholcer@altavista.com

***********************************************************************}

unit FindComp;

interface

uses

Windows, Classes;

function FindComputers: DWORD;

var

Computers: TStringList;

implementation

uses

SysUtils;

const

MaxEntries = 250;

function FindComputers: DWORD;

var

EnumWorkGroupHandle, EnumComputerHandle: THandle;

EnumError: DWORD;

Network: TNetResource;

WorkGroupEntries, ComputerEntries: DWORD;

EnumWorkGroupBuffer, EnumComputerBuffer: array[1..MaxEntries] of TNetResource;

EnumBufferLength: DWORD;

I, J: DWORD;

begin

Computers.Clear;

FillChar(Network, SizeOf(Network), 0);

with Network do

begin

dwScope := RESOURCE_GLOBALNET;

dwType := RESOURCETYPE_ANY;

dwUsage := RESOURCEUSAGE_CONTAINER;

end;

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0,

@Network, EnumWorkGroupHandle);

if EnumError = NO_ERROR then

begin

WorkGroupEntries := MaxEntries;

EnumBufferLength := SizeOf(EnumWorkGroupBuffer);

EnumError := WNetEnumResource(EnumWorkGroupHandle, WorkGroupEntries,

@EnumWorkGroupBuffer, EnumBufferLength);

if EnumError = NO_ERROR then

begin

for I := 1 to WorkGroupEntries do

begin

EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0,

@EnumWorkGroupBuffer[I], EnumComputerHandle);

if EnumError = NO_ERROR then

begin

ComputerEntries := MaxEntries;

EnumBufferLength := SizeOf(EnumComputerBuffer);

EnumError := WNetEnumResource(EnumComputerHandle, ComputerEntries,

@EnumComputerBuffer, EnumBufferLength);

if EnumError = NO_ERROR then

for J := 1 to ComputerEntries do

Computers.Add(Copy(EnumComputerBuffer[J].lpRemoteName,

3, Length(EnumComputerBuffer[J].lpRemoteName) — 2));

WNetCloseEnum(EnumComputerHandle);

end;

end;

end;

WNetCloseEnum(EnumWorkGroupHandle);

end;

if EnumError = ERROR_NO_MORE_ITEMS then

EnumError := NO_ERROR;

Result := EnumError;

end;

initialization

Computers := TStringList.Create;

finalization

Computers.Free;

end.

{/codecitation}

Отправляет сообщение по локальной сети (как команда Net Send)

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Num Lock

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Отправляет сообщение по локальной сети (как команда Net Send)

function NetSend(const sTo, sMessage: string): Boolean;

— Отправляет сообщение по локальной сети (делает тоже что и Net Send)

sTo — Кому (Имя пользователя, рабочей группы или компьютера).

Можно использовать ‘*’, чтобы отправить всем.

sMessage — Text сообщения.

Зависимости: Windows, ActiweX

Автор: Num Lock

Copyright: Num Lock

Дата: 13 марта 2003 г.

***************************************************** }

function NetSend(const sTo, sMessage: string): Boolean;

type

PNetMessageBufferSend = ^TNetMessageBufferSend;

TNetMessageBufferSend = function(

servername: PWideChar;

msgname: PWideChar;

fromname: PWideChar;

buf: PBYTE;

buflen: DWORD

): Integer; stdcall;

var

wMessage, wTo: PWideChar;

i, hLib: Integer;

NetMessageBufferSend: TNetMessageBufferSend;

begin

Result := False;

hLib := LoadLibrary(‘NetApi32.dll’);

if hlib > 0 then

try

@NetMessageBufferSend := GetProcAddress(hLib, ‘NetMessageBufferSend’);

if @NetMessageBufferSend nil then

begin

wMessage := CoTaskMemAlloc((Length(sMessage) 1) * sizeof(WideChar));

try

wTo := CoTaskMemAlloc((Length(sTo) 1) * sizeof(WideChar));

try

StringToWideChar(sMessage, wMessage, Length(sMessage) 1);

StringToWideChar(sTo, wTo, Length(sTo) 1);

i := NetMessageBufferSend(nil, wTo, nil, PBYTE(wMessage),

(Length(sMessage) 1) * sizeof(WideChar));

Result := i = ERROR_SUCCESS;

if not Result then

MessageBox(GetForegroundWindow, ‘Сообщение не отправлено.’, nil,

$1010);

finally

CoTaskMemFree(wTo);

end;

finally

CoTaskMemFree(wMessage);

end;

end

else

MessageBox(GetForegroundWindow,

‘Функция NetMessageBufferSend не обнаружена.’, nil, $1010);

finally

FreeLibrary(hLib);

end

else

MessageBox(GetForegroundWindow, ‘NetApi32.dll не загружена.’, nil, $1010);

end;

Пример использования:

procedure TForm1.NetSendBtnClick(Sender: PObj);

begin

if NetSend(combobox1.Text, Memo1.Text) then

begin

Memo1.Clear;

MessageBox(Form.Handle, ‘Отправка сообщения.’, ‘Сообщение отправлено’,

MB_ICONINFORMATION);

end;

end;

{/codecitation}

Определить доменное имя, в которое зашел пользователь

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

function GetDomainName: AnsiString;

type

WKSTA_INFO_100 = record

wki100_platform_id: Integer;

wki100_computername: PWideChar;

wki100_langroup: PWideChar;

wki100_ver_major: Integer;

wki100_ver_minor: Integer;

end;

WKSTA_USER_INFO_1 = record

wkui1_username: PChar;

wkui1_logon_domain: PChar;

wkui1_logon_server: PChar;

wkui1_oth_domains: PChar;

end;

type

//Win9X ANSI prototypes from RADMIN32.DLL and RLOCAL32.DLL

TWin95_NetUserGetInfo = function(ServerName, UserName: PChar; Level: DWORD; var

BfrPtr: Pointer): Integer;

stdcall;

TWin95_NetApiBufferFree = function(BufPtr: Pointer): Integer;

stdcall;

TWin95_NetWkstaUserGetInfo = function(Reserved: PChar; Level: Integer; var

BufPtr: Pointer): Integer;

stdcall;

//WinNT UNICODE equivalents from NETAPI32.DLL

TWinNT_NetWkstaGetInfo = function(ServerName: PWideChar; level: Integer; var

BufPtr: Pointer): Integer;

stdcall;

TWinNT_NetApiBufferFree = function(BufPtr: Pointer): Integer;

stdcall;

function IsWinNT: Boolean;

var

VersionInfo: TOSVersionInfo;

begin

VersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

Result := GetVersionEx(VersionInfo);

if Result then

Result := VersionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT;

end;

var

Win95_NetUserGetInfo: TWin95_NetUserGetInfo;

Win95_NetWkstaUserGetInfo: TWin95_NetWkstaUserGetInfo;

Win95_NetApiBufferFree: TWin95_NetApiBufferFree;

WinNT_NetWkstaGetInfo: TWinNT_NetWkstaGetInfo;

WinNT_NetApiBufferFree: TWinNT_NetApiBufferFree;

WSNT: ^WKSTA_INFO_100;

WS95: ^WKSTA_USER_INFO_1;

EC: DWORD;

hNETAPI: THandle;

begin

try

Result := »;

if IsWinNT then

begin

hNETAPI := LoadLibrary(‘NETAPI32.DLL’);

if hNETAPI 0 then

begin @WinNT_NetWkstaGetInfo := GetProcAddress(hNETAPI, ‘NetWkstaGetInfo’);

@WinNT_NetApiBufferFree := GetProcAddress(hNETAPI, ‘NetApiBufferFree’);

EC := WinNT_NetWkstaGetInfo(nil, 100, Pointer(WSNT));

if EC = 0 then

begin

Result := WideCharToString(WSNT^.wki100_langroup);

WinNT_NetApiBufferFree(Pointer(WSNT));

end;

end;

end

else

begin

hNETAPI := LoadLibrary(‘RADMIN32.DLL’);

if hNETAPI 0 then

begin @Win95_NetApiBufferFree := GetProcAddress(hNETAPI, ‘NetApiBufferFree’);

@Win95_NetUserGetInfo := GetProcAddress(hNETAPI, ‘NetUserGetInfoA’);

EC := Win95_NetWkstaUserGetInfo(nil, 1, Pointer(WS95));

if EC = 0 then

begin

Result := WS95^.wkui1_logon_domain;

Win95_NetApiBufferFree(Pointer(WS95));

end;

end;

end;

finally

if hNETAPI 0 then

FreeLibrary(hNETAPI);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(GetDomainName);

end;

{/codecitation}

Обзор сети (типа Network Neighborhood — Сетевое Окружение)

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Сеть — это дырки, связанные веревками.

В свое время я начал писать эту утилиту для своего развлечения, шутки ради. Она так и осталась незавершенной. Не знаю, хватит ли времени и желания дописать ее теперь. Но тем не менее вы можете использовать ее в качестве отправной точки для создания чего-то покруче. Я надеюсь, что приведеный здесь код поможет понять технологию поиска сетевых машин и мой труд не пропадет даром.

{

Сетевая утилита. Аналогична функции NetWork-

Neighborhood — Сетевое Окружение.

}

unit netres_main_unit;

interface

uses

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

Dialogs,

ComCtrls, StdCtrls, Buttons, Menus, ExtCtrls;

type

TfrmMain = class(TForm)

tvResources: TTreeView;

btnOK: TBitBtn;

btnClose: TBitBtn;

Label1: TLabel;

barBottom: TStatusBar;

popResources: TPopupMenu;

mniExpandAll: TMenuItem;

mniCollapseAll: TMenuItem;

mniSaveToFile: TMenuItem;

mniLoadFromFile: TMenuItem;

grpListType: TRadioGroup;

grpResourceType: TRadioGroup;

dlgOpen: TOpenDialog;

dlgSave: TSaveDialog;

procedure FormCreate(Sender: TObject);

procedure btnCloseClick(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure mniExpandAllClick(Sender: TObject);

procedure mniCollapseAllClick(Sender: TObject);

procedure mniSaveToFileClick(Sender: TObject);

procedure mniLoadFromFileClick(Sender: TObject);

procedure btnOKClick(Sender: TObject);

private

ListType, ResourceType: DWORD;

procedure ShowHint(Sender: TObject);

procedure DoEnumeration;

procedure DoEnumerationContainer(NetResContainer: TNetResource);

procedure AddContainer(NetRes: TNetResource);

procedure AddShare(TopContainerIndex: Integer; NetRes:

TNetResource);

procedure AddShareString(TopContainerIndex: Integer; ItemName:

string);

procedure AddConnection(NetRes: TNetResource);

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.ShowHint(Sender: TObject);

begin

barBottom.Panels.Items[0].Text := Application.Hint;

end;

procedure TfrmMain.FormCreate(Sender: TObject);

begin

Application.OnHint := ShowHint;

barBottom.Panels.Items[0].Text := »;

end;

procedure TfrmMain.btnCloseClick(Sender: TObject);

begin

Close;

end;

{

Перечисляем все сетевые ресурсы:

}

procedure TfrmMain.DoEnumeration;

var

NetRes: array[0..2] of TNetResource;

Loop: Integer;

r, hEnum, EntryCount, NetResLen: DWORD;

begin

case grpListType.ItemIndex of

{ Подключенные ресурсы: }

1: ListType := RESOURCE_CONNECTED;

{ Возобновляемые ресурсы: }

2: ListType := RESOURCE_REMEMBERED;

{ Глобальные: }

else

ListType := RESOURCE_GLOBALNET;

end;

case grpResourceType.ItemIndex of

{ Дисковые ресурсы: }

1: ResourceType := RESOURCETYPE_DISK;

{ Принтерные ресурсы: }

2: ResourceType := RESOURCETYPE_PRINT;

{ Все: }

else

ResourceType := RESOURCETYPE_ANY;

end;

Screen.Cursor := crHourGlass;

try

{ Удаляем любые старые элементы из дерева: }

for Loop := tvResources.Items.Count — 1 downto 0 do

tvResources.Items[Loop].Delete;

except

end;

{ Начинаем перечисление: }

r := WNetOpenEnum(ListType, ResourceType, 0, nil, hEnum);

if r NO_ERROR then

begin

if r = ERROR_EXTENDED_ERROR then

MessageDlg(‘Невозможно сделать обзор сети.’ #13

‘Произошла сетевая ошибка.’, mtError, [mbOK], 0)

else

MessageDlg(‘Невозможно сделать обзор сети.’,

mtError, [mbOK], 0);

Exit;

end;

try

{ Мы получили правильный дескриптор перечисления; опрашиваем ресурсы: }

while (1 = 1) do

begin

EntryCount := 1;

NetResLen := SizeOf(NetRes);

r := WNetEnumResource(hEnum, EntryCount, @NetRes, NetResLen);

case r of

0:

begin

{ Это контейнер, организуем итерацию: }

if NetRes[0].dwUsage = RESOURCEUSAGE_CONTAINER then

DoEnumerationContainer(NetRes[0])

else

{ Здесь получаем подключенные и возобновляемые ресурсы: } if ListType

in [RESOURCE_REMEMBERED, RESOURCE_CONNECTED] then

AddConnection(NetRes[0]);

end;

{ Получены все ресурсы: }

ERROR_NO_MORE_ITEMS: Break;

{ Другие ошибки: }

else

begin

MessageDlg(‘Ошибка опроса ресурсов.’, mtError, [mbOK], 0);

Break;

end;

end;

end;

finally

Screen.Cursor := crDefault;

{ Закрываем дескриптор перечисления: }

WNetCloseEnum(hEnum);

end;

end;

{

Перечисление заданного контейнера:

Данная функция обычно вызывается рекурсивно.

}

procedure TfrmMain.DoEnumerationContainer(NetResContainer:

TNetResource);

var

NetRes: array[0..10] of TNetResource;

TopContainerIndex: Integer;

r, hEnum, EntryCount, NetResLen: DWORD;

begin

{ Добавляем имя контейнера к найденным сетевым ресурсам: }

AddContainer(NetResContainer);

{ Делаем этот элемент текущим корневым уровнем: }

TopContainerIndex := tvResources.Items.Count — 1;

{ Начинаем перечисление: }

if ListType = RESOURCE_GLOBALNET then

{ Перечисляем глобальные объекты сети: }

r := WNetOpenEnum(ListType, ResourceType, RESOURCEUSAGE_CONTAINER,

@NetResContainer, hEnum)

else

{ Перечисляем подключаемые и возобновляемые ресурсы (другие получить здесь невозможно):

}

r := WNetOpenEnum(ListType, ResourceType, RESOURCEUSAGE_CONTAINER,

nil, hEnum);

{ Невозможно перечислить ресурсы данного контейнера;

выводим соответствующее предупреждение и едем дальше: }

if r NO_ERROR then

begin

AddShareString(TopContainerIndex, ‘<Не могу опросить ресурсы

(Ошибка #’

IntToStr(r) ‘>’);

WNetCloseEnum(hEnum);

Exit;

end;

{ Мы получили правильный дескриптор перечисления; опрашиваем ресурсы: }

while (1 = 1) do

begin

EntryCount := 1;

NetResLen := SizeOf(NetRes);

r := WNetEnumResource(hEnum, EntryCount, @NetRes, NetResLen);

case r of

0:

begin

{ Другой контейнер для перечисления;

необходим рекурсивный вызов: }

if (NetRes[0].dwUsage = RESOURCEUSAGE_CONTAINER) or

(NetRes[0].dwUsage = 10) then

DoEnumerationContainer(NetRes[0])

else

case NetRes[0].dwDisplayType of

{ Верхний уровень: }

RESOURCEDISPLAYTYPE_GENERIC,

RESOURCEDISPLAYTYPE_DOMAIN,

RESOURCEDISPLAYTYPE_SERVER: AddContainer(NetRes[0]);

{ Ресурсы общего доступа: }

RESOURCEDISPLAYTYPE_SHARE:

AddShare(TopContainerIndex, NetRes[0]);

end;

end;

ERROR_NO_MORE_ITEMS: Break;

else

begin

MessageDlg(‘Ошибка #’ IntToStr(r) ‘ при перечислении

ресурсов.’,mtError,[mbOK],0);

Break;

end;

end;

end;

{ Закрываем дескриптор перечисления: }

WNetCloseEnum(hEnum);

end;

procedure TfrmMain.FormShow(Sender: TObject);

begin

DoEnumeration;

end;

{

Добавляем элементы дерева; помечаем, что это контейнер:

}

procedure TfrmMain.AddContainer(NetRes: TNetResource);

var

ItemName: string;

begin

ItemName := Trim(string(NetRes.lpRemoteName));

if Trim(string(NetRes.lpComment)) » then

begin

if ItemName » then

ItemName := ItemName ‘ ‘;

ItemName := ItemName ‘(‘ string(NetRes.lpComment) ‘)’;

end;

tvResources.Items.Add(tvResources.Selected, ItemName);

end;

{

Добавляем дочерние элементы к контейнеру, обозначенному как текущий верхний уровень:

}

procedure TfrmMain.AddShare(TopContainerIndex: Integer; NetRes:

TNetResource);

var

ItemName: string;

begin

ItemName := Trim(string(NetRes.lpRemoteName));

if Trim(string(NetRes.lpComment)) » then

begin

if ItemName » then

ItemName := ItemName ‘ ‘;

ItemName := ItemName ‘(‘ string(NetRes.lpComment) ‘)’;

end;

tvResources.Items.AddChild(tvResources.Items[TopContainerIndex], ItemName);

end;

{

Добавляем дочерние элементы к контейнеру, обозначенному как текущий верхний уровень;

это просто добавляет строку для таких задач, как, например,

перечисление контейнера. То есть некоторые контейнерные

ресурсы общего доступа нам не доступны.

}

procedure TfrmMain.AddShareString(TopContainerIndex: Integer;

ItemName: string);

begin

tvResources.Items.AddChild(tvResources.Items[TopContainerIndex], ItemName);

end;

{

Добавляем соединения к дереву.

По большому счету к этому моменту все сетевые ресурсы типа

возобновляемых и текущих соединений уже отображены.

}

procedure TfrmMain.AddConnection(NetRes: TNetResource);

var

ItemName: string;

begin

ItemName := Trim(string(NetRes.lpLocalName));

if Trim(string(NetRes.lpRemoteName)) » then

begin

if ItemName » then

ItemName := ItemName ‘ ‘;

ItemName := ItemName ‘-> ‘ Trim(string(NetRes.lpRemoteName));

end;

tvResources.Items.Add(tvResources.Selected, ItemName);

end;

{

Раскрываем все контейнеры дерева:

}

procedure TfrmMain.mniExpandAllClick(Sender: TObject);

begin

tvResources.FullExpand;

end;

{

Схлопываем все контейнеры дерева:

}

procedure TfrmMain.mniCollapseAllClick(Sender: TObject);

begin

tvResources.FullCollapse;

end;

{

Записываем дерево в выбранном файле:

}

procedure TfrmMain.mniSaveToFileClick(Sender: TObject);

begin

if dlgSave.Execute then

tvResources.SaveToFile(dlgSave.FileName);

end;

{

Загружаем дерево из выбранного файла:

}

procedure TfrmMain.mniLoadFromFileClick(Sender: TObject);

begin

if dlgOpen.Execute then

tvResources.LoadFromFile(dlgOpen.FileName);

end;

{

Обновляем:

}

procedure TfrmMain.btnOKClick(Sender: TObject);

begin

DoEnumeration;

end;

end.

{/codecitation}

Как узнать, подключен ли компьютер к сети

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

procedure TForm1.Button1Click(Sender: TObject);

begin

if GetSystemMetrics(SM_NETWORK) and $01 = $01 then

ShowMessage(‘Computer is attached to a network!’)

else

ShowMessage(‘Computer is not attached to a network!’);

end;

{/codecitation}

Как узнать имя домена Windows NT или 2000

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: http://www.sources.ru

function GetNTDomainName: string;

var

hReg: TRegistry;

begin

hReg := TRegistry.Create;

hReg.RootKey := HKEY_LOCAL_MACHINE;

hReg.OpenKey(‘SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon’, false);

Result := hReg.ReadString(‘DefaultDomainName’);

hReg.CloseKey;

hReg.Destroy;

end;

{/codecitation}

Как узнать доступные сетевые pесуpсы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Nomadic

Любовь в интернете: С тобой мечтаю поболтать до боли в пальцах…

type

PNetResourceArray = ^TNetResourceArray;

TNetResourceArray =

array [0..MaxInt div SizeOf(TNetResource) — 1] of TNetResource;

procedure EnumResources(LpNR:PNetResource);

var

NetHandle: THandle;

BufSize: Integer;

Size: Integer;

NetResources: PNetResourceArray;

Count: Integer;

NetResult: Integer;

I: Integer;

NewItem: TListItem;

begin

if WNetOpenEnum(

RESOURCE_GLOBALNET,

RESOURCETYPE_ANY,

// RESOURCETYPE_ANY — все ресурсы

// RESOURCETYPE_DISK — диски

// RESOURCETYPE_PRINT — принтеры

0, LpNR, NetHandle) NO_ERROR then

Exit;

try

BufSize := 50 * SizeOf(TNetResource);

GetMem(NetResources, BufSize);

try

while True do

begin

Count := -1;

Size := BufSize;

NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);

if NetResult = ERROR_MORE_DATA then

begin

BufSize := Size;

ReallocMem(NetResources, BufSize);

Continue;

end;

if NetResult NO_ERROR then

Exit;

for I := 0 to Count-1 do

begin

with NetResources^[I] do

begin

if RESOURCEUSAGE_CONTAINER = (DwUsage and RESOURCEUSAGE_CONTAINER) then

EnumResources(@NetResources^[I]);

if dwDisplayType = RESOURCEDISPLAYTYPE_SHARE then

// ^^^^^^^^^^^^^^^^^^^^^^^^^ — ресурс

// RESOURCEDISPLAYTYPE_SERVER — компьютер

// RESOURCEDISPLAYTYPE_DOMAIN — рабочая группа

// RESOURCEDISPLAYTYPE_GENERIC — сеть

begin

NewItem:= Form1.ListView1.Items.Add;

NewItem.Caption:=LpRemoteName;

end;

end;

end

end;

finally

FreeMem(NetResources, BufSize);

end;

finally

WNetCloseEnum(NetHandle);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

OldCursor: TCursor;

begin

OldCursor:= Screen.Cursor;

Screen.Cursor:= crHourGlass;

with ListView1.Items do

begin

BeginUpdate;

Clear;

EnumResource(nil);

EndUpdate;

end;

Screen.Cursor:= OldCursor;

end;

Автор: Михаил Немцов

обнаружил и исправил некоторые ошибки. Его код публикуется ниже:

type

PNetResourceArray = ^TNetResourceArray;

TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) — 1] of TNetResource;

Procedure EnumResources(LpNR:PNetResource);

Var

NetHandle: DWORD;

BufSize: DWORD;

Size:DWORD;

NetResources: PNetResourceArray;

Count: DWORD;

NetResult:Integer;

I: Integer;

NewItem:TListItem;

Begin

If WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,0,LpNR,NetHandle) NO_ERROR

then Exit;

Try

BufSize := 50 * SizeOf(TNetResource);

GetMem(NetResources, BufSize);

Try

while True do

begin

Count := 1;

Size := BufSize;

NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);

If NetResult = ERROR_MORE_DATA then

begin

BufSize := Size;

ReallocMem(NetResources, BufSize);

Continue;

end;

if NetResult NO_ERROR then Exit;

For I := 0 to Count-1 do

Begin

With NetResources^[I] do

Begin

If RESOURCEUSAGE_CONTAINER =(DwUsage and RESOURCEUSAGE_CONTAINER) then

EnumResources(@NetResources^[I]);

If dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then

// ^^^^^^^^^^^^^^^^^^^^^^^^^ — ресурс

// RESOURCEDISPLAYTYPE_SERVER — компьютер

// RESOURCEDISPLAYTYPE_DOMAIN — рабочая группа

// RESOURCEDISPLAYTYPE_GENERIC — сеть

Begin

NewItem:= Form1.ListView1.Items.Add;

NewItem.Caption:=LpRemoteName;

End;

End;

End;

End;

finally

FreeMem(NetResources, BufSize);

end;

finally

WNetCloseEnum(NetHandle);

end;

End;

procedure TForm1.Button1Click(Sender: TObject);

Var

OldCursor: TCursor;

begin

OldCursor:= Screen.Cursor;

Screen.Cursor:= crHourGlass;

With ListView1.Items do

Begin

BeginUpdate;

Clear;

EnumResources(nil);

EndUpdate;

End;

Screen.Cursor:= OldCursor;

end;

end.

{/codecitation}