Discussion :

[Wilco]

Bonjour à tous,

Sous Delphi 2010, je souhaite faire un ping sur toutes les machines du réseau pour vérifier celles qui sont en marche.

J'utilise le code trouvé sur le site http://theroadtodelphi.wordpress.com...ry/networking/

ça marche mais lorsque je ping un PC qui est éteint ou qui n'est pas sur le réseau, le timeout est d'environ 30 secondes, ce qui es trop long pour l'usage que je souhaite en faire.

Je souhaite réduire ce timeout à 3secondes. Est ce possible et si oui comment ?


Merci d'avance pour vos réponses.
Wilco

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
program WMIPing;
002
 
003
{$APPTYPE CONSOLE}
004
 
005
uses
006
  SysUtils,
007
  ActiveX,
008
  ComObj,
009
  Variants;
010
 
011
function GetStatusCodeStr(statusCode:integer) : string;
012
begin
013
  case statusCode of
014
    0     : Result:='Success';
015
    11001 : Result:='Buffer Too Small';
016
    11002 : Result:='Destination Net Unreachable';
017
    11003 : Result:='Destination Host Unreachable';
018
    11004 : Result:='Destination Protocol Unreachable';
019
    11005 : Result:='Destination Port Unreachable';
020
    11006 : Result:='No Resources';
021
    11007 : Result:='Bad Option';
022
    11008 : Result:='Hardware Error';
023
    11009 : Result:='Packet Too Big';
024
    11010 : Result:='Request Timed Out';
025
    11011 : Result:='Bad Request';
026
    11012 : Result:='Bad Route';
027
    11013 : Result:='TimeToLive Expired Transit';
028
    11014 : Result:='TimeToLive Expired Reassembly';
029
    11015 : Result:='Parameter Problem';
030
    11016 : Result:='Source Quench';
031
    11017 : Result:='Option Too Big';
032
    11018 : Result:='Bad Destination';
033
    11032 : Result:='Negotiating IPSEC';
034
    11050 : Result:='General Failure'
035
    else
036
    result:='Unknow';
037
  end;
038
end;
039
 
040
 
041
//The form of the Address parameter can be either the computer name (wxyz1234), IPv4 address (192.168.177.124), or IPv6 address (2010:836B:4179::836B:4179).
042
procedure  Ping(const Address:string;Retries,BufferSize:Word);
043
var
044
  FSWbemLocator : OLEVariant;
045
  FWMIService   : OLEVariant;
046
  FWbemObjectSet: OLEVariant;
047
  FWbemObject   : OLEVariant;
048
  oEnum         : IEnumvariant;
049
  iValue        : LongWord;
050
  i             : Integer;
051
 
052
  PacketsReceived : Integer;
053
  Minimum         : Integer;
054
  Maximum         : Integer;
055
  Average         : Integer;
056
begin;
057
  PacketsReceived:=0;
058
  Minimum        :=0;
059
  Maximum        :=0;
060
  Average        :=0;
061
  Writeln('');
062
  Writeln(Format('Pinging %s with %d bytes of data:',[Address,BufferSize]));
063
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
064
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
065
  //FWMIService   := FSWbemLocator.ConnectServer('192.168.52.130', 'root\CIMV2', 'user', 'password');
066
  for i := 0 to Retries-1 do
067
  begin
068
    FWbemObjectSet:= FWMIService.ExecQuery(Format('SELECT * FROM Win32_PingStatus where Address=%s AND BufferSize=%d',[QuotedStr(Address),BufferSize]),'WQL',0);
069
    oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
070
    if oEnum.Next(1, FWbemObject, iValue) = 0 then
071
    begin
072
      if FWbemObject.StatusCode=0 then
073
      begin
074
        if FWbemObject.ResponseTime>0 then
075
          Writeln(Format('Reply from %s: bytes=%s time=%sms TTL=%s',[FWbemObject.ProtocolAddress,FWbemObject.ReplySize,FWbemObject.ResponseTime,FWbemObject.TimeToLive]))
076
        else
077
          Writeln(Format('Reply from %s: bytes=%s time=<1ms TTL=%s',[FWbemObject.ProtocolAddress,FWbemObject.ReplySize,FWbemObject.TimeToLive]));
078
 
079
        Inc(PacketsReceived);
080
 
081
        if FWbemObject.ResponseTime>Maximum then
082
        Maximum:=FWbemObject.ResponseTime;
083
 
084
        if Minimum=0 then
085
        Minimum:=Maximum;
086
 
087
        if FWbemObject.ResponseTime<Minimum then
088
        Minimum:=FWbemObject.ResponseTime;
089
 
090
        Average:=Average+FWbemObject.ResponseTime;
091
      end
092
      else
093
      if not VarIsNull(FWbemObject.StatusCode) then
094
        Writeln(Format('Reply from %s: %s',[FWbemObject.ProtocolAddress,GetStatusCodeStr(FWbemObject.StatusCode)]))
095
      else
096
        Writeln(Format('Reply from %s: %s',[Address,'Error processing request']));
097
    end;
098
    FWbemObject:=Unassigned;
099
    FWbemObjectSet:=Unassigned;
100
    //Sleep(500);
101
  end;
102
 
103
  Writeln('');
104
  Writeln(Format('Ping statistics for %s:',[Address]));
105
  Writeln(Format('    Packets: Sent = %d, Received = %d, Lost = %d (%d%% loss),',[Retries,PacketsReceived,Retries-PacketsReceived,Round((Retries-PacketsReceived)*100/Retries)]));
106
  if PacketsReceived>0 then
107
  begin
108
   Writeln('Approximate round trip times in milli-seconds:');
