Archive

Archive for March, 2014

Multi thread Ping in Free Pascal

Am arătat în articolul precedent cum se poate utiliza WMI pentru testarea disponibilității unui device dintr-o rețea. În articolul curent prezint codul sursă a unei aplicații ce permite lansarea de comenzi ping către diferite IP-uri prin multi thread-uri.

program project1;
{$mode objfpc}{$H+}
uses Classes, SysUtils, CustApp, Windows, ActiveX, ComObj, GetOpts;
Type TPingThread = Class(TThread)
 Computer: String;
 Procedure Execute; Override;
 End;
Const Buffer: Integer= 32;
 Timeout: Integer= 100;
 Retries: Integer= 4;
 MaxThreads: Integer= 30;
Var c: Char;
 OptionIndex: Longint;
 TheOpts: Array[1..5] Of TOption;
 i, ActiveThreads, IpOffline, IpOnLine: Integer;
 IpList: TStringList;
 t: TPingThread;
 Start: Variant;
Function WmiPing(Const Address: String; Const BufferSize, Timeout: Word): Integer;
Const WmiUser = '';
 WmiPassword = '';
 WmiComputer = 'localhost';
 WmiFlagForwardOnly = $00000020;
Var WmiLocator : OLEVariant;
 WmiService : OLEVariant;
 WmiObjectSet: OLEVariant;
 WmiObject : Variant;
 oEnum : ActiveX.IEnumvariant;
 WmiQuery : String[250];
begin
 Result:= -1;
 CoInitialize(Nil);
 Try
 WmiLocator := ComObj.CreateOleObject('WbemScripting.SWbemLocator');
 WmiService := WmiLocator.ConnectServer(WmiComputer, 'root\CIMV2', WmiUser, WmiPassword);
 WmiQuery := Format('Select * From Win32_PingStatus '+
 'Where Address=%s And BufferSize=%d And TimeOut=%d',
 [QuotedStr(Address), BufferSize, Timeout]);
 WmiObjectSet:= WmiService.ExecQuery(WmiQuery, 'WQL', WmiFlagForwardOnly);
 oEnum := IUnknown(WmiObjectSet._NewEnum) As IEnumVariant;
 While oEnum.Next(1, WmiObject, Nil) = 0 Do
 Begin
 Result:= LongInt(WmiObject.Properties_.Item('StatusCode').Value);
 WmiObject:= Unassigned;
 End;
 Finally
 CoUninitialize;
 End;
end;
Procedure TPingThread.Execute;
Var i, k: Integer;
begin
 k:= 0;
 For i:= 1 To Retries Do
 If WmiPing(Computer, Buffer, Timeout)= 0 Then
 Inc(k);
If k= 0 Then
 Inc(IpOffLine)
 Else
 Inc(IpOnLine);
Writeln(Computer, ';', k, ';', Retries);
 Dec(ActiveThreads);
End;
begin
 Start:= GetTickCount;
 IpList:= TStringList.Create;
With TheOpts[1] Do
 Begin
 Name:= 'ipfile';
 Has_Arg:= 1;
 Flag:= Nil;
 Value:= #0;
 End;
 With TheOpts[2] Do
 Begin
 Name:= 'buffer';
 Has_Arg:= 1;
 Flag:= Nil;
 Value:= #0;
 End;
 With TheOpts[3] Do
 Begin
 Name:= 'timeout';
 Has_Arg:= 1;
 Flag:= Nil;
 Value:= #0;
 End;
 With TheOpts[4] Do
 Begin
 Name:= 'retries';
 Has_Arg:= 1;
 Flag:= Nil;
 Value:= #0;
 End;
 With TheOpts[5] Do
 Begin
 Name:= 'maxthreads';
 Has_Arg:= 1;
 Flag:= Nil;
 Value:= #0;
 End;
c:= #0;
 Repeat
 c:= GetLongopts(':i:b:t:r:m:', @TheOpts[1], OptionIndex);
 Case c Of
 'i': If FileExists(OptArg) Then
 Begin
 IpList.LoadFromFile(OptArg);
 If IpList.Count= 0 Then
 Begin
 Writeln('Empty IP File: ', OptArg);
 Exit;
 End;
 End
 Else
 Begin
 Writeln('IP File not found: ', OptArg);
 Exit;
 End;
'b': Begin
 Buffer:= StrToInt(OptArg);
 If (Buffer< 0) Or (Buffer> 65500) Then
 Begin
 Writeln('Ping Buffer ', OptArg, ' out of limit 0..65500');
 Exit;
 End;
 End;
 't': Begin
 Timeout:= StrToInt(OptArg);
 If (Timeout< 10) Or (Timeout> 10000) Then
 Begin
 Writeln('Ping Timeout ', OptArg, ' out of limit 10..10000');
 Exit;
 End;
 End;
 'r': Begin
 Retries:= StrToInt(OptArg);
 If (Retries< 1) Or (Retries> 10) Then
 Begin
 Writeln('Ping Retries ', OptArg, ' out of limit 1..10');
 Exit;
 End;
 End;
 'm': Begin
 MaxThreads:= StrToInt(OptArg);
 If (MaxThreads< 1) Or (MaxThreads> 500) Then
 Begin
 Writeln('Max Threads ', OptArg, ' out of limit 1..500');
 Exit;
 End;
 End;
 End; { case }
 Until c= EndOfOptions;
