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

Вниз

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

 
pkm   (2004-09-07 19:29) [0]

Еще раз доброе время суток. Забыл еще вопрос один задать, как с помощью Delhi  можно создать программу, которая выводила бы список компьютеров находящихся в данное время в сети. Спасибо за внимание.


 
Rouse_ ©   (2004-09-07 20:30) [1]

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

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.


 
Вован   (2004-10-01 16:12) [2]

че-то не работает эта прога:(


 
Rouse_ ©   (2004-10-01 17:57) [3]

Значит не судьба ;)


 
Rouse_ ©   (2004-10-01 17:59) [4]

Если не можешь собрать то она собранная есть здесь...
http://rouse.front.ru



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

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

Наверх





Память: 0.57 MB
Время: 0.061 c
1-1101878308
dolphin
2004-12-01 08:18
2004.12.12
record с неизвестным количеством переменных


3-1100111086
APXi
2004-11-10 21:24
2004.12.12
Как узнать ID созданной с помощью SQL записи?


6-1096821871
Agent-Smith
2004-10-03 20:44
2004.12.12
Реализация работы между сегментами сети


1-1101887751
RDen
2004-12-01 10:55
2004.12.12
Опять про второй экземпляр приложения...


14-1100344529
VID
2004-11-13 14:15
2004.12.12
Как сделать так...





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский