| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

локальные сети, IP... [D7]

S-Viper ©   (2004-06-30 00:22:00) 

Здравствуйте!
Я тут недавно нашел одну статью по поводу вывода списка компьютеров в локальной сети. Все вроде бы хорошо, работает. Но! Не знаю что сделать чтобы он определял не только RESOURCEDISPLAYTYPE_DOMAIN и RESOURCEDISPLAYTYPE_SERVER но и RESOURCEDISPLAYTYPE_SHARE... Почему он даже в ..._SHARE и не пытается заглянуть... И если не сложно, можно было бы сюда добавить код по определению IP-адреса каждого компа?

var Form1: TForm1;
   MyTreeNode: TTreeNode;
   countgroup,a,z: integer;
   Reg: TRegistry;

implementation {$R *.dfm}

Function FillNetLevel(xxx: PNetResource; list: TStrings) : Word;
Type PNRArr = ^TNRArr;
    TNRArr = array[0..255] of TNetResource;
Var x: PNRArr;
   tnr: TNetResource;
   I : integer;
   EntrReq, SizeReq, twx: THANDLE;
   WSName: string;
begin
Result := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_CONTAINER, xxx, twx);
If Result = ERROR_NO_NETWORK Then Exit;
if Result = NO_ERROR then
 begin
  New(x);
  EntrReq := 1;
  SizeReq := SizeOf(TNetResource)*255;
   while (twx <> 0) and (WNetEnumResource(twx, EntrReq, x, SizeReq) <> ERROR_NO_MORE_ITEMS) do
    begin
     For i := 0 To EntrReq - 1 do
      begin
       Move(x^[i], tnr, SizeOf(tnr));
        case tnr.dwDisplayType of
         RESOURCEDISPLAYTYPE_DOMAIN:
          begin
           if tnr.lpRemoteName <> '' then WSName:= tnr.lpRemoteName else WSName:= tnr.lpComment;
           list.Add(WSName);
           Inc(countgroup);
           MyTreeNode := Form1.TreeView.Items.Add(nil, WSName);
           FillNetLevel(@tnr, list);
          end;
         RESOURCEDISPLAYTYPE_SERVER:
          begin
           if tnr.lpRemoteName <> '' then WSName:= tnr.lpRemoteName else WSName:= tnr.lpComment;
           list.Add(' '+WSName);
           Form1.TreeView.Items.AddChild(MyTreeNode,WSName);
           FillNetLevel(@tnr, list);
          end;
         RESOURCEDISPLAYTYPE_SHARE:
          begin
           if tnr.lpRemoteName <> '' then WSName:= tnr.lpRemoteName else WSName:= tnr.lpComment;
           Form1.TreeView.Items.Add(MyTreeNode, WSName);
           list.Add(' '+WSName);
          end;
        else FillNetLevel(@tnr, list);
      end;
    end;
 end;
Dispose(x);
WNetCloseEnum(twx);
end;
Form1.TreeView.FullExpand;
end;

procedure TForm1.StartClick(Sender: TObject);
var list:TStringList;
   xxx: PNetResource;
begin
a:=z{+1};
TreeView.Items.Clear;
countgroup:=0;
list:= TStringList.Create;
xxx:= nil;
FillNetLevel(xxx, list);
list.Free;
end;

---

Rouse_   (2004-06-30 17:36:00) [1]

Бог ты мой, к чему такие секреты с исходниками :)

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, Winsock, ImgList, ShellAPI;

type
 TDemoThread = class(TThread)
 private
   TreeDomain: TTreeNode;
   TreeServer: TTreeNode;
   TreeShares: TTreeNode;
   Param_dwDisplayType: Byte;
   Param_lpRemoteName: String;
 protected
   procedure Execute; override;
   procedure Scan(Res: TNetResource; Root: boolean);
   procedure AddElement;
   procedure Stop;
 end;

 TForm1 = class(TForm)
   Button1: TButton;
   TreeView1: TTreeView;
   StatusBar1: TStatusBar;
   ImageList1: TImageList;
   procedure Button1Click(Sender: TObject);
   procedure TreeView1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure TreeView1DblClick(Sender: TObject);
 private
   Thread: TDemoThread;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function GetIPAddress(NetworkName: String): String;
var
Error: DWORD;
HostEntry: PHostEnt;
Data: WSAData;
Address: In_Addr;
begin
 Delete(NetworkName, 1, 2);
 Error:=WSAStartup(MakeWord(1, 1), Data);
 if Error = 0 then
 begin
   HostEntry:=gethostbyname(PChar(NetworkName));
   Error:=GetLastError;
   if Error = 0 then
   begin
     Address:=PInAddr(HostEntry^.h_addr_list^)^;
     Result:=inet_ntoa(Address);
   end
   else
    Result:='Unknown';
 end
 else
   Result:='Error';
 WSACleanup;