ActiveThreads:= 0;
 IpOffline:= 0;
 IpOnLine:= 0;
 i:= 0;
 Writeln('Computer;Success;Total');
 While i< IpList.Count Do
 Begin
 If ActiveThreads< MaxThreads Then
 Begin
 t:= TPingThread.Create(True);
 Inc(ActiveThreads);
 Inc(i);
 t.Computer:= IpList[i- 1];
 t.FreeOnTerminate:= True;
 t.Start;
 End;
 End;
While ActiveThreads> 0 Do ;
WriteLn;
 WriteLn('Ip Count= ', IpList.Count);
 WriteLn('Ip Online= ', IpOnLine);
 WriteLn('Ip Offline= ', IpOffline);
 WriteLn('Buffer= ', Buffer);
 WriteLn('Timeout= ', Timeout, ' ms');
 WriteLn('Retries= ', Retries);
 WriteLn('Max Threads= ', MaxThreads);
 WriteLn('Elapsed Time= ', (GetTickCount- Start)/ 1000, 's');
IpList.Free;
end.

Pentru a-l putea folosi descărcați ultima versiune de Lazarus IDE. Eu am compilat programul cu v1.2.0 pe 64 biți. După compilare, din linia de comandă se utilizează astfel:

Pinguin64.exe -i "IP LIST.txt" -b 32 -t 100 -r 4 -m 500 > "IP RESULT.TXT"

unde “IP LIST.txt” este un fișierul care conține lista de IP-uri țintă, iar “IP RESULT.TXT” este fișierul în care vor fi vărsate rezultatele. Parametrii  -b 32 arată faptul că se trimit 32 biți prin ping, -t 100 reprezintă timeout-ul ping-ului în milisecunde, -r 4 reprezintă numărul de încercări succesive efectuate către fiecare IP în parte, iar -m 500 numărul de thread-uri utilizate. Atenție: un număr prea mare de thread-uri se poate să nu poată fi încărcat în memoria computerului dvs!

 

sdfsdfsd

Advertisements
Categories: IT, Programe

WMI Ping in Free Pascal

Ping reprezintă un instrument de rețea ce trimite unui device dintr-o rețea pachete de date, așteptând un răspuns de tip ecou de la acesta.

WMI (Instrumentaţie de Management Windows) este o componentă a sistemului de operare Microsoft Windows şi este implementarea Microsoft WBEM (Web-Based Enterprise Management). WMI poate fi utilizat pentru a automatiza activităţile administrative. WMI se poate utiliza în limbaje de scriptare care au un motor pentru Windows şi care gestionează obiecte ActiveX Microsoft.

Free Pascal este un compilator Pascal pe 32 și 64 biți disponibil pe diverse sisteme de operare. Sintaxa limbajului este compatibilă cu Turbo Pascal și Delphi. Pachetul este disponibil sub o licență GNU modificată.

Am realizat o funcție pentru Free Pascal ce utilizează WMI pentru a testa accesibilitatea unui device din rețea:

Function WmiPing(Const Address: String; Const BufferSize, Timeout: Word): Integer;
 Const WmiUser = '';
 WmiPassword = '';
 WmiComputer = 'localhost';
 WmiFlagForwardOnly = $00000020;
 Var WmiLocator: OLEVariant;
 WmiService : OLEVariant;
 WmiObjectSet : OLEVariant;
 WmiObject : Variant;
 oEnum : ActiveX.IEnumvariant;
 WmiQuery : String[250];
 begin
 Result:= -1;
 CoInitialize(Nil);
 Try
 WmiLocator := ComObj.CreateOleObject('WbemScripting.SWbemLocator');
 WmiService := WmiLocator.ConnectServer(WmiComputer, 'root\CIMV2', WmiUser, WmiPassword);
 WmiQuery := Format('Select * From Win32_PingStatus Where Address=%s And BufferSize=%d And TimeOut=%d', [QuotedStr(Address), BufferSize, Timeout]);
 WmiObjectSet:= WmiService.ExecQuery(WmiQuery, 'WQL', WmiFlagForwardOnly);
 oEnum := IUnknown(WmiObjectSet._NewEnum) As IEnumVariant;
 While oEnum.Next(1, WmiObject, Nil) = 0 Do
 Begin
 Result:= LongInt(WmiObject.Properties_.Item('StatusCode').Value);
 WmiObject:= Unassigned;
 End;
 Finally
 CoUninitialize;
 End;
 end;


Categories: IT, Programe