Текущий архив: 2004.07.18;
Скачать: CL | DM;

Вниз

NetShareEnum   Найти похожие ветки 

← →
sirin_   (2004-04-18 17:11) [0]

Доброго времери суток. У меня возникла такая проблема: необходимо програмно получить список расшаренных ресурсов, имея список сетевых машин. перелопатив хелпы и порывшись в инете сделал - (код внизу)
если передаю в качестве servername - nil, работает нормально, показывает локальные ресурсы, если передаю "\\hostname" -  загибается :(

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
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;

type
 TForm1 = class(TForm)
   Button1: TButton;
   list: TListBox;
   Edit1: TEdit;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 NetShareEnum :function (ServerName :PChar;
                            Level  :DWORD;
                            Bufptr  :Pointer;
                            Prefmaxlen :DWORD;
                            EntriesRead,
                            TotalEntries,
                            resume_handle:LPDWORD): DWORD; stdcall;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 i, result:Integer;
 FLibHandle : THandle;
 ShareNT : PShareInfo2Array;  //<= Перемеменные
 entriesread,totalentries:DWORD;  //<= для Windows NT

begin
   list.Items.Clear;
   FLibHandle := LoadLibrary("NETAPI32.DLL"); //Загружаем библиотеку
   if FLibHandle = 0 then Exit;
   //Связываем функцию
   @NetShareEnum := GetProcAddress(FLibHandle,"NetShareEnum");
   if not Assigned(NetShareEnum) then //Проверка
   begin
     FreeLibrary(FLibHandle);
     Exit;
   end;
   ShareNT := nil; //Очищаем указатель на массив структур
   //Вызов функции
   result := NetShareEnum(PChar(edit1.Text),2,@ShareNT,DWORD(-1),
            @entriesread,@totalentries,nil);
   if result <> 0 then
   begin //Если вызов неудачен выгружаем библиотеку
     FreeLibrary(FLibHandle);
     Exit;
   end;
   if entriesread > 0 then
   begin//Обработка результатов
   for i:= 0 to entriesread - 1 do
           list.Items.Add(String(ShareNT^[i].shi2_netname));

 end;

 FreeLibrary(FLibHandle); //Не забываем выгрузить библиотеку
end;

end.

---

← →
Vit@ly ©   (2004-04-18 20:41) [1]

Пару дней назад снял по-моему даже на этом форуме. Претензий к работе нет. Попробуй поюзать

uses
Windows;

var
NetResources: array[0..200]of TNetResource;
ResourceCount: integer;

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 TMainForm.Button2Click(Sender: TObject);
var
i: integer;
begin
if enumResourcesIn("\\RemouteComputerName") then
 for i:=1 to ResourceCount do Tree.Items.AddChildFirst(nil, NetResources[i].lpRemoteName)
end;

---

← →
Vit@ly ©   (2004-04-18 20:49) [2]

Извиняюсь перед автором предложенного варианта.
Взято здесь:
http://forum.sources.ru/index.php?showtopic=50610

---

← →
sirin_   (2004-04-18 21:51) [3]

работает нормально, но не показывает скрытые шари :(

---

← →
Rouse_ ©   (2004-04-18 22:04) [4]

Конечно не будет показывать - структура запроса не та :)
Используйте первую :)

---

← →
Rouse_ ©   (2004-04-18 22:07) [5]

Извините - не правильно выразился, имелось в виду в качестве структуры передавать вот это:
typedef struct _SHARE_INFO_1 {
 LPWSTR    shi1_netname;
 DWORD     shi1_type;
 LPWSTR    shi1_remark;
} SHARE_INFO_1, *PSHARE_INFO_1, *LPSHARE_INFO_1;

---

← →
Piter ©   (2004-04-19 10:25) [6]

Rouse_ (18.04.04 22:07) [5]

да отправляй всех к http://www.delphimaster.ru/articles/netmon/index.html

правда, непонятно, почему ты использовал NetShareEnum, ведь

"he NetShareEnum function is obsolete. It is provided only for compatibility with LAN Manager and 16-bit versions of Windows. Win32-based applications should use the WNetEnumResource function"

---

← →
Piter ©   (2004-04-20 19:55) [7]

Rouse?

---

← →
Verg ©   (2004-04-20 20:02) [8]

Хм.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/netmgmt/netmgmt/netshareenum.asp

Где там про "obsolete" ?

---

← →
Rouse_ ©   (2004-04-20 20:04) [9]

Ээээ...

Изначально стал разбирать именно эти функции, именно из-за > It is provided only for compatibility по совету старших товарищей.
Думаю, переделать на WNet не составит труда у любого кто достаточно серьезно озаботился данной сферой сети...

Ну а переписывать статью - я на ММР последнем говорил, "Чукча читатель, чукча не писатель" :) В смысле для меня очень сложно дается написание материала. Часто могу залипнуть над одним предложением и переписывать его по 100 раз заново :(
Поэтому пока все и стоит на месте :)

---

← →
Piter ©   (2004-04-20 22:52) [10]

Verg (20.04.04 20:02) [8]
Где там про "obsolete" ?

я из SDK дельфового цитировал

---

← →
Piter ©   (2004-04-20 22:54) [11]

Rouse_ (20.04.04 20:04) [9]
Ну а переписывать статью - я на ММР последнем говорил, "Чукча читатель, чукча не писатель"

а мне в общем нравится писать. Только знаний маловато для этого :(

---

← →
Verg ©   (2004-04-21 06:43) [12]

Есть вариант и с WNetEnumResource:
unit SerRec;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
 Buttons, ExtCtrls, ComCtrls, ImgList;

type
 TNetDialog = class(TForm)
   OKBtn: TButton;
   CancelBtn: TButton;
   Label1: TLabel;
   Prompt: TLabel;
   RecEdit: TEdit;
   TreeView1: TTreeView;
   ImageList1: TImageList;
   RefeshBtn: TSpeedButton;
   procedure TreeView1Deletion(Sender: TObject; Node: TTreeNode);
   procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
     var AllowExpansion: Boolean);
   procedure TreeView1DblClick(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   procedure RefeshBtnClick(Sender: TObject);
 private
   { Private declarations }
   function GetContainer:integer;
   procedure AddEnums(T : TTreeNode);
 public
   { Public declarations }
 end;

var
 NetDialog: TNetDialog;

 function SelectNetResource(const Caption:string; var Res:string):boolean;

implementation

{$R *.DFM}
type
 PNetResourceArray = ^TNetResourceArray;
 TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;

 PMyNetR = ^TMyNetR;
 TMyNetR = record
   mdwScope: DWORD;
   mdwType: DWORD;
   mdwDisplayType: DWORD;
   mdwUsage: DWORD;
   mlpLocalName: string;
   mlpRemoteName: string;
   mlpComment: string;
   mlpProvider: string;
 end;

var
 NetResources: PNetResourceArray;
 Count, BufSize : cardinal;
 NetHandle: THandle;

function stIfb( Bool : boolean; Yes, No : string):String;
begin
 if Bool then stIfb:=Yes else stIfb:=No
end;

function DelDD(const S : string):string;
begin
 result:=S;
 if Pos("\\",result)=1 then Delete(result,1,2);
 if Pos("\", result )>1 then delete(result, 1, Pos("\",result));
end;

{TNetDialog}
function TNetDialog.GetContainer:integer;
var
 Size: cardinal;
begin
 Result:=NO_ERROR;
   while true do
   begin
     Count := 0;
     Size := BufSize;
     Result := WNetEnumResource(NetHandle, Count, NetResources, Size);
     if Result = ERROR_MORE_DATA then
     begin
       BufSize := Size;
       ReallocMem(NetResources, BufSize);
       Continue;
     end;
     break;
   end;
end;

procedure TNetDialog.AddEnums(T : TTreeNode);
var Res, I : integer;
   P : PMyNetR;
   P1: PNetResource;
   Q : TNetResource;
   Nt, Te : TTreeNode;
   Oc : TCursor;
begin
   BufSize := 50 * SizeOf(TNetResource);
   GetMem(NetResources, BufSize);
   try
     if T=nil then P1:=nil else
     begin
       with Q, PMyNetR(T.Data)^ do
       begin
         dwScope:=mdwScope;
         dwType:=mdwType;
         dwDisplayType:=mdwDisplayType;
         dwUsage:=mdwUsage;
         lpLocalName:=Pchar(mlpLocalName);
         lpRemoteName:=Pchar(mlpRemoteName);
         lpComment:=Pchar(mlpComment);
         lpProvider:=pchar(mlpProvider);
       end;
       P1:=@Q;
     end;
//      Oc:=SetWinCursor(self, crHourGlass);
     try
       if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
                       0,P1,NetHandle)=NO_ERROR then
       try
         repeat
           if T<>nil then Res:=GetContainer else
                          Res:=GetContainer;
           if Res<>NO_ERROR then break;
           for I := 0 to Count - 1 do
           with NetResources^[I] do
           begin
             new(P);
             with P^ do
             begin
               mdwScope:=dwScope;
               mdwType:=dwType;
               mdwDisplayType:=dwDisplayType;
               mdwUsage:=dwUsage;
               mlpLocalName:=lpLocalName;
               mlpRemoteName:=lpRemoteName;
               mlpComment:=lpComment;
               mlpProvider:=lpProvider;
             end;
             if T=nil then
               Nt:=TreeView1.Items.AddObject(nil,
                                             DelDD(P^.mlpRemoteName)+
                                             stIfb(P^.mlpComment<>"",
                                             "   ("+P^.mlpComment+")",""),
                                             P)
             else
               Nt:=TreeView1.Items.AddChildObject(T,
                                                  DelDD(P^.mlpRemoteName)+
                                                  stIfb(P^.mlpComment<>"",
                                                  "   ("+P^.mlpComment+")",""),
                                                  P);
             Te:=TreeView1.Items.AddChild(Nt, "");
             Te.ImageIndex:=4;
             Te.SelectedIndex:=4;
             case dwDisplayType of
               RESOURCEDISPLAYTYPE_GENERIC : Nt.ImageIndex:=0;
               RESOURCEDISPLAYTYPE_DOMAIN  : Nt.ImageIndex:=1;
               RESOURCEDISPLAYTYPE_SERVER  : Nt.ImageIndex:=2;
               RESOURCEDISPLAYTYPE_SHARE   : Nt.ImageIndex:=3;
             else
               Nt.ImageIndex:=0;
             end;
             Nt.SelectedIndex:=Nt.ImageIndex;
           end;
         until false;
       finally
         WnetCloseEnum(NetHandle);
       end;
     finally
 //      SetWinCursor(Self,Oc);
     end;
   finally
     FreeMem(NetResources, BufSize);
   end;
end;

procedure TNetDialog.TreeView1Deletion(Sender: TObject; Node: TTreeNode);
begin
 if Node.Data<>nil then Dispose(PMyNetR(Node.Data));
end;

procedure TNetDialog.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
 var AllowExpansion: Boolean);