end;

{ TDemoThread }

procedure TDemoThread.Execute;
var
 R:TNetResource;
begin
 inherited;
 Priority := tpIdle;
 FreeOnTerminate := True;
 Resume;
 Scan(R, True);
 TreeDomain := nil;
 TreeServer := nil;
 Synchronize(Stop);
end;

procedure TDemoThread.Scan(Res: TNetResource; Root: boolean);
var
hEnum: cardinal;
nrResource: array[0..512] of TNetResource;
dwSize: DWORD;
numEntries: DWORD;
I: DWORD;
dwResult: DWORD;
begin
 if Root then
   dwResult := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
     0, nil, hEnum)
 else
   dwResult := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
     0, @Res, hEnum);
 if dwResult = NO_ERROR then
 begin
   dwSize := SizeOf(nrResource);
   numEntries := DWORD(-1);
   if WNetEnumResource(hEnum, numEntries, @nrResource, dwSize) = NO_ERROR then
   begin
     for i := 0 to numEntries - 1 do
     begin
       if Terminated then Break;
       with nrResource[i] do
       begin
         Param_dwDisplayType := dwDisplayType;
         Param_lpRemoteName := lpRemoteName;
       end;
       if Assigned(nrResource[i].lpRemoteName) then
         Synchronize(AddElement);
       Scan(nrResource[i], false);
     end;
   WNetCloseEnum(hEnum);
   end;
 end;
end;

procedure TDemoThread.AddElement;
begin
 Application.ProcessMessages;
 if Param_dwDisplayType = RESOURCEDISPLAYTYPE_DOMAIN then
 begin
   TreeDomain := Form1.TreeView1.Items.Add(nil, Param_lpRemoteName);
   TreeDomain.StateIndex := 1;
 end
 else
   if Param_dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then
   begin
     TreeServer := Form1.TreeView1.Items.AddChild(TreeDomain, Param_lpRemoteName + ' IP: ' + GetIPAddress(Param_lpRemoteName));
     TreeServer.StateIndex := 2;
   end
   else
   begin
     TreeShares := Form1.TreeView1.Items.AddChild(TreeServer, Param_lpRemoteName);
     TreeShares.StateIndex := 3;
   end;
end;

procedure TDemoThread.Stop;
begin
 Form1.StatusBar1.Panels[1].Text := '   Сканирование завершено ...';
 Form1.Button1.Caption := 'Начать сканирование';
 Form1.Button1.Enabled := True;
 Form1.Tag := 0;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
 Tag := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Tag := Tag + 1;
 if (Tag mod 2) = 1 then
 begin
   TreeView1.Items.Clear;
   StatusBar1.Panels[1].Text := '   Идет сканирование ...';
   Button1.Caption := 'Остановить сканирование';
   Thread := TDemoThread.Create(False);
 end
 else
 begin
   StatusBar1.Panels[1].Text := '   Завершение потока ...';
   Button1.Enabled := False;
   Thread.Terminate;
 end;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
 if Assigned(TreeView1.Selected) then
   StatusBar1.Panels[0].Text := '   ' + TreeView1.Selected.Text
 else
   StatusBar1.Panels[0].Text := '   Поле не выбрано ...';
end;

procedure TForm1.TreeView1DblClick(Sender: TObject);
var
 Str: String;
begin
 if Assigned(TreeView1.Selected) then
 begin
   Str := TreeView1.Selected.Text;
   if Copy(Str, 1, 2) <> '\\' then Exit;
   if Pos(' IP:', Str) <> 0 then
     ShellExecute(Handle, 'explore', PChar(Copy(Str, 1, Pos(' IP:', Str))), nil, nil, SW_SHOW)
   else
     ShellExecute(Handle, 'explore', PChar(Str), nil, nil, SW_SHOW);
 end;
end;

end.

---

cherrex   (2004-06-30 16:14:00) [2]

Ну спасибо!!! Желаю долнейших успехов в ПРОГРАММИРОВАНИИ. Удачи.

---

Said   (2004-06-30 16:10:00) [3]

Забирай

---

cherrex   (2004-06-30 15:40:00) [4]

Вышли мне cherrex@mail.ru. Буду благодарен! И напишу тебе кучу пожеланий.

---

Said   (2004-06-30 08:33:00) [5]

Могу дать готовую прогу, с исходниками, с условием:
ответишь, напишешь пожелания и т.п.
Могу выслать на твой ящик, подтверди согласие.

---

Наверх