unit komponenten;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Process;

type
  tBoolOperation = (boNot, boAnd, boOr, boMove, boSet, boClr);
  tBearbeitungsschritt = record
  case was: TBoolOperation of
    boNot,boSet,boClr: (womit: integer);
    boAnd,boOr:        (w1,w2: integer);
    boMove:            (Welches, wohin: integer);
  end;
  tBedingung = array of tBearbeitungsschritt;
  T_pipe = record
            m_read_handle: tHandle;
            m_write_handle: tHandle;
           end;
  tLogEvent = procedure(s: string) of object;

  tAufgabenThread = class(tThread)
  private
    _status:  byte;     // 0 = error; 1 = OK; 2 = disabled/unknown
    _pr:      tProcess;
    _beendet: boolean;
    procedure _statusAenderung;
  public
    statusAenderung: tNotifyEvent;
    beenden:         boolean;
    property status: byte read _status;
    property beendet: boolean read _beendet;
    constructor create;
    destructor destroy; override;
  end;

  tTestAufgabe = class(tComponent)
  private
    _status: Byte; // 0 = error; 1 = OK; 2 = disabled/unknown
    _thread: tAufgabenThread;
    procedure setStatus(b: byte);
    procedure outerLog(s: string);
  public
    bedingung:                   tBedingung;
    fehlerIntervall,okIntervall: Integer;
    fehlerNachricht:             string;
    statusAenderung:             tNotifyEvent;
    log:                         tLogEvent;
    ernst:                       boolean;
    property status: byte
      read _status
      write setStatus;
    function bedingungErfuellt(vorgaben: array of boolean): boolean;
    function aktivieren(vorgaben: array of boolean): boolean;
    function nimmParameter(s: string): boolean; virtual;
    constructor create(aOwner: tComponent); override;
    destructor destroy; override;
  end;

  tTestIpThread = class(tAufgabenThread)
  private
    _werBinIch: string;
    //IPAddress1: TIPAddress;
    procedure setWerBinIch;
  public
    werBinIch: string;
    procedure execute; override;
    constructor create(AOwner: TComponent);
    destructor destroy; override;
  end;

  tTestIp = class(tTestAufgabe)
  private
  public
    werBinIch: string;
    function nimmParameter(s: string): boolean; override;
    constructor create(aOwner: tComponent); override;
    destructor destroy; override;
  end;

(*  tPingThread = class(tAufgabenThread)
  private
  public
    werBinIch: string;
    procedure execute; override;
    constructor create(AOwner: TComponent);
    destructor destroy; override;
  end;

  tTestPing = class (tTestAufgabe)
  private
    procedure OnTimerProcedure(Sender: TObject);
    procedure OnIdIcmpClientReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
  public
    pingsocket: tIdICMPClient;
    wen:        String;
    function nimmParameter(s: String): boolean; override;
    constructor create(AOwner: TComponent); override;
    destructor destroy; override;
  end;

  TTestDnsLookup = class (TTestAufgabe)
                   private
                    DNS_IP,HTTP_IP,
                    host,ipVergleich,
                    klammerAuf,klammerZu,
                    Puffer: string;
                    procedure OnTimerProcedure(Sender: TObject);
                    procedure HTTPdata(Sender: TObject; Buffer: Pointer; Len: Integer);
                    procedure DnsLookupDone(Sender: TObject; Error: Word);
                   public
                    Pingsocket: TPing;
                    HttpClient: THTTPCli;
                    function nimmParameter(s: String): boolean; override;
                    constructor create(AOwner: TComponent); override;
                    destructor destroy; override;
                   end;
  TFtpFileCompare = class(TTestAufgabe)
                    private
                     Vergleich: string;
                     FTPClient1: TFTPClient;
                     refreshVergleich: boolean;
                     procedure OnTimerProcedure(Sender: TObject);
                    public
                     function nimmParameter(s: String): boolean; override;
                     constructor create(AOwner: TComponent); override;
                     destructor destroy; override;
                    end;
  TFtpDate = class(TTestAufgabe)
             private
              dt: longint;
              FTPClient1: TFTPClient;
              procedure OnTimerProcedure(Sender: TObject);
             public
              function nimmParameter(s: String): boolean; override;
              constructor create(AOwner: TComponent); override;
              destructor destroy; override;
             end;
  THttpCompare = class(TTestAufgabe)
                 private
                  Vergleich,buf: string;
                  HTTPClient1: THttpCli;
                  refreshVergleich,holeGerade: boolean;
                  procedure OnTimerProcedure(Sender: TObject);
                  procedure OnDocData(Sender: TObject; Buffer : Pointer; Len: Integer);
                  procedure OnDocEnd(Sender: TObject);
                 public
                  function nimmParameter(s: String): boolean; override;
                  constructor create(AOwner: TComponent); override;
                  destructor destroy; override;
                 end;
  TCheckProcess = class(TTestAufgabe)
                  private
                   exeFileName: string;
                   procedure OnTimerProcedure(Sender: TObject);
                  public
                   function nimmParameter(s: String): boolean; override;
                   constructor create(AOwner: TComponent); override;
                   destructor destroy; override;
                  end; *)