begin
 if Node.Count<=1 then
 begin
   if Node.Count>0 then Node.Item[0].Delete;
   AddEnums(Node);
 end;
end;

procedure TNetDialog.TreeView1DblClick(Sender: TObject);
var P : PMyNetR;
begin
 if TreeView1.Selected=nil then exit;
 P:=TreeView1.Selected.Data;
 if P<>nil then
 begin
   if P^.mdwDisplayType=RESOURCEDISPLAYTYPE_SHARE then
     RecEdit.Text:=P^.mlpRemoteName;
 end;
end;

function SelectNetResource(const Caption:string;var Res:string):boolean;
begin
 NetDialog:=TnetDialog.Create(application);
 result:=false;
 try
   NetDialog.Caption:=Application.Title+": "+NetDialog.Caption;
   NetDialog.Prompt.Caption:=Caption;
   NetDialog.RecEdit.Text:=Res;
   if NetDialog.ShowModal=mrOk then
   begin
     Res:=Trim(NetDialog.RecEdit.Text);
     if Res<>"" then result:=true;
   end;
 finally
   NetDialog.Free;
 end;
end;

procedure TNetDialog.FormShow(Sender: TObject);
begin
 AddEnums(nil);
end;

procedure TNetDialog.FormCloseQuery(Sender: TObject;
 var CanClose: Boolean);
begin
 while TreeView1.Items.Count>0 do TreeView1.Items[0].Delete;
end;

procedure TNetDialog.RefeshBtnClick(Sender: TObject);
begin
 while TreeView1.Items.Count>0 do
   TreeView1.Items[0].Delete;
 AddEnums(nil);
end;

end.

---

← →
Verg ©   (2004-04-21 07:22) [13]

Немного надо его подправить, а так очень даже приятный получается диалог:

Count := 0; -> Count := INFINITE;

        if T<>nil then Res:=GetContainer else
                         Res:=GetContainer;
          if Res<>NO_ERROR then break;

Я бы тут поправил на

   
          if GetContainer<>NO_ERROR then break;
          if Count = 0 then break;

---

← →
Verg ©   (2004-04-21 07:27) [14]

И еще я бы перенес TreeView1DblClick на просто TreeView1Click - так логичнее, но дело вкуса конечно.

---

← →
dimmu   (2004-05-21 10:44) [15]

Добрый день, мастера!
Пишу модуль индексирования файлов для поисковой системы в локальной сети. В первой написал индексирование фтп-серверов через инди и сейчас решил добавить поиск по расшаренным папкам.

Как получить поиск папок я разобрался (благо информации хватает - и здесь и куча примеров в мсдн) и написал через wnetopenenum/wnetenumresource/wnetcloseenum (Кстати, 2Verg ©   (21.04.04 06:43) - структура NETRESOURCE описана в windows.pas).

Теперь надо разобраться как программно получать список директорий и файлов в расшаренной папке и рекурсивно их обежать и занести в БД - с этим-то у меня возникли проблемы и нужна Ваша помощь.

Пока возникло несколько идей - в основном заключающихся в том, чтобы работать с расшаренной папкой как с обычной, но ни одну реализовать не удалось:
* попробовал findfirst/findnext/findclose, передавал им путь в стиле //компютер/расшаренная_папка -
* нашел статью в мсдн про ishellfolder - но где взять само описание интерфейса не нашел (в мсдн указывается, что оно должно быть в shell32.dll, но при импортировании библиотеки типов нужного интерфейса там не оказывается)

