Program testping;
{$MODE DELPHI}
uses
pingsend, sysutils, httpsend, classes, fpjson, jsonparser, fphttpclient;
type
TMyHTTPResult = record
Result: Integer;
Notes: TStringList;
end;
TMyPingResult = record
Result: Boolean;
Attempts: Integer;
Successes: Integer;
Failures: Integer;
Average: Integer;
end;
const
MAX_REDIRECTS = 5;
PING_COUNT = 5;
function CheckHTTPServer(Location: String; Attempts: Integer = 0): Boolean;
var
HTTP: THTTPSend;
S, NewLocation: String;
P: PChar;
Count: Integer;
begin
// Instantiate the HTTP Cleint
HTTP := THTTPSend.Create;
try
if not HTTP.HTTPMethod('GET', Location) then
// There is an error.
Result := False
else
// Check to see if the location has been moved
case (HTTP.ResultCode) of
// HTTP 200 OK
200:
Result := True;
// HTTP 301/302 Moved
301, 302:
begin
// First, see if we've reached the maximum number of redirect attempts
if Attempts >= MAX_REDIRECTS then
Result := false
else
// If not, cycle through each of the headers sent to find where the
// object was moved too
for Count := HTTP.Headers.Count - 1 downto 0 do
begin
{ This is a lot of nonsense to find the correct header.
Essentially, a new pointer is created to the string and then
the "pointer" is examined to see if contains the Location header
}
P := StrAlloc(Length(HTTP.Headers[Count]) + 1);
StrPCopy(P, HTTP.Headers[Count]);
if StrPos(P, 'Location:') <> nil then
begin
S := Trim(HTTP.Headers[Count]);
NewLocation := Copy(S, 10, Length(S));
NewLocation := Trim(NewLocation);
// Recursively try to find the object originally requested
Result := CheckHTTPServer(NewLocation, Attempts + 1);
end;
end;
end;
// I'm not dealing with it...
Otherwise
Result := False;
end;
finally
HTTP.Free;
end;
end;
function CheckPing(Location: String; Attempts: Integer = 5): TMyPingResult;
var
PingClient:TPingSend;
I, Acc: Integer;
MyPingResult: TMyPingResult;
begin
PingClient := TPingSend.Create;
MyPingResult.Result := False;
MyPingResult.Attempts := Attempts;
MyPingResult.Successes := 0;
MyPingResult.Failures := 0;
// set the accumulator
Acc := 0;
try
for I := 1 to Attempts do begin
PingClient.Ping(Location);
if PingClient.PingTime > -1 then
begin
Inc(MyPingResult.Successes);
Acc := Acc + PingClient.PingTime;
MyPingResult.Result := True;
end
else
Inc(MyPingResult.Failures);
// Wait just a tad
Sleep(10);
end;
finally
PingClient.Free;
end;
if MyPingResult.Result then
MyPingResult.Average:= Acc div Attempts;
Result := MyPingResult;
end;
var
PingResult: TMyPingResult;
J: TJSONData;
O, SubObj: TJSONObject;
f: tjsonarray;
json: String;
Parser:TJSONParser;
Arr:TJSONArray;
i: Integer;
Str: STring;
begin
(*
try
// Parse JSON Data to TJSONData
Str := TFPCustomHTTPClient.SimpleGet('****.txt');
Parser := TJSONParser.Create(Str);
Arr := Parser.Parse as TJSONArray;
// We send our JSON data to TJSONData. This is line 1 of our code.
for i := 0 to Arr.Count - 1 do
begin
SubObj := Arr.Objects[i];
WriteLn(i+1, ': ', SubObj.Strings['url'], ', ', SubObj.Strings['http']);
end;
except
on E: Exception do WriteLn('Error finding path!');
end;
(*
WriteLn(J.FindPath('tests').AsString);
*)
WriteLn('Welcome to Pinger!');
PingResult := CheckPing('example.com');
//if PingResult.Result then
//begin
WriteLn('Server responded in ' + IntToStr(PingResult.Average) + 'ms');
WriteLn(IntToStr(PingResult.Successes) + '/' + IntToStr(PingResult.Attempts) + ' ok');
if CheckHTTPServer('obviouslyfakewebsite.faketld') then
WriteLn('HTTP server gave acceptable response')
else
WriteLn('HTTP server appears down.');
//end
//else
// WriteLn('Ping Failure');
ReadLn;
end.