recuperer le réseau

**tomabrit** · 22/05/2007, 15h03

Bonjour ,
je voudrais recuperer dans mon programme toutes les adresse IP des PC etant connecté sur le reseau. Merci

**abdelghani_k** · 22/05/2007, 16h31

Utilise les composants Indy : TCPServer et TCPClient.
Peut être ca va vous aider.

mais pour récupérer l'@ IP locale voici le code d'un fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
uses ..., Winsock;
 
function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean; 
type 
  Name = array[0..100] of Char; 
  PName = ^Name; 
var 
  HEnt: pHostEnt;
  HName: PName; 
  WSAData: TWSAData;
  i: Integer; 
begin 
  Result := False;     
  if WSAStartup($0101, WSAData) <> 0 then begin 
    WSAErr := 'Winsock ne répond pas"'; 
    Exit; 
  end; 
  IPaddr := ''; 
  New(HName); 
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin 
    HostName := StrPas(HName^); 
    HEnt := GetHostByName(HName^); 
    for i := 0 to HEnt^.h_length - 1 do 
     IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.'); 
    SetLength(IPaddr, Length(IPaddr) - 1); 
    Result := True; 
  end
  else begin 
   case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:='WSANotInitialised'; 
    WSAENETDOWN      :WSAErr:='WSAENetDown'; 
    WSAEINPROGRESS   :WSAErr:='WSAEInProgress'; 
   end; 
  end; 
  Dispose(HName); 
  WSACleanup; 
end;

fait un appel comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Host, IP, Err: string;
begin
  if GetIPFromHost(Host, IP, Err) then begin
    Edit1.Text := Host;
    Edit2.Text := IP;
  end
  else
    MessageDlg(Err, mtError, [mbOk], 0);
end;

**abdelghani_k** · 23/05/2007, 14h35

Voici ce que j'ai pu retrouvé pour vous, un ipscan en delphi, et ce que je n'ai pas réussi à faire c'était l'affichage immédiat d'un scan ip à un autre, je vous propose de le revoir, de le tester et d'optimiser le code si c'est possible :

voici l'unité :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
 
unit ipscanunit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSock, Icmp, NB30, StdCtrls, Grids;
 
 
const
  MAX_THREAD_COUNT = 16; 
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    AdrDebut: TEdit;
    AdrFin: TEdit;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
  PNBStat = ^TNBStat;
  TNBStat = packed record
    AdapterStatus: TAdapterStatus;
    NameBuffer: array[0..254] of TNameBuffer;
  end;
 
  PNBInfo = ^TNBInfo;
  TNBInfo = packed record
    ComputerName: string[NCBNAMSZ];
    GroupName: string[NCBNAMSZ];
    MacAddress: string[17];
  end;
 
var
  Form1: TForm1;
  StartAddress, EndAddress, CurrentAddress: Longint;
  dwTimeOut: DWORD = 1000;
  WSAData: TWSAData;
  LanaEnum: TLanaEnum;
  hIcmp: THandle;
  Params: array[0..MAX_THREAD_COUNT - 1] of Longint;
  Handles: array[0..MAX_THREAD_COUNT - 1] of THandle;
  CSect: TRTLCriticalSection;
  i, j, Ind: Integer;
  ThreadID: DWORD;
 
{$R *.dfm}
 
implementation
 
function GetLana(var LanaEnum: TLanaEnum): Boolean;
var
  NCB: TNCB;
begin
  FillChar(LanaEnum, SizeOf(LanaEnum), 0);
  FillChar(NCB, SizeOf(NCB), 0);
  with NCB do
  begin
    ncb_command := Char(NCBENUM);
    ncb_buffer := PChar(@LanaEnum);
    ncb_length := SizeOf(TLanaEnum);
    Netbios(@NCB);
    Result := (ncb_retcode = Char(NRC_GOODRET)) and (Byte(LanaEnum.length) > 0);
  end;
end;
 
function NBReset(const LanaNum: Char): Boolean;
var
  NCB: TNCB;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  with NCB do
  begin
    ncb_command := Char(NCBRESET);
    ncb_lana_num := LanaNum;
    Netbios(@NCB);
    Result := (ncb_retcode = Char(NRC_GOODRET));
  end;
end;
 
function GetNetBiosInfo(const LanaNum: Char; const IpAddress: string;
  var NBInfo: TNBInfo): Boolean;
var
  NCB: TNCB;
  NBStat: TNBStat;
  i: Integer;
begin
  FillChar(NCB, SizeOf(TNCB), 0);
  FillChar(NBStat, SizeOf(TNBStat), 0);
  with NCB do
  begin
    ncb_command := Char(NCBASTAT);
    ncb_buffer := PChar(@NBStat);
    ncb_length := SizeOf(TNBStat);
    StrCopy(ncb_callname, PChar(IpAddress));
    ncb_lana_num := LanaNum;
    NetBios(@NCB);
    Result := ncb_retcode = Char(NRC_GOODRET);
    with NBStat, NBInfo do
      if Result then
      begin
        for i := 0 to AdapterStatus.name_count - 1 do
          if (NameBuffer[i].Name[15] = #0) then
          begin
            case NameBuffer[i].name_flags of
              Char(UNIQUE_NAME + REGISTERED):
                ComputerName := Trim(NameBuffer[i].Name);
              Char(GROUP_NAME + REGISTERED):
                GroupName := Trim(NameBuffer[i].Name);
            end;
            if (ComputerName <> '') and (GroupName <> '') then
              Break;
          end;
        MacAddress := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x', [
                             Byte(AdapterStatus.adapter_address[0]),
                             Byte(AdapterStatus.adapter_address[1]),
                             Byte(AdapterStatus.adapter_address[2]),
                             Byte(AdapterStatus.adapter_address[3]),
                             Byte(AdapterStatus.adapter_address[4]),
                             Byte(AdapterStatus.adapter_address[5])]);
      end
      else
      begin
        ComputerName := '?';
        GroupName := '?';
        MacAddress := '?-?-?-?-?-?';
      end;
  end;
end;
 
function Ping(IpAddress: DWORD): Boolean;
const
  BUFFER_SIZE  = 32;
var
  dwRetVal: DWORD;
  PingBuffer: Pointer;
  pIpe: PIcmpEchoReply;
begin
  GetMem(pIpe, SizeOf(TICMPEchoReply) + BUFFER_SIZE);
  try
    GetMem(PingBuffer, BUFFER_SIZE);
    try
      FillChar(PingBuffer^, BUFFER_SIZE, $AA);
      pIpe^.Data := PingBuffer;
      dwRetVal := IcmpSendEcho(hIcmp, IpAddress, PingBuffer, BUFFER_SIZE, nil,
                               pIpe, SizeOf(TICMPEchoReply) + BUFFER_SIZE, dwTimeOut);
      Result := dwRetVal <> 0;
    finally
      FreeMem(PingBuffer);
    end;
  finally
    FreeMem(pIpe);
  end;
end;
 
function Execute(P: Pointer): Integer;
var
  HostByteOrder: DWORD;
  IpAddress: string;
  i: Integer;
  NBInfo: TNBInfo;
