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
| unit MyHttp_U;
interface
uses
Classes, HttpProt, ExtCtrls;
const
// Nombre maximum de changement d'url par le champs LOCATION
// (Si infini mettre un nombre inferieur a 0)
DEFAULT_RELOCATION = 3;
type
TMyHttp = class(THttpCli)
private { Déclarations privées }
FTrace: TStringList;
FData: TObject;
FRelocation: Integer;
FOnLocationChange: TNotifyEvent;
// FTimeoutTimer : TTimer;
// procedure TimeoutTimerTimer(Sender : TObject);
procedure DoLocationChange(Sender: TObject);
protected { Déclarations protégées }
property FollowRelocation;
public { Déclarations publiques }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published { Déclarations publiées }
property Relocation: Integer read FRelocation write FRelocation default DEFAULT_RELOCATION;
property OnLocationChange: TNotifyEvent read FOnLocationChange write FOnLocationChange;
property Trace: TStringList read FTrace;
property Data: TObject read FData write FData;
end;
implementation
{ TMyHttp }
constructor TMyHttp.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FollowRelocation:=False;
FRelocation:=DEFAULT_RELOCATION;
FTrace:=TStringList.Create;
(*
FTimeoutTimer := TTimer.Create(Self);
FTimeoutTimer.Interval := 30000;
FTimeoutTimer.OnTimer := TimeoutTimerTimer;
*)
inherited OnLocationChange:=DoLocationChange;
end; {* cons .Create *}
destructor TMyHttp.Destroy;
begin
FTrace.Free;
inherited Destroy;
end; {* dest .Destroy *}
(*
procedure TMyHttp.TimeOutTimerTimer(Sender : TObject);
begin
// Ce qu'il faut faire :-)
end;
*)
procedure TMyHttp.DoLocationChange(Sender: TObject);
begin
FTrace.Add(inherited Location);
if (Relocation=0) or (Relocation>0) and (Trace.Count>Relocation) then
Abort;
if Assigned(FOnLocationChange) then
FOnLocationChange(Sender);
end; {* proc .DoLocationChange *}
end. |
Partager