//function loese_logischen_term(S: String): TBedingung;
//function unescape(s: string): string;
//function mystrtotime(s: string): TDatetime;

implementation

(*
// logischer Term **************************************************************

function loese_logischen_term(S: String): TBedingung;
var I:           Integer;
    T:           String;
    Zahlenstack: array of integer;
begin
 T:='';
 setlength(Result,0);
 setlength(Zahlenstack,0);
 For I:=1 to length(S) do
  case S[I] of
   '0'..'9': T:=T+S[I];
   '-':
    begin
     setlength(Result,length(Result)+1);
     Result[length(Result)-1].was:=boNot;
     Result[length(Result)-1].womit:=Zahlenstack[length(Zahlenstack)-1];
     setlength(Zahlenstack,length(Zahlenstack)-1);
    end;
   '&':
    begin
     setlength(Result,length(Result)+1);
     Result[length(Result)-1].was:=boAnd;
     Result[length(Result)-1].w1:=Zahlenstack[length(Zahlenstack)-2];
     Result[length(Result)-1].w2:=Zahlenstack[length(Zahlenstack)-1];
     setlength(Zahlenstack,length(Zahlenstack)-2);
    end;
   '|','#':
    begin
     setlength(Result,length(Result)+1);
     Result[length(Result)-1].was:=boOr;
     Result[length(Result)-1].w1:=Zahlenstack[length(Zahlenstack)-2];
     Result[length(Result)-1].w2:=Zahlenstack[length(Zahlenstack)-1];
     setlength(Zahlenstack,length(Zahlenstack)-2);
    end;
   'c':
    begin
     setlength(Result,length(Result)+1);
     Result[length(Result)-1].was:=boClr;
     Result[length(Result)-1].womit:=Zahlenstack[length(Zahlenstack)-1];
     setlength(Zahlenstack,length(Zahlenstack)-1);
    end;
   's':
    begin
     setlength(Result,length(Result)+1);
     Result[length(Result)-1].was:=boSet;
     Result[length(Result)-1].womit:=Zahlenstack[length(Zahlenstack)-1];
     setlength(Zahlenstack,length(Zahlenstack)-1);
    end;
   '~':
    begin
     setlength(Result,length(Result)+1);
     Result[length(Result)-1].was:=boMove;
     Result[length(Result)-1].welches:=Zahlenstack[length(Zahlenstack)-2];
     Result[length(Result)-1].wohin:=Zahlenstack[length(Zahlenstack)-1];
     setlength(Zahlenstack,length(Zahlenstack)-2);
    end;
   '_':
    begin
     setlength(Zahlenstack,length(Zahlenstack)+1);
     Zahlenstack[length(Zahlenstack)-1]:=strtoint(T);
     T:='';
    end;
  end;
end;

// Hilfskonvertierung **********************************************************

function unescape(s: string): string;
begin
 result:='';
 while pos('#',s)>0 do
  begin
   result:=result+copy(s,1,pos('#',s)-1);
   delete(s,1,pos('#',s));
   try
    result:=result+char(strtoint(copy(s,1,pos('*',s)-1)));
    delete(s,1,pos('*',s));
   except
    result:=result+'#';
   end;
  end;
 result:=result+s;
end;

(*
function istMESZ: boolean;
const TIME_ZONE_ID_UNKNOWN = 0;
      TIME_ZONE_ID_STANDARD = 1;
      TIME_ZONE_ID_DAYLIGHT = 2;
var TZ : TTimeZoneInformation;
begin
 case GetTimeZoneInformation(TZ) of
  TIME_ZONE_ID_STANDARD: result:=false;
  TIME_ZONE_ID_DAYLIGHT: result:=true;
  else result:=false;
 end;
end;
*)

function mystrtotime(s: string): TDatetime;
//const monate: array[1..12] of string = ('Jan','Feb','Mar','Apr','May','Jun',
//                                        'Jul','Aug','Sep','Oct','Nov','Dec');
var //i:           integer;
    y,mo,t,h,mi: word;
begin
 h:=strtoint(copy(s,1,pos(':',s)-1));
 delete(s,1,pos(':',s));
 mi:=strtoint(copy(s,1,pos(' ',s)-1));
 delete(s,1,pos(' ',s));
 t:=strtoint(copy(s,1,pos('.',s)-1));
 delete(s,1,pos('.',s));
 mo:=strtoint(copy(s,1,pos('.',s)-1));
 delete(s,1,pos('.',s));
 y:=strtoint(s);
 result:=EncodeDate(y,mo,t) + EncodeTime(h,mi,0,0);
(* decodeDate(now,y,mo,t);
 mo:=1;
 for i:=1 to 12 do
  if copy(s,1,3)=monate[i] then
   mo:=i;
 delete(s,1,pos(' ',s));
 while s[1]=' ' do delete(s,1,1);
 t:=strtoint(copy(s,1,pos(' ',s)-1));
 delete(s,1,pos(' ',s));
 while s[1]=' ' do delete(s,1,1);
 h:=strtoint(copy(s,1,pos(':',s)-1));
 delete(s,1,pos(':',s));
 mi:=strtoint(s);
 result:= EncodeDate(y,mo,t) + EncodeTime(h,mi,0,0);
 if result>Jetzt then
  result:= EncodeDate(y-1,mo,t) + EncodeTime(h,mi,0,0);
 if istMESZ then result:=result+1/24; *)
end;
*)
// tAufgabenThread *************************************************************

