Форум: "Сети";
Текущий архив: 2004.10.17;
Скачать: [xml.tar.bz2];

Вниз

Проблема с определением IP компов LAN a   Найти похожие ветки 

← →
Alexis ©   (2004-08-05 22:26) [0]

Написал функцию поиска всех компов в локалке и определения их адресов :

function TMainForm.ScanLocalNetwork(PNetR : PNetResource; List : TListView) : WORD;
type
TNetArray = array[0..200] of TNetResource;
PNetArray = ^TNetArray;
var
P : PNetArray;
NetResource : TNetResource;
I : Integer;
hEnum,
Count,
BufferSize : THandle;
WSName : string;

NewComp : TListItem;
HostInfo : PHostEnt;

begin

Result := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_CONTAINER, PNetR, hEnum);
if Result = ERROR_NO_NETWORK then
begin
 MessageBox(0, "No network found.", "H-m-m", MB_ICONWARNING);
 Exit;
end;
if Result = NO_ERROR then
begin
 New(P);
 Count := 1;
 BufferSize := sizeof(TNetResource)*201;
 while (hEnum <> 0) and
       (WNetEnumResource(hEnum, Count, P,BufferSize) <> ERROR_NO_MORE_ITEMS) do
 begin
  for I := 0 to Count-1 do
  begin
   Move(P^[I], NetResource, sizeof(NetResource));
   case NetResource.dwDisplayType of RESOURCEDISPLAYTYPE_SERVER :
   begin
    if NetResource.lpRemoteName <> "" then
     WSName := NetResource.lpRemoteName
    else
     WSName := NetResource.lpComment;

    NewComp := List.Items.Add;
    NewComp.Caption := Copy(WSName, 3, Length(WSName)-2);
   
    HostInfo := gethostbyname(PChar(WSName));
    NewComp.SubItems.Add(inet_ntoa(PInAddr(HostInfo.h_addr_list^)^));
   end;
   else
    ScanLocalNetwork(@NetResource, List);
   end;
  end;
 end;
 Dispose(P);
 WNetCloseEnum(hEnum);

end;

end;

Вызываю ее из проги так:
ScanLocalNetwork(Nil, LocalComps);

Если не добавлять жирные строки определяющие IP, то все прекрасно работает, а с ними нет:( Где-же я ошибся?
Заранее спасибо.

---

← →
имя   (2004-08-05 22:42) [1]

Удалено модератором

---

← →
Rouse_ ©   (2004-08-05 22:50) [2]

////////////////////////////////////////////////////////////////////////////////
//
//  Демонстрационная программа сканирования сети на основе
//  WNetOpenEnum, WNetEnumResource, WNetCloseEnum
//
//  Автор: Александр (Rouse_) Багель
//  mailto:rouse79@yandex.ru
//
//  Сепtциально для форумов Мастера Дельфи
//  http://www.delphimaster.ru
//
//  Другие демо программы вы можете найти на http://delphi.k-jarve.ee/programm/
//

unit Unit1;

interface

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

const
 STR_START    =  "Начать сканирование";
 STR_STOP     =  "Остановить сканирование";
 STR_STARTED  =  "   Идет сканирование ...";
 STR_STOPPED  =  "   Сканирование завершено ...";
 STR_END      =  "   Завершение потока ...";
 STR_FIELD    =  "   Поле не выбрано ...";

type
 TDemoThread = class(TThread)
 private
   TreeNetWrk: TTreeNode;
   TreeDomain: TTreeNode;
   TreeServer: TTreeNode;
   TreeShares: TTreeNode;
   Param_dwType: Byte;
   Param_dwDisplayType: Byte;
   Param_lpRemoteName: String;
   Param_lpIP: 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_ANY,
     0, nil, hEnum)
 else
   dwResult := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
     0, @Res, hEnum);
 if dwResult = NO_ERROR then
 begin
   dwSize := SizeOf(nrResource);
   numEntries := DWORD(-1);                                   // ERROR_NO_MORE_ITEMS
   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_dwType := dwType;
         Param_dwDisplayType := dwDisplayType;
         Param_lpRemoteName := lpRemoteName;
         if Param_dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then
           Param_lpIP := GetIPAddress(Param_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;
 case Param_dwDisplayType of
   RESOURCEDISPLAYTYPE_NETWORK:
   begin
     TreeNetWrk := Form1.TreeView1.Items.Add(nil, Param_lpRemoteName);
     TreeNetWrk.StateIndex := 1;
   end;
   RESOURCEDISPLAYTYPE_DOMAIN:
   begin
     TreeDomain := Form1.TreeView1.Items.AddChild(TreeNetWrk, Param_lpRemoteName);
     TreeDomain.StateIndex := 2;
   end;
   RESOURCEDISPLAYTYPE_SERVER:
   begin
     TreeServer := Form1.TreeView1.Items.AddChild(TreeDomain, Param_lpRemoteName + " IP: " + Param_lpIP);
     TreeServer.StateIndex := 3;
   end;
   RESOURCEDISPLAYTYPE_SHARE:
   begin
     TreeShares := Form1.TreeView1.Items.AddChild(TreeServer, Param_lpRemoteName);
     TreeShares.StateIndex := 3 + Param_dwType;
   end;
 end;
end;

procedure TDemoThread.Stop;
begin
 Form1.StatusBar1.Panels[1].Text := STR_STOPPED;
 Form1.Button1.Caption := STR_START;
 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 := STR_STARTED;
   Button1.Caption := STR_STOP;
   Thread := TDemoThread.Create(False);
 end
 else
 begin
   StatusBar1.Panels[1].Text := STR_END;
   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 := STR_FIELD;
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.

---

← →
Alexis ©   (2004-08-07 14:06) [3]

Rouse_, спасибо.
Оказывается, просто надо было первых два символа из имени убрать.
Сейчас все OK.

---

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

Форум: "Сети";
Текущий архив: 2004.10.17;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.036 c