Вопрос по статье "Мониторинг сетей в Delphi"

← →
MeMO (2004-08-06 00:46) [0]

Hi all.
У меня вопрос по выше указанной статье.
Там в примере расписано определение шар для локального компа.
Хочется узнать как это все делается для удаленного.
Я пытался написать, только работает через раз :)
Заранее спасибо.

← →
Vit@ly © (2004-08-06 08:15) [1]

Попробуй так:
Var NetResources: array[0..200]of TNetResource; ResourceCount: integer; .... implementation {$R *.DFM} function enumResourcesIn(Workgroup: string): boolean; var EnumHandle: THandle; WorkgroupRS: TNetResource; BufSize: Cardinal; Entries: Cardinal; Rest: Cardinal; begin ResourceCount:=0; Workgroup:=Workgroup+#0; FillChar(WorkgroupRS, SizeOf(WorkgroupRS), 0); with WorkgroupRS do begin dwScope:=RESOURCE_GLOBALNET; dwType:=RESOURCETYPE_ANY; dwDisplayType:=RESOURCEDISPLAYTYPE_DOMAIN; dwUsage:=RESOURCEUSAGE_CONTAINER; lpRemoteName:=@Workgroup[1]; end; WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @WorkgroupRS, EnumHandle); Entries:=200; BufSize:=SizeOf(NetResources); Rest:=WNetEnumResource(EnumHandle, Entries, @NetResources[0], BufSize); if (Rest=NO_ERROR) and (Entries>0) then Result:=true else Result:=false; ResourceCount:=Entries; WNetCloseEnum(EnumHandle); end; procedure TForm1.Button1Click(Sender: TObject); begin if enumResourcesIn("xxx.xxx.xxx.xxx") then //IP удаленного компа for i:=1 to ResourceCount do begin Tree.Items.AddChildFirst(nil, NetResources[i].lpRemoteName); Application.ProcessMessages; end; end;

← →
Rouse_ © (2004-08-06 09:30) [2]

Для удаленного нужно использовать немного другую структуру.

PShareInfo1 = ^TShareInfo1;
{$EXTERNALSYM _SHARE_INFO_1}
_SHARE_INFO_1 = record
shi1_netname: LPTSTR;
shi1_type: DWORD;
shi1_remark: LPTSTR;
end;
TShareInfo1 = _SHARE_INFO_1;
{$EXTERNALSYM SHARE_INFO_1}
SHARE_INFO_1 = _SHARE_INFO_1;

а по поводу сканирования через WNetEnumResource, то тут http://www.delphimaster.ru/cgi-bin/forum.pl?n=4 более полный пример

← →
MeMO (2004-08-29 17:06) [3]

За структуру спасибо только вот в массив куда шары заносятся всякая лобуда пишется. Что делать. Вот фрагмент на нахождение шар, что неправильно:

lbxShares.Items.Clear;
if ((CompList.SelCount>0)and(CompList.Selected.ImageIndex=0))or(Manual)then begin
GetMem(Host,SizeOf(WideChar)*256);
if Manual then begin
ZeroMemory(Host,sizeof(WideChar)*256);
StringToWideChar(TempStr,Host,Length(TempStr)+1);
end else begin
if CompList.Selected.Caption = LocIP then begin
GetMem(HostPCH,256);
GetHostName(HostPCH,256);
TempStr:="";
ZeroMemory(Host,sizeof(WideChar)*256);
TempStr:="\\"+strpas(HostPCH);
StringToWideChar(TempStr,Host,Length(TempStr)+1);
FreeMem(HostPch);
end else begin
DestAddress.s_addr:=Inet_Addr(PChar(CompList.Selected.Caption));
Hosten:=GetHostByAddr(@DestAddress.s_addr,Length(CompList.Selected.Caption),AF_INET);
TempStr:="";
ZeroMemory(Host,sizeof(WideChar)*256);
TempStr:="\\"+strpas(Hosten.h_name);
StringToWideChar(TempStr,Host,Length(TempStr)+1);
end;
end;
FLibHandle := LoadLibrary("NETAPI32.DLL"); //Загружаем библиотеку
if FLibHandle = 0 then Exit;
//Связываем функцию
@NetShareEnumNT := GetProcAddress(FLibHandle,"NetShareEnum");
if not Assigned(NetShareEnumNT) then //Проверка
begin
FreeLibrary(FLibHandle);
Exit;
end;
ShareNT1:=nil; //Очищаем указатель на массив структур
//Вызов функции
if NetShareEnumNT(Host,1,@ShareNT1,Word(-1),@EntriesRead,@TotalEntries,Nil) <> 0 then
begin //Если вызов неудачен выгружаем библиотеку
FreeLibrary(FLibHandle);
MessageDlg("Shares getting error", mtError, [mbOk],0);
Exit;
end;
if entriesread > 0 then //Обработка результатов
for i:=0 to Entriesread-1 do
lbxShares.Items.Add(StrPas(ShareNT1^[i].shi1_netname));
FreeLibrary(FLibHandle); //Не забываем выгрузить библиотеку
end;

или скажите мыльник я всю прогу вышлю чтоб легче было разобраться где у меня ошибка. Заранее спасибо.

← →
Дмитрий Ботвин (2004-08-30 09:16) [4]

Я по этой статье делал так:

//определил структуру
type
TShareInfo2 = packed record
shi2_netname : PWChar;
shi2_type: DWORD;
shi2_remark :PWChar;
shi2_permissions: DWORD;
shi2_max_uses : DWORD;
shi2_current_uses : DWORD;
shi2_path : PWChar;
shi2_passwd : PWChar;
end;
PShareInfo2 = ^ TShareInfo2;
TShareInfo2Array = array [0..512] of TShareInfo2;
PShareInfo2Array = ^ TShareInfo2Array;

//Вызов процедуры
procedure TForm8.btnGetSharesClick(Sender: TObject);
var
i:Integer;
HostName: WideString;
FLibHandle : THandle;
ShareNT : PShareInfo2Array;
entriesread,totalentries:DWORD;
begin
lbxShares.Items.Clear;
FLibHandle := LoadLibrary("NETAPI32.DLL"); //Загружаем библиотеку
if FLibHandle = 0 then Exit;
//Связываем функцию
@NetShareEnumNT := GetProcAddress(FLibHandle,"NetShareEnum");
if not Assigned(NetShareEnumNT) then //Проверка
begin
FreeLibrary(FLibHandle);
Exit;
end;
ShareNT := nil; //Очищаем указатель на массив структур
//Вызов функции
HostName:=WideString(Trim(Form1.CompName.Text));
if NetShareEnumNT(PWideChar(HostName),2,@ShareNT,DWORD(-1),@entriesread,@totalentries,nil) <> 0 then
begin //Если вызов неудачен выгружаем библиотеку
FreeLibrary(FLibHandle);
Exit;
end;
if entriesread>0 then //Обработка результатов
for i:= 0 to entriesread-1 do lbxShares.Items.Add(String(ShareNT^[i].shi2_netname));
FreeLibrary(FLibHandle); //Не забываем выгрузить библиотеку
end;

А вообще, помоему, Rouse_ там всё подробно расписал, за чё ему
большое человеческое спасибо :-))))

← →
Rouse_ © (2004-08-30 09:23) [5]

Вот более правильный пример (в статье были немного не верно некоторые моменты описаны из-за чего получался на выходе Memory Leack):

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) ListBox1: TListBox; Button1: TButton; Edit1: TEdit; procedure Button1Click(Sender: TObject); end; LMSTR = LPWSTR; NET_API_STATUS = DWORD; LPSHARE_INFO_1 = ^SHARE_INFO_1; {$EXTERNALSYM LPSHARE_INFO_1} PSHARE_INFO_1 = ^SHARE_INFO_1; {$EXTERNALSYM PSHARE_INFO_1} _SHARE_INFO_1 = record shi1_netname: LMSTR; shi1_type: DWORD; shi1_remark: LMSTR; end; {$EXTERNALSYM _SHARE_INFO_1} SHARE_INFO_1 = _SHARE_INFO_1; {$EXTERNALSYM SHARE_INFO_1} TShareInfo1 = SHARE_INFO_1; PShareInfo1 = PSHARE_INFO_1; function NetShareEnum(servername: LMSTR; level: DWORD; var bufptr: Pointer; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): NET_API_STATUS; stdcall; external "Netapi32.dll"; function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; external "Netapi32.dll"; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); type TShareInfo1Array = array of TShareInfo1; var entriesread, totalentries: DWORD; Info: Pointer; I: Integer; CompName: PWideChar; begin CompName := StringToOleStr(Edit1.Text); // Здесь имя компъютера к примеру \\SERVER1 if NetShareEnum(CompName, 1, Info, DWORD(-1), @entriesread, @totalentries, nil) = 0 then try if entriesread > 0 then for I := 0 to entriesread - 1 do ListBox1.Items.Add(TShareInfo1Array(@(Info^))[I].shi1_netname); finally NetApiBufferFree(Info); end; end; end.