109
   Writeln(Format('    Minimum = %dms, Maximum = %dms, Average = %dms',[Minimum,Maximum,Round(Average/PacketsReceived)]));
110
  end;
111
end;
112
 
113
 
114
begin
115
 try
116
    CoInitialize(nil);
117
    try
118
      //Ping('192.168.52.130',4,32);
119
      Ping('theroadtodelphi.wordpress.com',4,32);
120
    finally
121
      CoUninitialize;
122
    end;
123
 except
124
    on E:Exception do
125
        Writeln(E.Classname, ':', E.Message);
126
 end;
127
 Readln;
128
end.

[pascal07]

j'utilise ICS
Exemple sur mon petit ping rafale, source D2007 dispo
http://www.typonrelais.com/index.php?page=pingrafale
le time out est paramètrable...

Pascal 07

[Invité]

J'avais fait une petite application utilisant ICMP.dll dans le passé, ce bout de code était fonctionnel:

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
 
{Implementing Internet Pings Using Icmp.dll
 
 
Windows supports an Internet Control Message Protocol (ICMP) to determine whether or not a particular host is available. ICMP is a network layer protocol that delivers flow control, error messages, routing, and other data between Internet hosts. ICMP is primarily used by application developers for a network ping.
A ping is the process of sending an echo message to an IP address and reading the reply to verify a connection between TCP/IP hosts.
If you are writing new application will be better to use the Winsock 2 raw sockets support, implemented in Indy, for example.
Please note, however, that for Windows NT and Windows 2000 implementations, Raw Sockets are subject to security checks and are accessible only to members of the administrator's group.
Icmp.dll provides functionality that allows developers to write Internet ping applications on Windows systems without Winsock 2 support.
Note that the Winsock 1.1 WSAStartup function must be called prior to using the functions exposed by ICMP.DLL.
If you do not do this, the first call to IcmpSendEcho will fail with error 10091 (WSASYSNOTREADY).}
Unit UnitPing;
 
Interface
Uses
  Windows, SysUtils, Classes;
 
Type
  TSunB = Packed Record
    s_b1, s_b2, s_b3, s_b4: byte;
  End;
 
  TSunW = Packed Record
    s_w1, s_w2: word;
  End;
 
  PIPAddr = ^TIPAddr;
  TIPAddr = Record
    Case integer Of
      0: (S_un_b: TSunB);
      1: (S_un_w: TSunW);
      2: (S_addr: longword);
  End;
 
  IPAddr = TIPAddr;
 
Function IcmpCreateFile: THandle; stdcall; external 'icmp.dll';
Function IcmpCloseHandle(icmpHandle: THandle): boolean; stdcall; external 'icmp.dll';
Function IcmpSendEcho(IcmpHandle: THandle; DestinationAddress: IPAddr;
  RequestData: Pointer; RequestSize: Smallint;
  RequestOptions: pointer;
  ReplyBuffer: Pointer;
  ReplySize: DWORD;
  Timeout: DWORD): DWORD; stdcall; external 'icmp.dll';
 
 
Function PingAd(InetAddress: String): boolean;
 
Implementation
 
Uses
  WinSock;
 
Function Fetch(Var AInput: String;
               Const ADelim: String = ' ';
               Const ADelete: Boolean = true) : String;
Var
  iPos: Integer;
Begin
  If ADelim = #0 Then
  Begin
    // AnsiPos does not work with #0
    iPos := Pos(ADelim, AInput);
  End
  Else
  Begin
    iPos := Pos(ADelim, AInput);
  End;
  If iPos = 0 Then
  Begin
    Result := AInput;
    If ADelete Then
    Begin
      AInput := '';
    End;
  End
  Else
  Begin
    result := Copy(AInput, 1, iPos - 1);
    If ADelete Then
    Begin
      Delete(AInput, 1, iPos + Length(ADelim) - 1);
    End;
  End;
End;
 
Procedure TranslateStringToTInAddr(AIP: String; Var AInAddr);
Var
  phe: PHostEnt;
  pac: PChar;
  GInitData: TWSAData;
Begin
  WSAStartup($101, GInitData);
  Try
    phe := GetHostByName(PChar(AIP));
    If Assigned(phe) Then
    Begin
      pac := phe^.h_addr_list^;
      If Assigned(pac) Then
      Begin
        With TIPAddr(AInAddr).S_un_b Do
        Begin
          s_b1 := Byte(pac[0]);
          s_b2 := Byte(pac[1]);
          s_b3 := Byte(pac[2]);
          s_b4 := Byte(pac[3]);
        End;
      End
      Else
      Begin
        Raise Exception.Create('Error getting IP from HostName');
      End;
    End
    Else
    Begin
      Raise Exception.Create('Error getting HostName');
    End;
  Except
    FillChar(AInAddr, SizeOf(AInAddr), #0);
  End;
  WSACleanup;
End;
 
Function PingAd(InetAddress: String): boolean;
Var
  Handle: THandle;
  InAddr: IPAddr;
  DW: DWORD;
  rep: Array[1..128] Of byte;
Begin
  result := false;
  Handle := IcmpCreateFile;
  If Handle = INVALID_HANDLE_VALUE Then
    Exit;
  TranslateStringToTInAddr(InetAddress, InAddr);
  DW := IcmpSendEcho(Handle, InAddr, Nil, 0, Nil, @rep, 128, 100);
  Result := (DW <> 0);
  IcmpCloseHandle(Handle);
End;
 
End.

Je pense que j'avais trouvé ce code sur internet, mais je ne me rappelle plus... Il y a pas mal de temps de cela.
Il n'a pas l'air protégé, alors je le met là. Je peux le retirer au besoin.