begin
  HostByteOrder := ntohl(PDWORD(P)^);
  if Ping(HostByteOrder) then
  begin
    IpAddress := Format('%d.%d.%d.%d', [HostByteOrder and $FF,
                                       (HostByteOrder shr 8) and $FF,
                                       (HostByteOrder shr 16) and $FF,
                                       (HostByteOrder shr 24) and $FF]);
    for i := 0 to Byte(LanaEnum.length) - 1 do
    begin
      FillChar(NBInfo, SizeOf(NBInfo), 0);
      if GetNetBiosInfo(LanaEnum.lana[i], IpAddress, NBInfo) then
        Break;
    end;
    EnterCriticalSection(CSect);
    try
      Form1.StringGrid1.Cells[0,Ind]:=IpAddress;
      Form1.StringGrid1.Cells[1,Ind]:=NBInfo.ComputerName;
      Form1.StringGrid1.Cells[2,Ind]:=NBInfo.GroupName;
      Form1.StringGrid1.Cells[3,Ind]:=NBInfo.MacAddress;
      Inc(Ind);
    finally
      LeaveCriticalSection(CSect);
    end;
  end;
  Result := 0;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  StartAddress := htonl(inet_addr(PChar(AdrDebut.Text)));
  if (StartAddress = INADDR_NONE) or (Pos('.', AdrDebut.Text) = 0) then
  begin
    Showmessage('@IP début invalide.');
    Halt;
  end;
  EndAddress := htonl(inet_addr(PChar(AdrFin.Text)));
  if (EndAddress = INADDR_NONE) or (Pos('.', AdrFin.Text) = 0) then
  begin
    Showmessage('@IP finale invalide.');
    Halt;
  end;
  if StartAddress > EndAddress then
  begin
    Showmessage('@IP début ne peut être supérieure à @IP finale.');
    Halt;
  end;
  if WSAStartup($0101, WSAData) <> 0 then
  begin
    Showmessage('Winsock ne peut être initialisé.');
    Halt;
  end;
  if not GetLana(LanaEnum) then
  begin
    Showmessage('Problème adaptateur réseau.');
    Halt;
  end;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    for i := 0 to Byte(LanaEnum.length) - 1 do
      if not NBReset(LanaEnum.lana[i]) then
      begin
        Showmessage('Erreur Reset lana.');
        Halt;
      end;
  hIcmp := IcmpCreateFile;
  if hIcmp = INVALID_HANDLE_VALUE then
  begin
    Showmessage('icmp.dll ne peut être initialisée.');
    Halt;
  end;
 
  StringGrid1.Cells[0,0]:='Adresse IP';
  StringGrid1.Cells[1,0]:='Nom Ordinateur';
  StringGrid1.Cells[2,0]:='Groupe';
  StringGrid1.Cells[3,0]:='Adresse MAC';
  i := 0;
  Ind:=1;
  showmessage('ok');
 
  CurrentAddress := StartAddress;
  FillChar(Params, SizeOf(Params), 0);
  FillChar(Handles, SizeOf(Handles), 0);
  InitializeCriticalSection(CSect);
  try
    while True do
    begin
      Params[i] := CurrentAddress;
      Handles[i] := BeginThread(nil, 0, Execute, @Params[i], 0, ThreadID);
      Inc(i);
      if (i = MAX_THREAD_COUNT) or (CurrentAddress = EndAddress) then
      begin
        WaitForMultipleObjects(i, @Handles, True, INFINITE);
        for j := 0 to i - 1 do
          CloseHandle(Handles[j]);
        FillChar(Params, SizeOf(Params), 0);
        FillChar(Handles, SizeOf(Handles), 0);
        i := 0;
      end;
      if CurrentAddress = EndAddress then
        Break
      else
        Inc(CurrentAddress);
    end;
  finally
    DeleteCriticalSection(CSect);
    IcmpCloseHandle(hIcmp);
    WSACleanup;
  end;
 
end;
 
end.

Voici le fichier DFM en texte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 
object Form1: TForm1
  Left = 198
  Top = 133
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 272
    Top = 416
    Width = 75
    Height = 25
    Caption = 'Scan'
    TabOrder = 0
    OnClick = Button1Click
  end
  object AdrDebut: TEdit
    Left = 64
    Top = 80
    Width = 241
    Height = 21
    TabOrder = 1
    Text = '172.100.0.1'
  end
  object AdrFin: TEdit
    Left = 320
    Top = 80
    Width = 241
    Height = 21
    TabOrder = 2
    Text = '172.100.0.254'
  end
  object StringGrid1: TStringGrid
    Left = 64
    Top = 128
    Width = 529
    Height = 265
    ColCount = 4
    FixedCols = 0
    RowCount = 255
    TabOrder = 3
    ColWidths = (
      136
      133
      109
      102)
  end
end

Et voici l'unité Icmp :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
 
 
{*******************************************************}
{                                                       }
{       Borland Delphi Runtime Library                  }
{       ICMP API Interface Unit                         }
{                                                       }
{       Copyright (c) 1990-1999 Microsoft Corporation   }
{                                                       }
{                                                       }
{*******************************************************}
 
unit Icmp;
 
{$WEAKPACKAGEUNIT}
 
interface
 
uses
  Windows;
 
const
 
{ IP_STATUS codes returned from IP APIs }
 
  IP_STATUS_BASE             = 11000;
 
  IP_SUCCESS                 = 0;
  IP_BUF_TOO_SMALL           = (IP_STATUS_BASE + 1);
  IP_DEST_NET_UNREACHABLE    = (IP_STATUS_BASE + 2);
  IP_DEST_HOST_UNREACHABLE   = (IP_STATUS_BASE + 3);
  IP_DEST_PROT_UNREACHABLE   = (IP_STATUS_BASE + 4);
  IP_DEST_PORT_UNREACHABLE   = (IP_STATUS_BASE + 5);
  IP_NO_RESOURCES            = (IP_STATUS_BASE + 6);
  IP_BAD_OPTION              = (IP_STATUS_BASE + 7);
  IP_HW_ERROR                = (IP_STATUS_BASE + 8);
  IP_PACKET_TOO_BIG          = (IP_STATUS_BASE + 9);
  IP_REQ_TIMED_OUT           = (IP_STATUS_BASE + 10);
  IP_BAD_REQ                 = (IP_STATUS_BASE + 11);
  IP_BAD_ROUTE               = (IP_STATUS_BASE + 12);
  IP_TTL_EXPIRED_TRANSIT     = (IP_STATUS_BASE + 13);
  IP_TTL_EXPIRED_REASSEM     = (IP_STATUS_BASE + 14);
  IP_PARAM_PROBLEM           = (IP_STATUS_BASE + 15);
  IP_SOURCE_QUENCH           = (IP_STATUS_BASE + 16);
  IP_OPTION_TOO_BIG          = (IP_STATUS_BASE + 17);
  IP_BAD_DESTINATION         = (IP_STATUS_BASE + 18);
 
{ The next group are status codes passed up on status indications to
  transport layer protocols. }
 
  IP_ADDR_DELETED            = (IP_STATUS_BASE + 19);
  IP_SPEC_MTU_CHANGE         = (IP_STATUS_BASE + 20);
  IP_MTU_CHANGE              = (IP_STATUS_BASE + 21);
  IP_UNLOAD                  = (IP_STATUS_BASE + 22);
  IP_ADDR_ADDED              = (IP_STATUS_BASE + 23);
  IP_MEDIA_CONNECT           = (IP_STATUS_BASE + 24);
  IP_MEDIA_DISCONNECT        = (IP_STATUS_BASE + 25);
  IP_BIND_ADAPTER            = (IP_STATUS_BASE + 26);
  IP_UNBIND_ADAPTER          = (IP_STATUS_BASE + 27);
  IP_DEVICE_DOES_NOT_EXIST   = (IP_STATUS_BASE + 28);
  IP_DUPLICATE_ADDRESS       = (IP_STATUS_BASE + 29);
  IP_INTERFACE_METRIC_CHANGE = (IP_STATUS_BASE + 30);
  IP_RECONFIG_SECFLTR        = (IP_STATUS_BASE + 31);
  IP_NEGOTIATING_IPSEC       = (IP_STATUS_BASE + 32);
  IP_INTERFACE_WOL_CAPABILITY_CHANGE = (IP_STATUS_BASE + 33);
  IP_DUPLICATE_IPADD         = (IP_STATUS_BASE + 34);
 
  IP_GENERAL_FAILURE         = (IP_STATUS_BASE + 50);
  MAX_IP_STATUS              = IP_GENERAL_FAILURE;
  IP_PENDING                 = (IP_STATUS_BASE + 255);
 
{ Values used in the IP header Flags field. }
 
  IP_FLAG_DF      = $2;      { Don't fragment this packet. }
 
 
{ Supported IP Option Types. }
 
{ These types define the options which may be used in the OptionsData field
  of the ip_option_information structure.  See RFC 791 for a complete
  description of each. }
 
  IP_OPT_EOL      = 0;       { End of list option }
  IP_OPT_NOP      = 1;       { No operation }
  IP_OPT_SECURITY = $82;     { Security option }
  IP_OPT_LSRR     = $83;     { Loose source route }
  IP_OPT_SSRR     = $89;     { Strict source route }
  IP_OPT_RR       = $7;      { Record route }
  IP_OPT_TS       = $44;     { Timestamp }
  IP_OPT_SID      = $88;     { Stream ID (obsolete) }
  IP_OPT_ROUTER_ALERT = $94; { Router Alert Option }
 
  MAX_OPT_SIZE    = 40;      { Maximum length of IP options in bytes }
 
type
 
{ IP types }
 
  TIPAddr   = DWORD; { An IP address. }
  TIPMask   = DWORD; { An IP subnet mask. }
  TIPStatus = DWORD; { Status code returned from IP APIs. }
 
{ The ip_option_information structure describes the options to be
  included in the header of an IP packet. The TTL, TOS, and Flags
  values are carried in specific fields in the header. The OptionsData
  bytes are carried in the options area following the standard IP header.
  With the exception of source route options, this data must be in the
  format to be transmitted on the wire as specified in RFC 791. A source
  route option should contain the full route - first hop thru final
  destination - in the route data. The first hop will be pulled out of the
  data and the option will be reformatted accordingly. Otherwise, the route
  option should be formatted as specified in RFC 791. }
 
  PIPOptionInformation = ^TIPOptionInformation;
  TIpOptionInformation = packed record
    Ttl: BYTE;          { Time To Live }
    Tos: BYTE;          { Type Of Service }
    Flags: BYTE;        { IP header flags }
    OptionsSize: BYTE;  { Size in bytes of options data }
    OptionsData: PBYTE; { Pointer to options data }
  end;
 
{ The icmp_echo_reply structure describes the data returned in response
  to an echo request. }
 
  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = packed record
    Address: TIPAddr;              { Replying address }
    Status: DWORD;                 { Reply IP_STATUS }
    RoundTripTime: DWORD;          { RTT in milliseconds }
    DataSize: WORD;                { Reply data size in bytes }
    Reserved: WORD;                { Reserved for system use }
    Data: Pointer;                 { Pointer to the reply data }
    Options: TIpOptionInformation; { Reply options }
  end;
 
 
function IcmpCreateFile: THandle; stdcall;
 
function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall;
 
function IcmpSendEcho(IcmpHandle: THandle;
                      DestinationAddress: TIPAddr;
                      RequestData: Pointer;
                      RequestSize: WORD;
                      RequestOptions: PIPOptionInformation;
                      ReplyBuffer: Pointer;
                      ReplySize: DWORD;
                      Timeout: DWORD): DWORD; stdcall;
 
implementation
 
const
  icmpDLL = 'icmp.dll';
 
function IcmpCreateFile;  external icmpDLL name 'IcmpCreateFile';
function IcmpCloseHandle; external icmpDLL name 'IcmpCloseHandle';
function IcmpSendEcho;    external icmpDLL name 'IcmpSendEcho';
 
end.

A la fin je vous dis : 'il ne faut jamais jeter le manche aprés la cognée'. il ne faut jamais desépérer.

On arrive toujours après la recherche et les essais.

**Soulama** · 23/05/2007, 14h44

voir dans le

recuperer le réseau

Delphi

Vue hybride

Discussions similaires

Partager

Partager