constructor tAufgabenThread.create;
begin
  inherited create(true);
  _status:=2;
  _pr:=tProcess.create(nil);
  _pr.options:=[poUsePipes];
  _beendet:=false;
  statusAenderung:=nil;
  beenden:=false;
end;

destructor tAufgabenThread.destroy;
begin
  _pr.free;
  inherited destroy;
end;

procedure tAufgabenThread._statusAenderung;
begin
  if assigned(statusAenderung) then
    statusAenderung(self);
end;

// tTestAufgabe ****************************************************************

constructor tTestAufgabe.create(aOwner: tComponent);
begin
  inherited create(aOwner);
  _status:=2;
  setlength(bedingung,0);
  fehlerIntervall:=60;
  okIntervall:=60;
  fehlerNachricht:='leer';
  statusAenderung:=nil;
  log:=nil;
  ernst:=true;
end;

destructor tTestAufgabe.destroy;
begin
  _thread.free;
  setlength(bedingung,0);
  inherited destroy;
end;

procedure tTestAufgabe.setStatus(b: byte);
begin
  _status:=b;
  if assigned(statusAenderung) then
    statusAenderung(self);
end;

procedure tTestAufgabe.outerLog(s: string);
begin
  if assigned(log) then begin
    if self is tTestIP then
      s:=s+' (testIP)';
(*    if self is tTestPing then
      s:=s+' (testPing)';
    if self is tTestDnsLookup then
      s:=s+' (testDnsLookup)';
    if self is tFtpFileCompare then
      s:=s+' (ftpFileCompare)';
    if self is tFtpDate then
      s:=s+' (ftpDate)';
    if self is tHttpCompare then
      s:=s+' (httpCompare)'; *)
    log(datetimetostr(now)+': '+s);
  end;
end;

function tTestAufgabe.bedingungErfuellt(vorgaben: array of boolean): boolean;
var
  reg: array of boolean;
  i:   integer;
begin
  setlength(reg,length(vorgaben));
  for i:=0 to length(vorgaben)-1 do
    reg[i]:=vorgaben[i];
  for i:=0 to length(Bedingung)-1 do
    case Bedingung[i].was of
      boNot:
        reg[bedingung[i].womit]:=not reg[bedingung[i].womit];
      boSet: begin
        if bedingung[i].womit>=length(reg) then
          setlength(reg,bedingung[i].womit+1);
        reg[bedingung[i].womit]:=true;
      end;
      boClr: begin
        if bedingung[i].womit>=length(reg) then
          setlength(reg,bedingung[i].womit+1);
        reg[bedingung[i].womit]:=false;
      end;
      boAnd:
        reg[bedingung[i].w1]:=reg[bedingung[i].w1] and reg[bedingung[i].w2];
      boOr:
        reg[bedingung[i].w1]:=reg[bedingung[i].w1] or reg[bedingung[i].w2];
      boMove: begin
        if bedingung[i].wohin>=length(reg) then
          setlength(reg,bedingung[i].wohin+1);
        reg[bedingung[i].wohin]:=reg[bedingung[i].welches];
      end;
    end{of Case};
  result:=reg[0];
end;

function tTestAufgabe.aktivieren(vorgaben: array of boolean): boolean;
var
  tmp: boolean;
begin
  tmp:=Bedingung_erfuellt(Vorgaben);
  result:=tmp xor Zeitwarter.enabled;
  if result then begin
    if tmp then Zeitwarter.Interval:=1000;
    Zeitwarter.enabled:=tmp;
  end;
end;

function tTestAufgabe.nimmParameter(s: string): boolean; virtual;
begin
  result:=true;
end;

