Поиск папок по сети

[Tw1X]

Ребята, может вы поможете в решении данной проблемы? или дадите ссылку для самостоятельного изучения, потому что я пока ничего путевого на эту тему не нашел.

[Vapaamies]

Ссылка для изучения -- описание битовых операций в Википедии. Выучить, потом кликать в IDE по идентификаторам с зажатым Ctrl -- будет переходить к его описанию. Включать голову и писать самостоятельно.

[NetSpace]

писал для себя - искал на компе пустые папки для удаления.
может поможет хоть как-то...

const N=1000000;
var Form1:TForm1;
    SR:TSearchRec;
    q,z,ad,jm,pnt:LongInt;
    sps:array[1..N]of string;
    Name0,Name1,Name2:array[1..N] of string;


//----- определяем число объектов в указанной папке ----------------------------
procedure TForm1.PrintObject(Put:string);
begin
   q:=0;
   if FindFirst(Put+'*.*',faHidden or faSysFile or faVolumeID or faDirectory,SR)=0 then
   repeat
    if(SR.Name<>'.')and(SR.Name<>'..')then q:=q+1;//считаем файлы в папке
   until FindNext(SR)<>0;
   FindClose(SR);
   if(q=0)then Memo1.Lines.Add(Put);
end;

//----- открываем папку --------------------------------------------------------
procedure TForm1.Direct(Put:string);
var i:LongInt;
    SR:TSearchRec;
begin
   i:=z;//число предыдущих путей,с него и начинаем счёт
   if(FindFirst(Put+'*.',faAnyFile,SR)=0)then
   repeat
    i:=i+1;
    if(SR.Name<>'.')and(SR.Name<>'..')and(FileExists(Put+SR.Name)=False)then Name1[i]:=Put+SR.Name+'\';
   until FindNext(SR)<>0;
   z:=i;//число новых папок
   FindClose(SR);
end;

//----- выводим пути на конкретном диске ---------------------------------------
procedure TForm1.PrintDirect(Dir:Byte;Put:string);
var i,j,k,p,cnt:LongInt;
begin
   //----- очищаем массивы путей -----------------------------------------------
   for i:=1 to N do Name1[i]:='';
   for i:=1 to N do Name2[i]:='';
   //----- ищем пути -----------------------------------------------------------
   Name1[1]:=Put;//начинаем искать с нашего диска
   Name2[1]:=Put;
   z:=1;
   jm:=Dir;//глубина поиска папок
   if(0<Dir)then
   begin
      if(jm<0)or(jm>8)then jm:=3;//если ошибка, то пусть ищет в глубине 3 папки
      for j:=1 to jm do//число вложенных друг в друга папок
      begin
         if(j=1)then z:=1;//один путь уже есть точно - сам диск
         for i:=1 to z do Direct(Name1[i]);
         for i:=1 to z do Name2[i]:=Name1[i];//копируем пути, чтоб потом сравнивать
         for i:=1 to z do Name2[1]:=Put;//самое первое имя-имя диска
         //----- убираем похожие папки -----------------------------------------
         for p:=0 to j+2 do
         begin
            Application.ProcessMessages;
            pnt:=0;
            for i:=1 to z do if(Name2[i]='')then Name2[i]:='*';
            for i:=1 to z do if(Name2[i]=' ')then Name2[i]:='*';
            for i:=1 to z do for k:=1 to z do if(Name2[i]=Name2[i+k])then Name2[i+k]:='*';
            for i:=1 to z do
            begin
               Application.ProcessMessages;
               Form1.Caption:=IntToStr(p*i)+' из '+IntToStr((j+2)*z);
               if(Name2[i]='*')then pnt:=pnt+1;
               if(Name2[i]<>'*')and(0<pnt)then
               begin
                  Application.ProcessMessages;
                  for k:=i-pnt to z do Name2[k]:=Name2[k+pnt];
                  pnt:=0;
               end;
            end;
            Application.ProcessMessages;
            for i:=0 to z do if(Pos('Recycled',Name2[i])<>0)then Name2[i]:='*';//если это корзина
            for i:=1 to z do if(Name2[i]='')then Name2[i]:='*';
            for i:=1 to z do if(Name2[i]=' ')then Name2[i]:='*';
         end;
      end;
   end;
   //----- считаем число пустых путей ------------------------------------------
   cnt:=0;
   for i:=1 to z do if(Name2[i]='*')then cnt:=cnt+1;
   z:=z-cnt;//вычитаем число пустых путей из общего числа путей
end;

//----- ищем пути поиска -------------------------------------------------------
procedure TForm1.Quest(Dir:Byte);
var i:LongInt;
begin
   Memo1.Clear;
   z:=0;//число путей на предыдущем диске
   ad:=0;//начальный номер путей-первый
   //PrintDirect(Dir,'C:\');//начинаем поиск путей с диска
   PrintDirect(Dir,Edit1.Text);
   for i:=ad+1 to ad+z do Name0[i]:=Name2[i-ad];//прибавляем к массиву
   ad:=ad+z;//запоминаем номер последнего пути
end;

procedure TForm1.Button1Click(Sender:TObject);
var u:Integer;
begin
   Quest(5);
   for u:=1 to z do PrintObject(Name0[u]);
end;

[Tw1X]

Сообщение от NetSpace

писал для себя - искал на компе пустые папки для удаления.
может поможет хоть как-то...

Спасибо, но это не совсем то.



Разобрался сам. если кому то в будущем поможет.
поиск по имени каталога(папки,директории) в локальной сети.

procedure NetworkScan(AFiles : TStrings); 
var pr:PNetResource; 

procedure FindWithLevel(path:string{ str:TStrings; level:integer}); 
var SR:TSearchRec; 
ext:string; str:TStrings; level:integer; 
begin 
level:=0; 
ext:='*.*'; 
if FindFirst(path+ext, faAnyFile, SR) = 0 then 
begin 
repeat 
if (SR.Attr = faDirectory) then 
if (SR.Name <> '.') and (SR.Name <> '..') then 
begin 
if sr.Name=form1.edit1.text then 
afiles.Add(path + SR.Name); 
if level <> 1 then FindWithLevel(path+SR.Name+'\'); 
end; 
until FindNext(SR) <> 0; 
FindClose(SR); 
end; 
end; 


procedure EnumNet(NetRes:PNetResource); 
var i,res,Handle,count,bufsize:cardinal; 
pr:PNetResource; 
buf:array of byte; 
begin 
bufsize:=16384; 
SetLength(buf,bufsize); 
count:=$FFFFFFFF; 
res := WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,0,NetRes,Handle); 
if res=NO_ERROR then begin 
repeat 
res:=WNetEnumResource(Handle,count,@buf[0],bufsize); 
if res=NO_ERROR then begin 
pr:=@buf[0]; 
for i:=0 to count-1 do begin 
if (pr.dwUsage and RESOURCEUSAGE_CONTAINER)<>0 
then EnumNet(pr); 
if (pr.dwUsage and RESOURCEUSAGE_CONNECTABLE)<>0 
then FindWithLevel(pr.lpRemoteName+'\'); 
inc(pr); 
end; 
end; 
until (res<>NO_ERROR); 
WNetCloseEnum(Handle); 
end; 
end; 

begin 
EnumNet(nil); 
end; 


procedure TForm1.Button1Click(Sender: TObject); 
begin 
NetworkScan(Memo1.Lines); 
end; 

end.