← →
Rouse_ © (2004-08-30 09:24) [6]

PS:
> А вообще, помоему, Rouse_ там всё подробно расписал, за
> чё ему
> большое человеческое спасибо :-))))

Приятно слышать :)

← →
Дмитрий Ботвин (2004-08-30 09:39) [7]

Кстати, Rouse_ а в остальных функциях для работы с сетевыми
ресурсами в той статье тоже необходима NetApiBufferFree???

← →
Rouse_ © (2004-08-30 10:27) [8]

Да, именно из-за нее и был Memory Leack.
Думаю не составит труда переписать остальные функции по образу и подобию данного мной примера...

← →
Rouse_ © (2004-08-30 10:31) [9]

Хотя, сейчас идет работа над второй частью статьи (наконец-то:) и я собираюсь также поправить и первую часть (как на Королевстве Дельфи примерно, выйдет исправленный вариант) и там все распишу как правильно делать :)

← →
Дмитрий Ботвин (2004-08-30 11:42) [10]

А у меня лишь на некоторых компах с WinNT 4.0 тока ошибку
выдовал, но я её устранил убрав флажок Range Checking в настройках компилятора. После чего всё заработало на любых
компах. Я подумал, что это глюк тех компов :-))))

P.S. Щас попробую на тех компах исправленный вариант....

← →
Дмитрий Ботвин (2004-08-30 14:40) [11]

Rouse_ а когда ты хош 2-ю часть опубликовать? И о чём там
будет идти речь???

← →
Rouse_ © (2004-08-30 15:18) [12]

> [11] Дмитрий Ботвин (30.08.04 14:40)
Сканер сети, оспределенние параметров удаленной машины таких как ОС, время, ресурсы, пользователи, группы, текущие процессы... и т.д. и т.п.

Как закончу, если все нормально то недельки через 2 - 3...

← →
Piter © (2004-08-30 15:39) [13]

Rouse_ © (30.08.04 10:27) [8]
Думаю не составит труда переписать остальные функции по образу и подобию данного мной примера

а чего, поправить статью совсем никак? Это же пять минут, чем в конференции каждый раз объяснятся... да и вообще некорретный ответ в форуме это ладно. А вот некорректный пример в статье гораздо хуже...

← →
Дмитрий Ботвин (2004-08-30 15:57) [14]

Rouse_ я тоже когда то написал полнофункцианальный сетевой администратор. Единственное чего не смог определить для сетевого
компа - объём оперативки на нём. Ты часом не в курсе это
вообще реально сделать???

← →
Rouse_ © (2004-08-30 16:47) [15]

> Piter © (30.08.04 15:39)
Я же сказал что одновременно и в статье поправлю :)

> [14] Дмитрий Ботвин (30.08.04 15:57)
не уверен что такое вообще возможно :)

← →
Дмитрий Ботвин (2004-08-30 16:58) [16]

Ну ты даёшь, ты меня последней надежды лишил :-((((
Нельзя же так сразу :-))))
Я, в принципе, так и предполагал, ну думал может чё не знаю.
Ну ладно, всё равно спасибо :-))))

← →
MeMO (2004-08-31 11:55) [17]

С нахождением шар все получидось, спасибо. Только вот теперь появилась проблема с их подключением. Куда писать путь к шаре?
Постоянно фу-я выдает ошибку 123. Вот фрагмент где я пытаюсь подключить шару что не так. Помогите. Заранее спасибо.

procedure TMainForm.lbxSharesDblClick(Sender: TObject); const STYPE_DISKTREE = 0; ACCESS_ALL = 258; var ShareNTItem : TShareInfo1; TmpDir:lmstr; TmpName: String; TmpDirNT, TmpNameNT: PWideChar; TmpLength: Integer; begin TmpDir:=TShareInfo1Array(@Info^)[lbxShares.ItemIndex].shi1_netname; TmpName:=InputBox("Share name","Enter name",""); //Îïðåäåëÿåì èìÿ ïîä êîòîðûì îí áóäåò âèäåí â ñåòè if TmpName="" then Exit; if TmpDir="" then Exit; FLibHandle:=LoadLibrary("NETAPI32.DLL"); if FLibHandle=0 then Exit; @NetShareAdd:=GetProcAddress(FLibHandle,"NetShareAdd"); if not Assigned(NetShareAdd) then begin FreeLibrary(FLibHandle); Exit; end; TmpLength:=SizeOF(WideChar)*256; //Îïðåäåëÿåì íåîáõîäèìûé ðàçìåð GetMem(TmpNameNT,sizeof(WideChar)*256); //Êîíâåðòèðóåì â PWChar StringToWideChar(TmpName, TmpNameNT,sizeof(WideChar)*256); ShareNTItem.shi1_netname := TmpNameNT; //Èìÿ ShareNTItem.shi1_type := STYPE_DISKTREE; //Òèï ðåñóðñà ShareNTItem.shi1_remark := ""; //Êîììåíòàðèé //ShareNTItem.shi1_permissions := ACCESS_ALL; //Äîñòóï //ShareNTItem.shi1_max_uses := DWORD(-1); //Êîë-âî ìàêñèì. ïîäêëþ÷. //ShareNTItem.shi1_current_uses := 0; //Êîë-âî òåê ïîäêë.} //GetMem(TmpDirNT, TmpLength); //StringToWideChar(TmpDir, TmpDirNT, TmpLength); //ShareNTItem.shi1_path := TmpDirNT; //Ïóòü ê ðåñóðñó //ShareNTItem.shi1_passwd := nil; //Ïàðîëü Error:=NetShareAdd(Host,2,@ShareNTItem,nil); //Äîáàâëÿåì ðåñóðñ if Error<>0 then MessageDlg("Share add error"+Inttostr(Error),mtError,[mbOK],0); FreeMem (TmpNameNT); //îñâîáîæäàåì ïàìÿòü //FreeMem (TmpDirNT); FreeLibrary(FLibHandle); CompList.OnDblClick(self); end;

← →
Дмитрий Ботвин (2004-09-01 10:25) [18]

Вот тебе работающий код:

procedure TForm8.btnAddSharesClick(Sender: TObject);
type
TShareInfo2 = record
shi2_netname : PWChar;
shi2_type: DWORD;
shi2_remark :PWChar;
shi2_permissions: DWORD;
shi2_max_uses : DWORD;
shi2_current_uses : DWORD;
shi2_path : PWChar;
shi2_passwd : PWChar;
end;
const
STYPE_DISKTREE = 0;
ACCESS_ALL = 258;
SHI50F_FULL = 258;
var
ShareNT : TShareInfo2;
TmpDir, TmpName, Path: String;
HostName, TmpDirNT, TmpNameNT: PWChar;
begin
TmpDir := InputBox("Локальный путь к ресурсу","Введите путь в формате: <Диск>:\<Путь>",""); //Определяем путь к будующему ресурсу
if TmpDir = "" then Exit;
TmpName := InputBox("Сетевое имя","Введите имя",""); //Определяем имя под которым он будет виден в сети
if TmpName = "" then Exit;
//преобразуем локальный путь к сетевому
Path:=TmpDir;
Path[2]:="$";
Path:="\\"+Trim(Form1.CompName.Text)+"\"+Path;
//Проверяем есть ли такая папка если нет, то создаём её
if not(DirectoryExists(Path)) then
begin
MkDir(Path);
if IOResult<>0 then
begin
Application.MessageBox("Не могу создать указанный ресурс!","Создание ресурса",
MB_OK+MB_ICONSTOP);
exit;
end;
end;
HostName := StringToOleStr("\\"+Trim(Form1.CompName.Text));
TmpNameNT := StringToOleStr(TmpName);
TmpDirNT := StringToOleStr(TmpDir);
//Заполняем структуру
ShareNT.shi2_netname := TmpNameNT; //Имя
ShareNT.shi2_type := STYPE_DISKTREE; //Тип ресурса
ShareNT.shi2_remark := ""; //Комментарий
ShareNT.shi2_permissions := ACCESS_ALL; //Доступ
ShareNT.shi2_max_uses := DWORD(-1); //Кол-во максим. подключ.
ShareNT.shi2_current_uses := 0; //Кол-во тек подкл.
ShareNT.shi2_path := TmpDirNT; //Путь к ресурсу
ShareNT.shi2_passwd := ""; //Пароль
try
if NetShareAdd(PWideChar(HostName), 2, @ShareNT, nil)=0 then btnGetSharesClick(Sender);
finally
NetApiBufferFree(@ShareNT);
end;
end;