(*
// TTestPing *******************************************************************

procedure TTestPing.OnTimerProcedure(Sender: TObject);
begin
 try
  Pingsocket.Host:=wen;
  Pingsocket.ReceiveTimeout:=5000;
  Pingsocket.Ping;
 except
  Log('Ich bin aus dem try-except geflogen!');
  Status:=0;
 end;
end;

procedure TTestPing.OnIdIcmpClientReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
begin
 status:=
   byte(AReplyStatus.ReplyStatusType = rsEcho);
end;

constructor TTestPing.create(AOwner: TComponent);
begin
 inherited create(AOwner);
 PingSocket:=TIdIcmpClient.create(self);
 PingSocket.OnReply:=OnIdIcmpClientReply;
 InnerTimerProcedure:=OnTimerProcedure;
 Zeitwarter.Enabled:=false;
end;

destructor TTestPing.destroy;
begin
 PingSocket.destroy;
 inherited destroy;
end;

function TTestping.nimmParameter(s: String): boolean;
begin
 wen:=unescape(s);
 PingSocket.Host:=wen;
 result:=true;
end;

// TTestIP *********************************************************************

procedure TTestIP.OnTimerProcedure(Sender: TObject);
begin
 try
  IPChecker.Resume;
  if IPChecker.Returnvalue = 0 then
   Status:=Byte(IPChecker.WerBinIch = WerBinIch);
 except
  Log('Ich bin aus dem try-except geflogen!');
  Status:=0;
 end;
end;

constructor TTestIP.create(AOwner: TComponent);
begin
 inherited create(AOwner);
 InnerTimerProcedure:=OnTimerProcedure;
 IPChecker:=TIPCheckThread.Create(AOwner);
end;

destructor TTestIP.destroy;
begin
 IPChecker.Destroy;
 inherited destroy;
end;

function TTestIP.nimmParameter(s: String): boolean;
begin
 werBinIch:=unescape(s);
 result:=true;
end;

// TIPCheckThread **************************************************************

constructor TIPCheckThread.Create(AOwner: TComponent);
begin
 inherited Create(true);
 IPAddress1:=TIPAddress.Create(AOwner);
 Werbinich:='';
 Werbinich_:='';
 FreeOnTerminate:= false;
 Returnvalue:=1;
end;

destructor TIPCheckThread.destroy;
begin
 IPAddress1.destroy;
 inherited destroy;
end;

procedure TIPCheckThread.setWerBinIch;
begin
 werBinIch:=werBinIch_;
end;

procedure TIPCheckThread.execute;
begin
 werbinich_:='';
 Synchronize(setWerBinIch);
 werbinich_:=IPAddress1.GetIpAddress;
 Synchronize(setWerBinIch);
 Returnvalue:=0;
end;

// TTestDNSLookup **************************************************************

constructor TTestDNSLookup.create(AOwner: TComponent);
begin
 inherited create(AOwner);
 Pingsocket:=TPing.Create(AOwner);
 HttpClient:=THTTPCli.Create(AOwner);
 HttpClient.OnDocData:=HTTPdata;
 Pingsocket.OnDnsLookupDone:=DnsLookupDone;
 InnerTimerProcedure:=OnTimerProcedure;
 Puffer:='';
end;

destructor TTestDNSLookup.destroy;
begin
 Pingsocket.destroy;
 HttpCLient.destroy;
 inherited destroy;
end;

procedure TTestDNSLookup.OnTimerProcedure(Sender: TObject);
begin
 try
  DNS_IP:='';
  HTTP_IP:='';
  PingSocket.DnsLookup(host);
  HttpClient.URL:=ipVergleich;
  HttpClient.Get;
 except
  Log('Ich bin aus dem try-except geflogen!');
  Status:=0;
 end;
end;

procedure TTestDNSLookup.DnsLookupDone(Sender: TObject; Error: Word);
begin
 if Error<>0 then
  begin
   Log('DnsLookupDone liefert Fehler '+inttostr(Error)+'!=0');
   Status:=0;
   exit;
  end;
 DNS_IP:= PingSocket.DnsResult;
 if (HTTP_IP<>'') then
  Status:=Byte(HTTP_IP=DNS_IP);
end;

function TTestDNSLookup.nimmParameter(s: String): boolean;
begin
 Result:=false;
 if (length(S)=0) or (S[1]<>'"') then exit;
 delete(S,1,1);
 if pos('"',S)=0 then exit;
 host:=unescape(copy(S,1,pos('"',S)-1));
 delete(S,1,pos('"',S));
 if pos('"',S)=0 then exit;
 delete(S,1,pos('"',S));
 if pos('"',S)=0 then exit;
 ipVergleich:=unescape(copy(S,1,pos('"',S)-1));
 delete(S,1,pos('"',S));
 if pos('"',S)=0 then exit;
 delete(S,1,pos('"',S));
 if pos('"',S)=0 then exit;
 klammerAuf:=unescape(uppercase(copy(S,1,pos('"',S)-1)));
 delete(S,1,pos('"',S));
 if pos('"',S)=0 then exit;
 delete(S,1,pos('"',S));
 if pos('"',S)=0 then exit;
 klammerZu:=unescape(uppercase(copy(S,1,pos('"',S)-1)));
 delete(S,1,pos('"',S));
 if length(S)>0 then exit;
 Result:=true;
end;

procedure TTestDNSLookup.HTTPdata(Sender: TObject; Buffer: Pointer; Len: Integer);
var S:   String;
    I,J: Integer;
begin
 Setlength(S,Len);
 Move(Buffer^,S[1],Len);
 S:=uppercase(S);
 Puffer:=Puffer+S;
 if pos(klammerAuf,Puffer)=0 then exit;
 while pos(klammerAuf,Puffer)<>0 do
  delete(Puffer,1,pos(klammerAuf,Puffer)+length(klammerAuf)-1);
 if pos(klammerZu,Puffer)=0 then
  begin
   Puffer:=klammerAuf+Puffer;
   exit;
  end;
 delete(Puffer,pos(KlammerZu,Puffer),length(Puffer)-pos(KlammerZu,Puffer)+1);
 J:=0;
 For I:=length(Puffer) downto 1 do
  case J of
   0..2,4..6,8..10,12..14:
    case Puffer[I] of
     '0'..'9': inc(J);
     '.': J:=(J div 4 +1) *4;
     else J:=-1;
    end{of Case};
   3,7,11:
    if Puffer[I] ='.' then inc(J)
                      else J:=-1;
  end{of Case};
 if J in [13..16] then HTTP_IP:=Puffer
  else
   begin
    Log('Ich finde die IP-Adresse nicht im HTML-Dokument!');
    Status:=0;
    exit;
   end;
 Puffer:='';
 if (DNS_IP<>'') then
  Status:=Byte(HTTP_IP=DNS_IP);
end;

// TFtpFileCompare *************************************************************

procedure TFtpFileCompare.OnTimerProcedure(Sender: TObject);
var s,User,Pass,Host,HostDir,HostFile:  string;
    i,j:                                integer;
    f1,f2:                              file;
    a1,a2:                              array of byte;
    AOwner:                             tComponent;
const Zeichen = '1234567890qwertzuiopasdfghjklyxcvbnm';
begin
 j:=0;
 s:='';
 repeat
  if s<>'' then sleep(100);
  s:=extractfilepath(Paramstr(0));
  s:=s+'download';
  s:=s+floattostr(now);
  for i:=1 to 10 do
   s:=s + Zeichen[1+random(length(Zeichen))];
  s:=s+'.txt';
  inc(j);
 until (not fileexists(s)) or (j>10000);
 FTPClient1.LocalFileName:=s;
 try
  FTPClient1.Receive;
  if not fileexists(s) then begin
    Log('Datei wurde beim Herunterladen nicht auf der Festplatte erzeugt!');
    status:=0;
    AOwner:=FTPClient1.Owner;
    User:=FTPCLient1.Username;
    Pass:=FTPCLient1.Password;
    Host:=FTPCLient1.HostName;
    HostDir:=FTPCLient1.HostDirName;
    HostFile:=FTPCLient1.HostFileName;
    FTPClient1.Free;
    FTPClient1:=tFTPClient.create(AOwner);
    FTPCLient1.Username:=User;
    FTPCLient1.Password:=Pass;
    FTPCLient1.HostName:=Host;
    FTPCLient1.HostDirName:=HostDir;
    FTPCLient1.HostFileName:=HostFile;
    exit;
  end;
  assignfile(f1,s);
  assignfile(f2,vergleich);
  reset(f1,1);
  reset(f2,1);
  setlength(a1,filesize(f1));
  setlength(a2,filesize(f2));
  blockread(f1,a1[0],length(a1));
  blockread(f2,a2[0],length(a2));
  closefile(f1);
  closefile(f2);
 except
  Log('Ich bin aus dem try-except geflogen!');
  deletefile(pchar(s));
  status:=0;
  exit;
 end;
 j:=0;
 if length(a1)=length(a2) then
  begin
   j:=1;
   for i:=0 to length(a1)-1 do
    if a1[i]<>a2[i] then
     j:=0;
  end;
 if refreshVergleich then
  begin
   refreshVergleich:=false;
   reset(f1,1);
   rewrite(f2,1);
   setlength(a1,filesize(f1));
   blockread(f1,a1[0],length(a1));
   blockwrite(f2,a1[0],length(a1));
   closefile(f1);
   closefile(f2);
  end;
 deletefile(pchar(s));
 status:=j;
end;

function TFtpFileCompare.nimmParameter(s: String): boolean;
var Vergl,User,Pass,Host,HostDir,HostFile: String;
begin
 if (length(s)>0) and (s[1]='*') then
  begin
   delete(s,1,1);
   refreshVergleich:=true;
  end;
 if pos('/',s)=0 then
  begin
   result:=false;
   exit;
  end;
 Vergl:=copy(s,1,pos('/',s)-1);
 delete(s,1,pos('/',s));
 if pos(':',s)=0 then
  begin
   result:=false;
   exit;
  end;
 user:=copy(s,1,pos(':',s)-1);
 delete(s,1,pos(':',s));
 if pos('@',s)=0 then
  begin
   result:=false;
   exit;
  end;
 pass:=copy(s,1,pos('@',s)-1);
 delete(s,1,pos('@',s));
 if pos('/',s)=0 then
  begin
   result:=false;
   exit;
  end;
 Host:=copy(s,1,pos('/',s)-1);
 delete(s,1,pos('/',s));
 HostDir:='/';
 while pos('/',s)>0 do
  begin
   HostDir:=HostDir+copy(s,1,pos('/',s));
   delete(s,1,pos('/',s));
  end;
 HostFile:=s;

 Vergleich:=Vergl;
 FTPCLient1.Username:=User;
 FTPCLient1.Password:=Pass;
 FTPCLient1.HostName:=Host;
 FTPCLient1.HostDirName:=HostDir;
 FTPCLient1.HostFileName:=HostFile;
 Result:=true;
end;

constructor TFtpFileCompare.create(AOwner: TComponent);
var SR:  TSearchRec;
    err: integer;
begin
 inherited create(AOwner);
 err:=Sysutils.Findfirst(extractfilepath(Paramstr(0))+'download*.txt',$00,SR);
 while err=0 do
  begin
//   Form1.Memo2.Lines.add(extractfilepath(Paramstr(0))+SR.Name);
   if fileexists(extractfilepath(Paramstr(0))+SR.Name) then
    deletefile(PChar(extractfilepath(Paramstr(0))+SR.Name));
   err:=Sysutils.Findnext(SR);
  end;
 Sysutils.Findclose(SR);
 FTPCLient1:=TFTPCLient.Create(AOwner);
 InnerTimerProcedure:=OnTimerProcedure;
 refreshVergleich:=false;
end;

destructor TFtpFileCompare.destroy;
begin
 FTPClient1.Free;
 inherited destroy;
end;

// TFtpDate ********************************************************************

procedure TFtpDate.OnTimerProcedure(Sender: TObject);
var s,t:   string;
    i,j:   integer;
    z:     extended;
    f:     textfile;
const Zeichen = '1234567890qwertzuiopasdfghjklyxcvbnm';
begin
 j:=0;
 s:='';
 repeat
  if s<>'' then sleep(100);
  s:=extractfilepath(Paramstr(0));
  s:=s+'download';
  s:=s+floattostr(now);
  for i:=1 to 10 do
   s:=s + Zeichen[1+random(length(Zeichen))];
  s:=s+'.txt';
  inc(j);
 until (not fileexists(s)) or (j>10000);
 FTPClient1.LocalFileName:=s;
 try
  FTPClient1.Receive;
  assignfile(f,s);
  reset(f);
  readln(f,t);
  closefile(f);
 except
  Log('Ich bin aus dem try-except geflogen (beim Runterladen und Anschauen)!');
  deletefile(pchar(s));
  status:=0;
  exit;
 end;
 deletefile(pchar(s));

 try
  z:=mystrtotime(t);
 except
  Log('Ich bin aus dem try-except geflogen (bei der Zeitumwandlung)!');
  status:=0;
  exit;
 end;
 status:=byte(abs(now-z)*60*60*24<=dt);
end;

function TFtpDate.nimmParameter(s: String): boolean;
var User,Pass,Host,HostDir,HostFile: String;
begin
 if pos('/',s)=0 then
  begin
   result:=false;
   exit;
  end;
 dt:=strtoint(copy(s,1,pos('/',s)-1));
 delete(s,1,pos('/',s));
 if pos(':',s)=0 then
  begin
   result:=false;
   exit;
  end;
 user:=copy(s,1,pos(':',s)-1);
 delete(s,1,pos(':',s));
 if pos('@',s)=0 then
  begin
   result:=false;
   exit;
  end;
 pass:=copy(s,1,pos('@',s)-1);
 delete(s,1,pos('@',s));
 if pos('/',s)=0 then
  begin
   result:=false;
   exit;
  end;
 Host:=copy(s,1,pos('/',s)-1);
 delete(s,1,pos('/',s));
 HostDir:='/';
 while pos('/',s)>0 do
  begin
   HostDir:=HostDir+copy(s,1,pos('/',s));
   delete(s,1,pos('/',s));
  end;
 HostFile:=s;

 FTPCLient1.Username:=User;
 FTPCLient1.Password:=Pass;
 FTPCLient1.HostName:=Host;
 FTPCLient1.HostDirName:=HostDir;
 FTPCLient1.HostFileName:=HostFile;
 Result:=true;
end;

constructor TFtpDate.create(AOwner: TComponent);
var SR:  TSearchRec;
    err: integer;
begin
 inherited create(AOwner);
 err:=Sysutils.Findfirst(extractfilepath(Paramstr(0))+'download*.txt',$00,SR);
 while err=0 do
  begin
//   Form1.Memo2.Lines.add(extractfilepath(Paramstr(0))+SR.Name);
   if fileexists(extractfilepath(Paramstr(0))+SR.Name) then
    deletefile(PChar(extractfilepath(Paramstr(0))+SR.Name));
   err:=Sysutils.Findnext(SR);
  end;
 Sysutils.Findclose(SR);
 FTPCLient1:=TFTPCLient.Create(AOwner);
 InnerTimerProcedure:=OnTimerProcedure;
end;

destructor TFtpDate.destroy;
begin
 FTPClient1.Free;
 inherited destroy;
end;

// THttpCompare *************************************************************

procedure THttpCompare.OnTimerProcedure(Sender: TObject);
begin
 if holeGerade then exit;
 buf:='';
 holeGerade:=true;
 HTTPClient1.GetASync;
end;

procedure THttpCompare.OnDocData(Sender: TObject; Buffer: Pointer; Len: Integer);
begin
 setlength(buf,length(buf)+Len);
 move(Buffer^,buf[length(buf)-Len+1],Len);
end;

procedure THttpCompare.OnDocEnd(Sender: TObject);
var f: file;
    s: string;
begin
 assignfile(f,vergleich);

 if refreshVergleich then begin
   rewrite(f,1);
   blockwrite(f,buf[1],length(buf));
   closefile(f);
 end;

 if not fileexists(vergleich) then begin
   status:=1;
   buf:='';
   exit;
 end;

 reset(f,1);
 setlength(s,filesize(f));
 blockread(f,s[1],filesize(f));
 closefile(f);

 status:=byte(buf=s);

 buf:='';
 holeGerade:=false;
end;

function THttpCompare.nimmParameter(s: String): boolean;
var Vergl: String;
begin
 if (length(s)>0) and (s[1]='*') then
  begin
   delete(s,1,1);
   refreshVergleich:=true;
  end;
 if pos(':',s)=0 then
  begin
   result:=false;
   exit;
  end;
 Vergl:=copy(s,1,pos(':',s)-1);
 delete(s,1,pos(':',s));

 Vergleich:=Vergl;
 HTTPClient1.URL:=s;
 Result:=true;
end;

constructor THttpCompare.create(AOwner: TComponent);
begin
 inherited create(AOwner);
 HTTPClient1:=THTTPCli.Create(AOwner);
 HTTPClient1.OnDocData:=OnDocData;
 HTTPClient1.OnDocEnd:=OnDocEnd;
 InnerTimerProcedure:=OnTimerProcedure;
 refreshVergleich:=false;
 buf:='';
 holeGerade:=false;
end;

destructor THttpCompare.destroy;
begin
 buf:='';
 HTTPClient1.Free;
 inherited destroy;
end;

// TCheckProcess ***************************************************************

procedure TCheckProcess.OnTimerProcedure(Sender: TObject);
var ContinueLoop,laeuft: boolean;
    FSnapshotHandle:     THandle;
    FProcessEntry32:     TProcessEntry32;
begin
 FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 FProcessEntry32.dwSize:= SizeOf(FProcessEntry32);
 ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
 laeuft:=false;
 while Integer(ContinueLoop) <> 0 do begin
   if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or
       (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then begin
     laeuft:=true;
   end;
   ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
 end;
 CloseHandle(FSnapshotHandle);
 status:=byte(laeuft);
end;

function TCheckProcess.nimmParameter(s: String): boolean;
begin
 exeFileName:=s;
 Result:=true;
end;

constructor TCheckProcess.create(AOwner: TComponent);
begin
 inherited create(AOwner);
 InnerTimerProcedure:=OnTimerProcedure;
 exeFileName:='';
end;

destructor TCheckProcess.destroy;
begin
 exeFileName:='';
 inherited destroy;
end;
*)

end.