|
unit data;
|
|
interface
|
|
uses
| classes, graphics, msxml2_tlb, SyncObjs;
|
|
type
| PURL = ^TURL;
|
| TURL =
class
|
private
|
{ Private-Deklarationen }
| FURL :
string;
| FStatus :
string;
| FStatus_Text :
string;
| FStatusWWW :
string;
| FStatusWWW_Text :
string;
| FZeit : TDateTime;
| Fnext : PURL;
| Fprev : PURL;
| CriticalSection : TCriticalSection;
|
function ConnectToServer(Request,
URL:
String) :
String;
|
procedure Lock;
|
procedure Unlock;
|
protected
|
function GetURL :
string;
|
function GetStatus :
string;
|
function GetStatus_Text :
string;
|
function GetStatusWWW :
string;
|
function GetStatusWWW_Text :
string;
|
function GetZeitalsString :
string;
|
function GetNext : PURL;
|
function GetPrev : PURL;
|
procedure SetURL (
URL:
string);
|
procedure SetNext (Next: PURL);
|
procedure SetPrev (Prev: PURL);
|
public
|
{ Public-Deklarationen }
|
constructor Create(CriticalSection: TCriticalSection);
|
procedure LoadFromLine(Line:
String);
|
procedure GetStatusHead;
|
procedure SaveXML(Node: IXMLDOMNode);
|
procedure LoadXML(Node: IXMLDOMNode);
|
property URL :
string read GetURL
write SetURL;
|
property Status :
string read GetStatus;
|
property Status_Text :
string read GetStatus_Text;
|
property StatusWWW :
string read GetStatusWWW;
|
property StatusWWW_Text :
string read GetStatusWWW_Text;
|
property Zeit : TDateTime
read FZeit;
|
property ZeitalsString :
String read GetZeitalsString;
|
property Next : PURL
read GetNext
write SetNext;
|
property Prev : PURL
read GetPrev
write SetPrev;
|
end;
|
|
const
| CELEMENT = '
url';
| CURL = '
url';
| CStatus = '
status';
| CStatus_Text = '
statustext';
| CStatusWWW = '
wwwstatus';
| CStatusWWW_Text = '
wwwstatustext';
| CDatum = '
datum';
|
|
implementation
|
|
uses
| constants, IdGlobal, ScktComp, SysUtils, XMLops;
|
|
|
procedure TURL.Lock;
|
begin
| CriticalSection.Acquire;
|
end;
|
|
procedure TURL.Unlock;
|
begin
| CriticalSection.Release;
|
end;
|
|
function TURL.GetURL :
string;
|
begin
| Lock;
| Result := FURL;
| Unlock;
|
end;
|
|
function TURL.GetStatus :
string;
|
begin
| Lock;
| Result := FStatus;
| Unlock;
|
end;
|
|
function TURL.GetStatus_Text :
string;
|
begin
| Lock;
| Result := FStatus_Text;
| Unlock;
|
end;
|
|
function TURL.GetStatusWWW :
string;
|
begin
| Lock;
| Result := FStatusWWW;
| Unlock;
|
end;
|
|
function TURL.GetStatusWWW_Text :
string;
|
begin
| Lock;
| Result := FStatusWWW_Text;
| Unlock;
|
end;
|
|
function TURL.GetZeitalsString :
string;
|
begin
| Lock;
|
if FZeit>0
then
| Result := FormatDateTime('
dd.mm.yyyy hh:nn:ss',FZeit)
|
else
| Result := '
'
|
{end if};
| Unlock;
|
end;
|
|
function TURL.GetNext : PURL;
|
begin
| Lock;
| Result := FNext;
| Unlock;
|
end;
|
|
function TURL.GetPrev : PURL;
|
begin
| Lock;
| Result := FPrev;
| Unlock;
|
end;
|
|
procedure TURL.SetURL (
URL:
string);
|
begin
| Lock;
| FURL :=
URL;
| Unlock;
|
end;
|
|
procedure TURL.SetNext (Next: PURL);
|
begin
| Lock;
| FNext := Next;
| Unlock;
|
end;
|
|
procedure TURL.SetPrev (Prev: PURL);
|
begin
| Lock;
| FPrev := Prev;
| Unlock;
|
end;
|
|
function TURL.ConnectToServer(Request,
URL:
String) :
String;
|
var
| ClientSocket : TClientSocket;
| SockStream: TWinSocketStream;
| Buffer:
Array[0..1024]
of char;
| Ergebnis:
string;
| now:Cardinal;
| FData:
String;
|
begin
| Ergebnis := '
';
| ClientSocket := TClientSocket.Create(
nil);
| ClientSocket.Port := 80;
| ClientSocket.Host :=
URL;
| ClientSocket.ClientType := ctBlocking;
|
try
| ClientSocket.Open;
| SockStream := TWinSocketStream.Create(ClientSocket.Socket,60000);
| SockStream.
Write(Request[1], Length(Request));
|
| now := gettickcount;
|
|
while (SockStream.
Read(Buffer, SizeOf(Buffer)) <> 0)
do
|
begin
| FData := FData + Buffer;
| FillChar(Buffer, SizeOf(Buffer), #0);
|
// Überprüfen, ob TimeOut erreicht oder Socket geschlossen
|
if (gettickcount > now+TIMEOUT)
or not ClientSocket.Active
then
| Exit
|
{end if};
|
end;
|
{end while};
| ClientSocket.Socket.Close;
| SockStream.Free;
|
if Trim(FData)<>'
'
then
|
begin
|
if Pos('
HTTP/1.',FData)>0
then
| Ergebnis := Copy(FData,10,9999)
|
else
| Ergebnis := FData
|
{end if};
| Ergebnis := Copy(Ergebnis,1,Pos(#13,Ergebnis)-1);
|
end
|
else
| Ergebnis := '
ERR ERR HOST NOT FOUND'
|
{end if};
|
except
| Ergebnis := Ergebnis + '
ERR ERR HOST NOT FOUND';
|
end;
| ClientSocket.Active := false;
| ClientSocket.Close;
| ClientSocket.Free;
| Result := Ergebnis;
|
end;
|
|
constructor TURL.Create(CriticalSection: TCriticalSection);
|
begin
|
inherited Create;
| Self.CriticalSection := CriticalSection;
| FURL := '
';
| FStatus := '
';
| FStatus_Text := '
';
| FStatusWWW := '
';
| FStatusWWW_Text := '
';
| Fnext :=
nil;
| Fprev :=
nil;
|
end;
|
|
procedure TURL.LoadFromLine(Line:
String);
|
// Liest die Daten aus der Datei, die vom Unix-Script check.sh angelegt wurde
|
// oder welche nur die Domainnamen enthält
|
var
| Position : integer;
|
begin
| Lock;
| Position := Pos('
: ',Line);
|
if Position<>0
then
|
begin // Daten aus check.sh
| FURL := Copy(Line,1,Position-1);
| FStatus := Copy(Line,Position+3,3);
| FStatus_Text := Copy(Line,Position+7,9999);
|
end
|
else
|
begin // Daten aus Domain-Liste
| FURL := Line;
|
end
|
{end if};
| Unlock;
|
end;
|
|
procedure TURL.GetStatusHead;
|
var
| RequestString:
string;
| Dummy :
string;
|
begin
| RequestString:='
HEAD / HTTP/1.1'#13#10;
| RequestString := RequestString+'
User-Agent: xxx'#13#10;
| RequestString := RequestString+'
Host: www.'+FURL+#13#10;
| RequestString := RequestString+'
Connection: close'#13#10#13#10#13#10;
| Dummy := ConnectToServer(RequestString,'
www.'+FURL);
| Lock;
// Holen und Eintrag in Variable gesplittet, um Lock-Zeit möglichst kurz zu halten
| FStatusWWW := Copy(Dummy,1,3);
| FStatusWWW_Text := Copy(Dummy,5,9999);
| Unlock;
|
| RequestString:='
HEAD / HTTP/1.1'#13#10;
| RequestString := RequestString+'
User-Agent: xxx'#13#10;
| RequestString := RequestString+'
Host: '+FURL+#13#10;
| RequestString := RequestString+'
Connection: close'#13#10#13#10#13#10;
| Dummy := ConnectToServer(RequestString,FURL);
| Lock;
// Holen und Eintrag in Variable gesplittet, um Lock-Zeit möglichst kurz zu halten
| FStatus := Copy(Dummy,1,3);
| FStatus_Text := Copy(Dummy,5,9999);
| FZeit := now;
| Unlock;
|
end;