← →
MeMO (2004-09-03 11:42) [19]

Спасибо конечно но это не совсем то что мне надо. Я пытаюсь выкалупать имя шары из той структуры которую заполнила NetShareEnum.

← →
Rouse_ © (2004-09-03 12:22) [20]

> [19] MeMO (03.09.04 11:42)
ну так пример же даден как правильно "выколупывать" ;)

см. > [5] Rouse_ © (30.08.04 09:23)

← →
MeMO (2004-09-04 16:57) [21]

Rouse_ © (03.09.04 12:22) [20]
не спорю пример правильный, но там ведь нахождение шар. А вот "выколупывать" мне имя надо для NetShareAdd. Так вот в Дмитрий Ботвин (01.09.04 10:25) [18] это все пальцами делать надо т.е. вводить сетевое имя и т.д.

Ну так а в чем проблема?
NetShareEnum тебе вернула именя ресурсов некоего сетевого компьютера имя которого тебе заранее известно, полное имя строишь так \\имя компьютера\имя ресурса

Или про разные вещи говорим?

← →
MeMO (2004-09-05 12:12) [23]

to Rouse_ ©
я еще из статьи понял как это делается (за неё отдельное спасибо), только в предложенном примере ([18]) данные полученные NetShareEnum не используются, а вписываются в ручную.

Ну тогда имя ресурса (под которым он будет виден в сети) бери от имени папки к которой будет открыт доступ

← →
Дмитрий Ботвин (2004-09-05 15:10) [25]

Если тебе ваще всё лень самому писать тогда запускай комманду:
shrpubw.exe /s <имя компа>, например shrpubw.exe /s server
И за тебя виндус всё сделает :-))))

> [25] Дмитрий Ботвин (05.09.04 15:10)
Класс, даже не знал что такая утилита есть :)))

← →
MeMO (2004-09-05 22:22) [27]

А при чем тут статья? В ней не будет этот вопрос рассмотрен...
ЗЫ: Если чесно то я просто не понял какое именно имя ты не можешь найти? Которое в shi1_netname подставляется? Если да, то его туда пожно любое писать, хоть рандомом последовательсость букв сгенерировать...

← →
MeMO (2004-09-06 11:03) [29]

Да имя я уже получается вытянуть из структуры. Просто в примере [5] в конце делается NetApiBufferFree(Info), а я не досмотрел и пытался обратится к Info. Только вот теперь NetShareAdd возвращает постоянно 123 ошибку.
TmpDir:=TShareInfo1Array(@Info^)[lbxShares.ItemIndex].shi1_netname; TmpName:=InputBox("Share name","Enter name",""); if TmpName="" then Exit; if TmpDir="" then Exit; FLibHandle:=LoadLibrary("NETAPI32.DLL"); if FLibHandle=0 then Exit; @NetShareAdd:=GetProcAddress(FLibHandle,"NetShareAdd"); if not Assigned(NetShareAdd) then begin MessageDlg("Error in call to Loadlibrary()"+#10+#13+"Error "+IntToStr(Error),mtError,[mbok],0); FreeLibrary(FLibHandle); Exit; end; ShareNTItem.shi2_netname:=StringToOleStr(TmpName); ShareNTItem.shi2_type := STYPE_DISKTREE; ShareNTItem.shi2_remark := ""; ShareNTItem.shi2_permissions := ACCESS_ALL; ShareNTItem.shi2_max_uses := DWORD(-1); ShareNTItem.shi2_current_uses := 0; ShareNTItem.shi2_path:=StringToOleStr(TmpDir); ShareNTItem.shi2_passwd :=nil; Error:=NetShareAdd(Host,2,@ShareNTItem,nil); if Error<>0 then MessageDlg("Error in call to NetShareAdd()"+#10+#13+"Error "+Inttostr(Error),mtError,[mbOK],0); FreeLibrary(FLibHandle); CompList.OnDblClick(self);
Последний параметр NetShareAdd указывает на ошибку в 8 поле стуктуры. Подскажите может я опять гдето протупил. Спасибо.

Вопрос по статье "Мониторинг сетей в Delphi" Найти похожие ветки