---

← →
Krey   (2004-05-21 21:10) [16]

findfirst \\компютер\расшаренная_папка
-Должно работать

---

← →
Rouse_ ©   (2004-05-21 21:27) [17]

WNetAddConnection, WNetAddConnection2, WNetAddConnection3 :)

Также в MSDN сказано следующее

Similarly, on network shares, you can use an lpFileName of the form "\\server\service\*" but you cannot use an lpFileName that points to the share itself, such as "\\server\service".

---

← →
sirin   (2004-05-22 15:56) [18]

2 dimmi
findfirs работает нормально, я делал такую же программу
если у тебя не хочет работать, напиши, какую ошибку выдает

---

← →
коД_в_мешке   (2004-05-23 07:30) [19]

Погвоздите плиз этот код.

type
   TNetEnumThread = class(TThread)
       ChildNode: String;
       TreeNode: TTreeNode;
       procedure AddChildNode;
       procedure Execute; override;
       procedure LoadNetNode(NetNode: PNetResourceA);
       procedure BeforeUpdate;
       procedure AfterUpdate;
   end;

var
 Form1: TForm1;
 flagError: boolean;
const InitialSize = $1;

implementation

uses client2;

procedure TNetEnumThread.BeforeUpdate;
begin
TreeNode:=nil;
Form1.TreeView1.Items.Clear;
Form1.Button1.Enabled:=false;
end;

procedure TNetEnumThread.AfterUpdate;
begin
Form1.TreeView1.FullExpand;
Form1.Button1.Enabled:=true;
end;

procedure TNetEnumThread.Execute;
begin
FreeOnTerminate:=True;
Synchronize(BeforeUpdate);
LoadNetNode(nil);
Synchronize(AfterUpdate);
end;

procedure TNetEnumThread.AddChildNode;
begin
TreeNode:=Form1.TreeView1.Items.AddChild(TreeNode,ChildNode);
end;

procedure TNetEnumThread.LoadNetNode(NetNode: PNetResourceA);
var hEnum : THandle;
   Count,BufSize: DWORD;
   NR,Buf: PNetResourceA;
   R: Integer;
   next,add:boolean;
   CurrentNode: TTreeNode;
begin
R:=WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_ANY,RESOURCEUSAGE_CONTAINER,NetNode,hEnum);
if R<>NO_ERROR then exit;
BufSize:=InitialSize ; GetMem(Buf,BufSize);
try
 while true do
 begin
  Count:=$FFFFFFFF; // I wish to read ALL items
  R:=WNetEnumResource(hEnum,Count, Buf, BufSize);
  if R = ERROR_MORE_DATA then // Oops ! The InitialSize is too small !
  begin
   Count:=$FFFFFFFF; // I wish to read ALL items
   FreeMem(Buf); GetMem(Buf,BufSize);
   R:=WNetEnumResource(hEnum,Count, Buf, BufSize);
  end;
  if R = ERROR_NO_MORE_ITEMS then break; // All items are processed
  if R<>NO_ERROR then abort; // R is the error code. Process it!
  NR:=Buf;
  while Count>0 do
  begin
    CurrentNode:=TreeNode; // Remember current position

    if NR.lpRemoteName<>nil then
     ChildNode:=StrPas(NR.lpRemoteName)
    else
     ChildNode:="-";

    add:=false;
    next:=false;

    case NR.dwDisplayType of
     RESOURCEDISPLAYTYPE_NETWORK: next:=true;
     RESOURCEDISPLAYTYPE_DOMAIN: begin
                                  TreeNode:=nil;
                                  add:=true;
                                  next:=true;
                                 end;
     RESOURCEDISPLAYTYPE_SERVER: add:=true;
    end;

    if add=true then Synchronize(AddChildNode);
    if next=true then LoadNetNode(NR);
    if add=true then TreeNode:=CurrentNode; // restore current position

    Inc(NR);
    Dec(Count);
   end;
  end;
  finally
 WNetCloseEnum(hEnum); // Close handle
 FreeMem(Buf); // Free memory1
end;

end;

Код не есть мой где взял не помню.

---

← →
MegaVolt   (2004-05-24 09:54) [20]

dimmu:
Я такую прогу уже написал :) Правда она только по зашаренным дискам. :) По FTP не лазит :(
Пиши в мыло может устроим какой нибудь обмен :)
Поиск в база из 2 милионов файлов занимает 30 сек. Народ в нашей сети доволен :)

---

Страницы: 1 вся ветка

Текущий архив: 2004.07.18;
Скачать: CL | DM;

Наверх

Память: 0.55 MB
Время: 0.035 c