{ $Project$ $Workfile$ $Revision$ $DateUTC$ $Id$ This file is part of the Indy (Internet Direct) project, and is offered under the dual-licensing agreement described on the Indy website. (http://www.indyproject.org/) Copyright: (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. } { $Log$ } { Rev 1.4 1/17/2005 7:26:12 PM JPMugaas Moved stack management code to IdStack. Rev 1.3 2004.06.06 5:18:14 PM czhower OnWork bug fix Rev 1.2 2004.06.05 9:46:38 AM czhower IOHandler OnWork fix Rev 1.1 2004.02.03 3:15:52 PM czhower Updates to move to System. Rev 1.0 2004.02.03 2:28:28 PM czhower Move Rev 1.7 2004.01.22 5:59:10 PM czhower IdCriticalSection Rev 1.6 2004.01.20 10:03:24 PM czhower InitComponent Rev 1.5 2003.10.14 1:26:42 PM czhower Uupdates + Intercept support Rev 1.4 2003.10.01 9:11:16 PM czhower .Net Rev 1.3 2003.10.01 11:16:30 AM czhower .Net Rev 1.2 2003.09.30 1:22:54 PM czhower Stack split for DotNet Rev 1.1 2003.09.18 5:17:58 PM czhower Implemented OnWork Rev 1.0 11/13/2002 08:41:12 AM JPMugaas } unit IdComponent; interface {$i IdCompilerDefines.inc} uses {$IFNDEF USE_OBJECT_ARC} Classes, {$ENDIF} IdBaseComponent, IdGlobal, IdResourceStrings, IdStack; type TIdStatus = ( hsResolving, hsConnecting, hsConnected, hsDisconnecting, hsDisconnected, hsStatusText, ftpTransfer, // These are to eliminate the TIdFTPStatus and the ftpReady, // coresponding event ftpAborted); // These can be use din the other protocols to. const IdStati: array[TIdStatus] of string = ( RSStatusResolving, RSStatusConnecting, RSStatusConnected, RSStatusDisconnecting, RSStatusDisconnected, RSStatusText, RSStatusText, RSStatusText, RSStatusText); type TIdStatusEvent = procedure(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string) of object; TWorkMode = (wmRead, wmWrite); TWorkInfo = record Current: Int64; Max: Int64; Level: Integer; end; TWorkBeginEvent = procedure(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64) of object; TWorkEndEvent = procedure(ASender: TObject; AWorkMode: TWorkMode) of object; TWorkEvent = procedure(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64) of object; TIdComponent = class(TIdBaseComponent) protected FOnStatus: TIdStatusEvent; FOnWork: TWorkEvent; FOnWorkBegin: TWorkBeginEvent; FOnWorkEnd: TWorkEndEvent; FWorkInfos: array[TWorkMode] of TWorkInfo; {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FWorkTarget: TIdComponent; // procedure DoStatus(AStatus: TIdStatus); overload; procedure DoStatus(AStatus: TIdStatus; const AArgs: array of const); overload; procedure InitComponent; override; {$IFNDEF USE_OBJECT_ARC} procedure Notification(AComponent: TComponent; Operation: TOperation); override; {$ENDIF} procedure SetWorkTarget(AValue: TIdComponent); // property OnWork: TWorkEvent read FOnWork write FOnWork; property OnWorkBegin: TWorkBeginEvent read FOnWorkBegin write FOnWorkBegin; property OnWorkEnd: TWorkEndEvent read FOnWorkEnd write FOnWorkEnd; public procedure BeginWork(AWorkMode: TWorkMode; const ASize: Int64 = 0); virtual; destructor Destroy; override; procedure DoWork(AWorkMode: TWorkMode; const ACount: Int64); virtual; procedure EndWork(AWorkMode: TWorkMode); virtual; // property WorkTarget: TIdComponent read FWorkTarget write SetWorkTarget; published property OnStatus: TIdStatusEvent read FOnStatus write FOnStatus; end; implementation { TIdComponent } destructor TIdComponent.Destroy; begin inherited Destroy; // After inherited - do at last possible moment TIdStack.DecUsage; end; procedure TIdComponent.DoStatus(AStatus: TIdStatus); begin DoStatus(AStatus, []); end; procedure TIdComponent.DoStatus(AStatus: TIdStatus; const AArgs: array of const); begin // We do it this way because Format() can sometimes cause an AV if the // variable array is blank and there is something like a %s or %d. This // is why there was sometimes an AV in TIdFTP if Assigned(OnStatus) then begin if Length(AArgs) = 0 then begin OnStatus(Self, AStatus, IndyFormat(IdStati[AStatus], [''])); {Do not Localize} end else begin OnStatus(Self, AStatus, IndyFormat(IdStati[AStatus], AArgs)); end; end; end; procedure TIdComponent.BeginWork(AWorkMode: TWorkMode; const ASize: Int64 = 0); var // under ARC, convert a weak reference to a strong reference before working with it LWorkTarget: TIdComponent; begin LWorkTarget := FWorkTarget; if LWorkTarget <> nil then begin LWorkTarget.BeginWork(AWorkMode, ASize); end else begin Inc(FWorkInfos[AWorkMode].Level); if FWorkInfos[AWorkMode].Level = 1 then begin FWorkInfos[AWorkMode].Max := ASize; FWorkInfos[AWorkMode].Current := 0; if Assigned(OnWorkBegin) then begin OnWorkBegin(Self, AWorkMode, ASize); end; end; end; end; procedure TIdComponent.DoWork(AWorkMode: TWorkMode; const ACount: Int64); var // under ARC, convert a weak reference to a strong reference before working with it LWorkTarget: TIdComponent; begin LWorkTarget := FWorkTarget; if LWorkTarget <> nil then begin LWorkTarget.DoWork(AWorkMode, ACount); end else begin if FWorkInfos[AWorkMode].Level > 0 then begin Inc(FWorkInfos[AWorkMode].Current, ACount); if Assigned(OnWork) then begin OnWork(Self, AWorkMode, FWorkInfos[AWorkMode].Current); end; end; end; end; procedure TIdComponent.EndWork(AWorkMode: TWorkMode); var // under ARC, convert a weak reference to a strong reference before working with it LWorkTarget: TIdComponent; begin LWorkTarget := FWorkTarget; if LWorkTarget <> nil then begin LWorkTarget.EndWork(AWorkMode); end else begin if FWorkInfos[AWorkMode].Level = 1 then begin if Assigned(OnWorkEnd) then begin OnWorkEnd(Self, AWorkMode); end; end; Dec(FWorkInfos[AWorkMode].Level); end; end; procedure TIdComponent.InitComponent; begin inherited InitComponent; TIdStack.IncUsage; end; // under ARC, all weak references to a freed object get nil'ed automatically {$IFNDEF USE_OBJECT_ARC} procedure TIdComponent.Notification(AComponent: TComponent; Operation: TOperation); begin if (Operation = opRemove) and (AComponent = FWorkTarget) then begin FWorkTarget := nil; end; inherited Notification(AComponent, Operation); end; {$ENDIF} procedure TIdComponent.SetWorkTarget(AValue: TIdComponent); begin {$IFDEF USE_OBJECT_ARC} // under ARC, all weak references to a freed object get nil'ed automatically FWorkTarget := AValue; {$ELSE} if FWorkTarget <> AValue then begin if Assigned(FWorkTarget) then begin FWorkTarget.RemoveFreeNotification(Self); end; FWorkTarget := AValue; if Assigned(AValue) then begin AValue.FreeNotification(Self); end; end; {$ENDIF} end; end.