Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2004.07.18;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.54 MB
Время: 0.039 c
14-1088447102
Lego
2004-06-28 22:25
2004.07.18
PaintBox...


11-1076874880
DDA
2004-02-15 22:54
2004.07.18
Canvas &amp; Transparent


14-1088171705
ИМХО
2004-06-25 17:55
2004.07.18
Mail.RU совсем рехнулся


3-1088055819
garry_c
2004-06-24 09:43
2004.07.18
каскадное обновление и удаление данных


14-1088496348
Igorek
2004-06-29 12:05
2004.07.18
VCL от Дельфи5 на Дельфи6





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский