unit RSFile; { RSFILE: RTC add-ons for managed stream and file sending NOTE*NOTE*NOTE*NOTE*NOTE*NOTE*NOTE*NOTE*NOTE*NOTE*NOTE*NOTE* While I have a long history with writing non-blocking sockets, This is the ABSOLUTE FIRST PROGRAM I HAVE EVER WRITTEN WITH RTC! PLUS, this program is NOT YET IN ANY PRODUCTION ENVIRONMENT! USE AT YOUR OWN RISK, KEEPING ALL THE WARNINGS IN MIND! This is an early posting, based on requests for what I had. ALSO, I use these functions 'direct' and not to a web server, so some issues may be incompatible. Also, I do most of my work with the stream items, so file items have not been used much. Intent was to learn the RTC framework; I'll be adding the functions into production shortly. I'll post back significant updates to the RTC forums as I have them. Basic functionality for a StreamProvider: * Set autoaccept method and/or filename if you don't want to write an OnAccept. These can have options with a semicolon, such as: acceptfilename: *.wav;*.txt;etc. * Streams are tracked by the ManagedList item, that assigns IDs (guids) to inbound and outbound streams. (Sender as TRtcDataServer).Request.Info.AsString[RTC_STREAM_RCV] is the ID for the inbound stream (Sender as TRtcDataServer).Request.Info.AsString[RTC_STREAM_SND] is the ID for the outbound stream Note that THEY ARE BOTH set in the request.info. This is just to dupe logic for client parts, since the client doesn't have access to the response early on. * public functions to find and assign a stream. remember INFO IS ALWAYS the REQUEST.INFO. function FindSendStream(Info:TRtcInfo):TStream; function FindRecvStream(Info:TRtcInfo):TStream; SetStream is currently passing streamname of EITHER RTC_STREAM_RCV or RTC_STREAM_SND constant procedure SetStream(Info:TRtcInfo; StreamName:String; AStream:TStream; AOwnsStream:Boolean=True); * Functions OnGetSaveStream and OnGetSendStream are key to retrieving and sending data. Create your stream and then assign it via SetStream in either Save/Send where appropriate. The Obj parameter in the OnGetSaveStream is a cast of the Request.Info. Basic functionality for a FileProvider: * The AutoMode of amSend/amReceive changes behavior for defaults. amSend: If no stream is set during OnGetSendStream, it'll look for the file in the specific directory and send it. amReceive: If no stream is set during OnGetSaveStream, it'll look for the file in the specific directory and save it. * Directories can be relative to executable path (default) or specific ones * Basic permissions set up to allow complete access to the computer, allow access to root (relative or specific) Note if root is set to "temp" and it's relative, then root is ExePath\temp. If access to root is set to false, the user can NOT access the new root, only things below. Basic functionality from a StreamRequest: Call this functions directly from your code in lieu of Request.Post: * if Stream is owned, then it will be freed on end of transfer. * if receiving into a stream, you need to created it (MemoryStream, FileStream, etc.) * Default values for method, query, etc., are those in the component values set from the IDE * ServerName is NAME OF FILE for Server; note that this isn't necessarily a file -- interpreted from server. SendStream(ServerName:String; Stream:TStream; OwnsStream:Boolean=True; Method:String=''; Query:String=''); virtual; ReceiveStream(ServerName:String; Stream:TStream; Method:String=''; Query:String=''); virtual; SendReceiveStream(ServerName:String; SendStream,RecvStream:TStream; OwnsSend:Boolean=True; OwnsRecv:Boolean=False; Method:String=''; Query:String=''); virtual; Basic functionality from a FileRequest: * Local name is local filename, Servername is filename for server. * BufferTo is a local filename to buffer the file to, to be renamed to localfile at end. SendFile(LocalName:String; ServerName:String=''; Method:String=''; Query:String=''); ReceiveFile(ServerName:String; LocalName:String=''; Method:String=''; Query:String=''; BufferTo:String=''); HTH, Jerry Hayes; jhayes@connexability.com ToDo: * Add OnResponseSuccess as an OnResponseDone when status=200 * Add OnResponseFailure as an OnResponseDone when (status<>200) or Exception and proxy exception * Verify that streams are being cleaned up regardless of response * Function to report on managed list status * Add all Temp buffering types from server to client for automated BufferTo * Server permissions to "AutoCreateDirectories", etc. } interface uses Windows, SysUtils, Classes, Forms, SyncObjs, Masks, rtcFunction, rtcDataSrv, rtcSrvModule, rtcInfo, rtcConn, rtcHttpSrv, rtcDataCli, rtcCliModule, rtcHttpCli, rtcConnProv; const DEFAULT_BUFFER_SIZE=64*1024; HTTP_NO_CODE=0; HTTP_NO_TEXT=''; HTTP_SUCCESS_CODE=200; HTTP_SUCCESS_TEXT='OK'; HTTP_UNAUTHORIZED_CODE=401; HTTP_UNAUTHORIZED_TEXT='Unauthorized'; HTTP_FORBIDDEN_CODE=403; HTTP_FORBIDDEN_TEXT='Forbidden'; HTTP_NOT_FOUND_CODE=404; HTTP_NOT_FOUND_TEXT='Not found'; HTTP_CONFLICT_CODE=409; HTTP_CONFLICT_TEXT='Conflict'; HTTP_SERVER_ERROR_CODE=500; HTTP_SERVER_ERROR_TEXT='Internal server error'; HTTP_CLIENT_ERROR_CODE=500; HTTP_CLIENT_ERROR_TEXT='Internal client error'; HTTP_FAILURE_CODE=HTTP_FORBIDDEN_CODE; HTTP_FAILURE_TEXT=HTTP_FORBIDDEN_TEXT; const RTC_STREAM_RCV='RTC_STREAM_RCV'; RTC_STREAM_SND='RTC_STREAM_SND'; RTC_FILE_TMP='RTC_FILE_TMP'; RTC_FILE_RCV='RTC_FILE_RCV'; RTC_FILE_SND='RTC_FILE_SND'; RTC_CLIENT_TIME='RTC_CLIENT_TIME'; RTC_SESSION_ROLE='RTC_SESS_ROLE'; //RTC_SESSION_ type TRtcAutoMode=(amNone,amSend,amReceive); TRtcTempType=(ttNone,ttTmp,ttGuid); TRtcStreamParams=record AutoAcceptMethod:String; AutoAcceptFilename:String; BufferSize:Integer; MaxDataSize:Integer; SuccessCode:Integer; SuccessText:String; end; TRtcFileParams=record NamedRoot:String; ExpandedRoot:String; AutoMode:TRtcAutoMode; RelativePath:Boolean; CanAccessRoot:Boolean; CompleteAccess:Boolean; TempType:TRtcTempType; end; TRtcSecurityParams=record PermissionName:String; //User must have this code in their list (if not blank) RequiresRole:String; //User must have this role in their list (if not blank) RequiresLogin:Boolean; //User must be logged in for this item end; TRtcParams=record StreamParams:TRtcStreamParams; FileParams:TRtcFileParams; SecurityParams:TRtcSecurityParams; end; TRtcManagedItemType=(mitUnknown,mitFunction,mitData,mitUser); PRtcManagedItem=^TRtcManagedItem; TRtcManagedItem=record Data:TObject; Text:String; ItemType:TRtcmanagedItemType; Created:TDateTime; Updated:TDateTime; Completed:TDateTime; OwnsItem:Boolean; Tag:Integer; end; TRtcManagedList=class(TObject) private FStrings:TStringList; CS:TCriticalSection; public constructor Create; destructor Destroy; override; function GetCounts(var OwnedCount:Integer; var UnownedCount:Integer; var NullCount:Integer):Integer; function GetDetailList(NoLock:Boolean=False):String; procedure Lock; virtual; procedure Unlock; virtual; function Item(ID:String; NoLock:Boolean=False):PRtcManagedItem; overload; function Item(Index:Integer; NoLock:Boolean=False):PRtcManagedItem; overload; function Data(ID:String; NoLock:Boolean=False):TObject; overload; function Data(Index:Integer; NoLock:Boolean=False):TObject; overload; function RegisterID(ItemType:TRtcManagedItemType; ID:String; Value:TObject; OwnsItem:Boolean=True; Text:String=''):Boolean; function UnRegisterID(ID:String):Boolean; function Count:Integer; end; TRtcBaseStreamDataProvider=class(TRtcDataProvider) private FOnGetSaveStream:TRtcUserEvent; FOnGetSendStream:TRtcUserEvent; FOnRequestDone:TRtcNotifyEvent; FOnResponseDone:TRtcNotifyEvent; procedure NullNotifyEvent(Sender: TRtcConnection); protected Params:TRtcParams; procedure CheckActive; virtual; procedure SetAutoAcceptMethod(Value:String); virtual; procedure SetAutoAcceptFilename(Value:String); virtual; procedure SetBufferSize(Value:Integer); virtual; procedure SetMaxDataSize(Value:Integer); virtual; procedure SetSuccessCode(Value:Integer); virtual; procedure SetSuccessText(Value:String); virtual; procedure SetPermissionName(Value:String); virtual; procedure SetRequiresRole(Value:String); virtual; procedure SetRequiresLogin(Value:Boolean); virtual; function AutoAccept(Sender: TRtcConnection):Boolean; property BufferSize:Integer read Params.StreamParams.BufferSize write SetBufferSize; property MaxDataSize:Integer read Params.StreamParams.MaxDataSize write SetMaxDataSize; property SuccessCode:Integer read Params.StreamParams.SuccessCode write SetSuccessCode; property SuccessText:String read Params.StreamParams.SuccessText write SetSuccessText; property AutoAcceptMethod:String read Params.StreamParams.AutoAcceptMethod write SetAutoAcceptMethod; property AutoAcceptFilename:String read Params.StreamParams.AutoAcceptFilename write SetAutoAcceptFilename; property PermissionName:String read Params.SecurityParams.PermissionName write SetPermissionName; property RequiresRole:String read Params.SecurityParams.RequiresRole write SetRequiresRole; property RequiresLogin:Boolean read Params.SecurityParams.RequiresLogin write SetRequiresLogin; property OnGetSaveStream:TRtcUserEvent read FOnGetSaveStream write FOnGetSaveStream; property OnGetSendStream:TRtcUserEvent read FOnGetSendStream write FOnGetSendStream; property OnRequestDone:TRtcNotifyEvent read FOnRequestDone write FOnRequestDone; property OnResponseDone:TRtcNotifyEvent read FOnResponseDone write FOnResponseDone; procedure DoInitialize(Sender:TRtcConnection); virtual; procedure DoReceive(Sender:TRtcConnection); virtual; procedure DoRequestDone(Sender:TRtcConnection); virtual; procedure DoReadySend(Sender:TRtcConnection); virtual; procedure DoResponseStart(Sender:TRtcConnection); virtual; procedure DoResponseDone(Sender:TRtcConnection); virtual; procedure DoSetHeader(Sender:TRtcConnection; DefaultCode:Integer=HTTP_NO_CODE; DefaultText:String=HTTP_NO_TEXT); virtual; function CreateSaveStream(Sender:TRtcConnection):TStream; virtual; function CreateSendStream(Sender:TRtcConnection):TStream; virtual; function GetRequest(Sender:TRtcConnection):TRtcServerRequest; function GetResponse(Sender:TRtcConnection):TRtcServerResponse; procedure Call_DataReceived(Sender:TRtcConnection); override; //individual implementation procedure Call_ReadyToSend(Sender:TRtcConnection); override; //individual implementation procedure Call_CheckRequest(Sender:TRtcConnection); override; //individual implementation procedure Call_DataSent(Sender:TRtcConnection); override; //individual implementation public constructor Create(AOwner:TComponent); override; destructor Destroy; override; procedure Loaded; override; function RemainReceive(Sender:TRtcConnection):Integer; function RemainSend(Sender:TRtcConnection):Integer; end; TRtcStreamDataProvider=class(TRtcBaseStreamDataProvider) protected published property AutoAcceptMethod; property AutoAcceptFilename; property BufferSize; property MaxDataSize; property SuccessCode; property SuccessText; property PermissionName; property RequiresRole; property RequiresLogin; property OnGetSaveStream; property OnGetSendStream; property OnRequestDone; property OnResponseDone; end; TRtcBaseFileDataProvider=class(TRtcBaseStreamDataProvider) protected procedure SetNamedRoot(Value:String); procedure SetExpandedRoot(Value:String); procedure SetRelativePath(Value:Boolean); procedure SetCanAccessRoot(Value:Boolean); procedure SetCompleteAccess(Value:Boolean); procedure SetTempType(Value:TRtcTempType); procedure SetAutoMode(Value:TRtcAutoMode); property NamedRoot:String read Params.FileParams.NamedRoot write SetNamedRoot; property ExpandedRoot:String read Params.FileParams.ExpandedRoot write SetExpandedRoot; property RelativePath:Boolean read Params.FileParams.RelativePath write SetRelativePath; property CanAccessRoot:Boolean read Params.FileParams.CanAccessRoot write SetCanAccessRoot; property CompleteAccess:Boolean read Params.FileParams.CompleteAccess write SetCompleteAccess; property TempType:TRtcTempType read Params.FileParams.TempType write SetTempType; property AutoMode:TRtcAutoMode read Params.FileParams.AutoMode write SetAutoMode; procedure DoInitialize(Sender:TRtcConnection); override; function CreateSaveStream(Sender:TRtcConnection):TStream; override; function CreateSendStream(Sender:TRtcConnection):TStream; override; procedure DoResponseDone(Sender:TRtcConnection); override; public constructor Create(AOwner:TComponent); override; procedure Loaded; override; published property AutoAcceptMethod; property AutoAcceptFilename; property MaxDataSize; property SuccessCode; property SuccessText; property PermissionName; property RequiresRole; property RequiresLogin; property OnRequestDone; property OnResponseDone; end; TRTCFileDataProvider=class(TRtcBaseFileDataProvider) published property AutoMode; property NamedRoot; property RelativePath; property CanAccessRoot; property CompleteAccess; property BufferSize; property TempType; property OnRequestDone; end; TRtcBaseStreamDataRequest=class(TRtcDataRequest) private FOnGetSaveStream:TRtcUserEvent; FOnGetSendStream:TRtcUserEvent; FDefaultMethod:String; FDefaultQuery:String; protected Params:TRtcParams; procedure CheckActive; virtual; procedure DoReadyToSend(Sender:TRtcConnection); virtual; procedure DoInitialize(Sender:TRtcConnection); virtual; procedure DoReceive(Sender:TRtcConnection); virtual; procedure DoResponseDone(Sender:TRtcConnection); virtual; procedure DoResponseAbort(Sender:TRtcConnection); virtual; procedure SetBufferSize(Value:Integer); virtual; procedure SetMaxDataSize(Value:Integer); virtual; procedure SetSuccessCode(Value:Integer); virtual; procedure SetSuccessText(Value:String); virtual; property DefaultMethod:String read FDefaultMethod write FDefaultMethod; property DefaultQuery:String read FDefaultQuery write FDefaultQuery; property BufferSize:Integer read Params.StreamParams.BufferSize write SetBufferSize; property MaxDataSize:Integer read Params.StreamParams.MaxDataSize write SetMaxDataSize; property OnGetSaveStream:TRtcUserEvent read FOnGetSaveStream write FOnGetSaveStream; property OnGetSendStream:TRtcUserEvent read FOnGetSendStream write FOnGetSendStream; function CreateSaveStream(Sender: TRtcConnection):TStream; virtual; function CreateSendStream(Sender: TRtcConnection):TStream; virtual; procedure Call_ReadyToSend(Sender:TRtcConnection); override; //individual implementation procedure Call_DataReceived(Sender:TRtcConnection); override; //individual implementation procedure Call_BeginRequest(Sender:TRtcConnection); override; //individual implementation procedure Call_ResponseDone(Sender:TRtcConnection); override; procedure Call_ResponseAbort(Sender:TRtcConnection); override; //procedure Call_ function GetRequest(Sender:TRtcConnection):TRtcClientRequest; function GetResponse(Sender:TRtcConnection):TRtcClientResponse; procedure RequestNoPost(ServerName:String; Method:String=''; Query:String=''; SendID:String=''; ReceiveID:String=''); public procedure SendStream(ServerName:String; Stream:TStream; OwnsStream:Boolean=True; Method:String=''; Query:String=''); virtual; procedure ReceiveStream(ServerName:String; Stream:TStream; Method:String=''; Query:String=''); virtual; procedure SendReceiveStream(ServerName:String; SendStream,RecvStream:TStream; OwnsSend:Boolean=True; OwnsRecv:Boolean=False; Method:String=''; Query:String=''); virtual; constructor Create(AOwner:TComponent); override; destructor Destroy; override; function RemainReceive(Sender:TRtcConnection):Integer; function RemainSend(Sender:TRtcConnection):Integer; published end; {Send or Receive a stream} TRtcStreamDataRequest=class(TRtcBaseStreamDataRequest) published property BufferSize; property MaxDataSize; property DefaultMethod; property DefaultQuery; property OnGetSaveStream; property OnGetSendStream; end; {Requesting a file} TRtcBaseFileRequest=class(TRtcBaseStreamDataRequest) private protected procedure DoInitialize(Sender:TRtcConnection); override; public constructor Create(AOwner:TComponent); override; procedure Loaded; override; procedure DoResponseDone(Sender:TRtcConnection); override; procedure DoResponseAbort(Sender:TRtcConnection); override; function CreateSaveStream(Sender: TRtcConnection):TStream; override; procedure ReceiveFile(ServerName:String; LocalName:String=''; Method:String=''; Query:String=''; BufferTo:String=''); overload; procedure SendFile(LocalName:String; ServerName:String=''; Method:String=''; Query:String=''); overload; published property DefaultMethod; property DefaultQuery; end; TRtcFileDataRequest=class(TRtcBaseFileRequest) published property DefaultMethod; property DefaultQuery; property BufferSize; property MaxDataSize; end; TRtcSecureFunction=class(TRtcFunction) protected Params:TRtcSecurityParams; procedure SetPermissionName(Value:String); virtual; procedure SetRequiresRole(Value:String); virtual; procedure SetRequiresLogin(Value:Boolean); virtual; public constructor Create(AOwner:TComponent); override; function Call_Execute(Sender:TRtcConnection; Param:TRtcFunctionInfo; Res:TRtcValue):boolean; override; published property PermissionName:String read Params.PermissionName write SetPermissionName; property RequiresRole:String read Params.RequiresRole write SetRequiresRole; property RequiresLogin:Boolean read Params.RequiresLogin write SetRequiresLogin; //property end; procedure Register; function FindStream(StreamID:String):TStream; overload; function FindStream(Info:TRtcInfo; StreamName:String; Sender:TRtcConnection=nil; OnGetStream:TRtcUserEvent=nil):TStream; overload; function FindSendStream(Info:TRtcInfo):TStream; function FindRecvStream(Info:TRtcInfo):TStream; procedure SetStream(Info:TRtcInfo; StreamName:String; Stream:TStream; OwnsStream:Boolean=True); overload; procedure SetSendStream(Info:TRtcInfo; Stream:TStream; OwnsStream:Boolean=True); procedure SetRecvStream(Info:TRtcInfo; Stream:TStream; OwnsStream:Boolean=True); function SetID(Info:TRtcInfo; NameID:String; ID:String=''):String; //Set Message ID for Inbound items function GetID(Info:TRtcInfo; NameID:String):String; //Set Message ID for Inbound items function UrlString(S:String; Encoding:Boolean=True):String; var ManagedStreams:TRtcManagedList; implementation procedure Register; begin RegisterComponents('Rtc RSFile',[TRtcStreamDataProvider,TRtcFileDataProvider]); RegisterComponents('Rtc RSFile',[TRtcStreamDataRequest,TRTCFileDataRequest]); end; function UrlString(S:String; Encoding:Boolean=True):String; const HEXSTRING='0123456789ABCDEF'; URL_CHAR=['0'..'9','A'..'Z','a'..'z','*','@','.','_','-','/','(',')','$','=']; var i:Integer; C:Char; begin Result:=''; if Encoding then begin for i:=1 to Length(S) do begin C:=S[i]; if C in URL_CHAR then begin Result:=Result+C; end else begin Result:=Result+'%'+IntToHex(Ord(C),2); end; end; end else begin i:=1; while i<=Length(S) do begin C:=S[i]; if C='%' then begin Result:=Result+Char((Pos(UpCase(S[i+1]),HEXSTRING)-1)*16+(Pos(UpCase(S[i+2]),HEXSTRING)-1)); Inc(i,2); end else begin Result:=Result+C; end; Inc(i); end; end; end; procedure CheckServerActive(Server:TRtcDataServer; Link:TRtcDataServerLink); var Active:Boolean; begin Active:=False; if Assigned(Server) then begin Active:=(Server.isListening) and (Server.TotalSessionsCount>0); end else if Assigned(Link) then begin Active:=Link.Server.isListening and (Link.Server.TotalSessionsCount>0);; end; if Active then raise(Exception.Create('Cannot set startup params while sessions active')); end; function DoSecurityCheck(Sender: TRtcConnection; Params:TRtcSecurityParams): Boolean; var Session:TRtcSession; begin Result:=True; if not Params.RequiresLogin then Exit; //not required to be logged in Session:=(Sender as TRtcDataServer).Session; Result:=Assigned(Session); if Result then begin if Length(Params.PermissionName)>0 then begin //This MAY include multiples...consider walking with ';' Result:=Session.asRecord['Permissions'].asBoolean[Params.PermissionName]; end; if Result and (Length(Params.RequiresRole)>0) then begin //This MAY include multiples...consider walking with ';' Result:=Session.asRecord['Roles'].asBoolean[Params.RequiresRole]; end; end; end; function GetNextSection(var s:String; Delim:Char):String; var Index:Integer; begin Index:=Pos(Delim,s); if Index<=0 then begin Result:=Trim(s); s:=''; end else begin Result:=Trim(Copy(s,1,Index-1)); s:=Trim(Copy(s,Index+1,Length(S))); end; end; function ExcludeLeadingPathDelimiter(const S: string): string; begin Result := S; if IsPathDelimiter(Result,1) then begin Delete(Result,1,1); end; end; function ResolveDir(ADir:String; RelativePath:Boolean):String; var Drive:String; begin Result:=Trim(ADir); if Length(Result)=0 then begin Result:=ExtractFilepath(Application.ExeName); if not RelativePath then begin Result:=ExtractFileDrive(Result); end; end else begin Drive:=ExtractFileDrive(Result); if Drive='' then begin if RelativePath then begin Result:=ExtractFilePath(Application.ExeName)+Result; end else begin Result:=ExtractFileDrive(Application.Exename)+ADir; //Add current drive end; Drive:=ExtractFileDrive(Result); if Drive='' then begin Result:=''; Exit; end; end; //Sure I've got a drive here; either passed or specified local if IsPathDelimiter(Drive,1) then begin //UNC name Result:=ExpandUNCFilename(Result); end else begin Result:=ExpandFilename(Result); end; end; if Length(Result)>0 then begin Result:=IncludeTrailingPathDelimiter(Result); end; end; function ResolveBufferFilename(Info:TRtcInfo; Filename:String; const Params:TRtcParams):String; var ID:String; begin case Params.FileParams.TempType of ttNone: Result:=Filename; ttTmp: begin Result:=ChangeFileExt(Filename,'.Tmp'); end; ttGuid: begin ID:=Info.asString[RTC_STREAM_RCV]; if ID='' then begin raise Exception.Create('Invalid stream ID: '+RTC_STREAM_RCV); end else begin Result:=ExtractFilePath(Filename)+ID+'.tmp'; end; end; else raise Exception.Create('Unhandled file buffering: TempType'); end; end; function FindStream(StreamID:String):TStream; overload; begin Result:=nil; if Length(StreamID)>0 then Result:=(ManagedStreams.Data(StreamID) as TStream); end; function FindStream(Info:TRtcInfo; StreamName:String; Sender:TRtcConnection=nil; OnGetStream:TRtcUserEvent=nil):TStream; overload; begin if Assigned(Sender) and Assigned(OnGetStream) then begin //Called regardless of stream existence. Sender.Sync(OnGetStream,Info); end; Result:=FindStream(Info.asString[StreamName]); //was it set during the sync operation end; function FindSendStream(Info:TRtcInfo):TStream; begin Result:=FindStream(Info.asString[RTC_STREAM_SND]); end; function FindRecvStream(Info:TRtcInfo):TStream; begin Result:=FindStream(Info.asString[RTC_STREAM_RCV]); end; function SendChunk(Sender:TRtcConnection; Info:TRtcInfo; const BufferSize:Integer; var Remain:Int64; var ErrorCode:Integer; var ErrorText:String):Boolean; var ThisBlock:Integer; ThisBufferSize:Integer; Buffer:String; Stream:TStream; begin ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; Stream:=FindSendStream(Info); Result:=Assigned(Stream); if Result then begin ThisBufferSize:=BufferSize; if ThisBufferSize<=0 then begin ThisBufferSize:=DEFAULT_BUFFER_SIZE; end; Remain:=Stream.Size-Stream.Position; {ToDo: What if sending a partial block? Remain should be passed} if Remain>0 then begin ThisBlock:=Remain; if ThisBlock>=ThisBufferSize then begin ThisBlock:=ThisBufferSize; end; SetLength(Buffer,ThisBlock); Result:=Stream.Read(Buffer[1],ThisBlock)=ThisBlock; if Result then begin Sender.Write(Buffer); Remain:=Remain-ThisBlock; end; SetLength(Buffer,0); end; end; if not Result then begin Remain:=0; ErrorCode:=HTTP_SERVER_ERROR_CODE; ErrorText:=HTTP_SERVER_ERROR_TEXT; end; end; function SaveChunk(Sender:TRtcConnection; Stream:TStream; var Remain:Int64; var ErrorCode:Integer; var ErrorText:String):Boolean; overload; var Buffer:String; BufferSize:Integer; begin ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; Result:=Assigned(Stream); if Result then begin Buffer:=Sender.Read; BufferSize:=Length(Buffer); if BufferSize>0 then begin Result:=Stream.Write(Buffer[1],BufferSize)=BufferSize; Dec(Remain,BufferSize); end; end; if not Result then begin Remain:=0; ErrorCode:=HTTP_SERVER_ERROR_CODE; ErrorText:=HTTP_SERVER_ERROR_TEXT; end; end; function SaveChunk(Sender:TRtcConnection; Info:TRtcInfo; var Remain:Int64; var ErrorCode:Integer; var ErrorText:String):Boolean; overload; begin Result:=SaveChunk(Sender,FindRecvStream(Info),Remain,ErrorCode,ErrorText); end; procedure SetStream(Info:TRtcInfo; StreamName:String; Stream:TStream; OwnsStream:Boolean=True); overload; var StreamID:String; begin StreamID:=Info.asString[StreamName]; ManagedStreams.UnRegisterID(StreamID); //Just in case.. if Assigned(Stream) then begin ManagedStreams.RegisterID(mitData,StreamID,Stream,OwnsStream,StreamName); end; end; procedure SetSendStream(Info:TRtcInfo; Stream:TStream; OwnsStream:Boolean=True); begin SetStream(Info,RTC_STREAM_SND,Stream,OwnsStream); end; procedure SetRecvStream(Info:TRtcInfo; Stream:TStream; OwnsStream:Boolean=True); begin SetStream(Info,RTC_STREAM_RCV,Stream,OwnsStream); end; function GetID(Info:TRtcInfo; NameID:String): String; begin Result:=Info.asString[NameID]; end; function SetID(Info:TRtcInfo; NameID:String; ID:String=''):String; var Guid:TGuid; begin if ID='' then begin ID:=Info.asString[NameID]; if ID='' then begin CreateGuid(Guid); ID:=GuidToString(Guid); end; end; Info.asString[NameID]:=ID; Result:=ID; end; procedure SetStatus(Response:TRtcResponse; Code:Integer; Text:String); begin Response.StatusCode:=Code; Response.StatusText:=Text; end; function CleanupFiles(Filename,Buffername:String; ASuccess:Boolean):Boolean; begin Result:=True; if Length(Filename)>0 then begin if (Length(BufferName)=0) or SameText(Filename,BufferName) then begin //Not buffered to external if not ASuccess then begin Result:=not FileExists(Filename) or DeleteFile(Filename); end; end else begin if not ASuccess then begin Result:=not FileExists(BufferName) or DeleteFile(BufferName); end else begin Result:=SameText(BufferName,Filename) or RenameFile(BufferName,Filename); if not Result then begin //Couldn't Rename. Result:=not FileExists(BufferName) or DeleteFile(BufferName); end; end; end; end; end; function ResolveFilename(Filename:String; const Params:TRtcParams):String; var TempRoot:String; TempName:String; begin //if $temp then begin TempName:=StringReplace(Filename,'/','\',[rfReplaceAll]); if IsPathDelimiter(TempName,1) and not IsPathDelimiter(TempName,2) then begin Delete(TempName,1,1); //Starts with a \ (relative path), but *not* a \\ (share name) end; if Length(ExtractFileDrive(TempName))>0 then begin //This is a fully named path. TempRoot:=ExtractFilePath(TempName); TempName:=ExtractFilename(TempName); end else begin //it's a path, no drive specified. {ToDo: Error when ExpandedRoot is blank} TempRoot:=Params.FileParams.ExpandedRoot+ExtractFilePath(TempName); TempName:=ExtractFilename(TempName); end; TempRoot:=ResolveDir(TempRoot,False); //with drive,path, (hopefully) filename TempRoot:=IncludeTrailingPathDelimiter(TempRoot); Result:=TempRoot+TempName; end; function ClearFilePath(Filename:String; var ErrorCode:Integer; var ErrorText:String):Boolean; var Path:String; begin ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; Path:=ExtractFilePath(Filename); if (Length(Path)>0) and not ForceDirectories(Path) then begin ErrorCode:=HTTP_NOT_FOUND_CODE; ErrorText:='Could not create directory '+Path; end else if FileExists(Filename) and not DeleteFile(Filename) then begin ErrorCode:=HTTP_NOT_FOUND_CODE; ErrorText:='Could not delete existing '+ExtractFileName(Filename); end; Result:=(ErrorCode=HTTP_NO_CODE); end; function CreateSendFileStream(Filename:String; var ErrorCode:Integer; var ErrorText:String):TStream; begin Result:=nil; ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; if not FileExists(Filename) then begin ErrorCode:=HTTP_NOT_FOUND_CODE; ErrorText:=HTTP_NOT_FOUND_TEXT; end else begin Result:=TFileStream.Create(Filename,fmOpenRead or fmShareDenyWrite); //when sending, others can read, but not write. if TFileStream(Result).Handle=0 then begin Result.Free; ErrorCode:=HTTP_CONFLICT_CODE; ErrorText:=HTTP_CONFLICT_TEXT; end; end; end; function CreateSaveFileStream(Filename:String; var ErrorCode:Integer; var ErrorText:String):TStream; begin Result:=nil; if ClearFilePath(Filename,ErrorCode,ErrorText) then begin //ErrorCode is set here...no need to initialize; if ErrorCode=HTTP_NO_CODE then begin Result:=TFileStream.Create(Filename,fmCreate or fmShareExclusive); if TFileStream(Result).Handle=0 then begin ErrorCode:=HTTP_CONFLICT_CODE; ErrorText:='Could not create '+Filename; //unavailable, but there end; end; end; end; function CanAccessFile(Filename:String; Params:TRtcParams; Size:Int64; var ErrorCode:Integer; var ErrorText:String):Boolean; var Root:String; begin ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; Filename:=ExpandFilename(Filename); //SHOULD BE expanded already, but just in case... Root:=Params.FileParams.ExpandedRoot; {ToDo: Common fn to expand ANY filename, if UNC or not} Result:=Params.FileParams.CompleteAccess; //Allowed to get file from anywhere if not Result then begin Result:=StrLIComp(PChar(Root),PChar(Filename),Length(Root))=0; //full path starts with expanded root, so must be subset if not Result then begin ErrorCode:=HTTP_UNAUTHORIZED_CODE; ErrorText:='Not under root '+Params.FileParams.ExpandedRoot; end; end; if Result and SameText(Root,ExtractFilePath(Filename)) then begin Result:=Params.FileParams.CanAccessRoot; //Even if there's complete access, they may want root denied if not Result then begin ErrorCode:=HTTP_UNAUTHORIZED_CODE; ErrorText:='Cannot access root '+Root; end; end; if Result and (Size>0) and (Params.StreamParams.MaxDataSize>0) then begin Result:=Size<=Params.StreamParams.MaxDataSize; if not Result then begin ErrorCode:=HTTP_UNAUTHORIZED_CODE; ErrorText:='Exceeds max size '+IntToStr(Params.StreamParams.MaxDataSize); end; end; end; //============================================================================== //============================================================================== { TRtcManagedList } constructor TRtcManagedList.Create; begin inherited Create; CS:=TCriticalSection.Create; FStrings:=TStringList.Create; end; destructor TRtcManagedList.Destroy; var i:Integer; PItem:PRtcManagedItem; begin for i:=0 to FStrings.Count-1 do begin PItem:=PRtcManagedItem(FStrings.Objects[i]); if PItem^.OwnsItem then begin PItem^.Data.Free; end; Dispose(PItem); end; FreeAndNil(FStrings); FreeAndNil(CS); inherited Destroy; end; function TRtcManagedList.Count: Integer; begin Result:=FStrings.Count; end; procedure TRtcManagedList.Lock; begin CS.Enter; end; function TRtcManagedList.RegisterID(ItemType:TRtcManagedItemType; ID:String; Value:TObject; OwnsItem:Boolean=True; Text:String=''):Boolean; var Index:Integer; PItem:PRtcManagedItem; begin Result:=False; if Value=nil then Exit; PItem:=nil; Lock; try Index:=FStrings.IndexOf(ID); if Index>=0 then begin PItem:=PRtcManagedItem(FStrings.Objects[Index]); PItem^.Updated:=Now; if Text<>'' then PItem^.Text:=Text; end else begin New(PItem); FStrings.AddObject(ID,TObject(PItem)); PItem^.Text:=Text; PItem^.ItemType:=ItemType; PItem^.Created:=Now; end; if Assigned(PItem) then begin PItem^.Data:=Value; PItem^.OwnsItem:=OwnsItem; end; Result:=Assigned(PItem); finally Unlock; end; end; procedure TRtcManagedList.Unlock; begin CS.Leave; end; function TRtcManagedList.UnRegisterID(ID:String): Boolean; var Index:Integer; PItem:PRtcManagedItem; begin Result:=False; Lock; try Index:=FStrings.IndexOf(ID); if Index>=0 then begin PItem:=PRtcManagedItem(FStrings.Objects[Index]); if PItem^.OwnsItem then begin PItem^.Data.Free; end; Dispose(PItem); FStrings.Delete(Index); Result:=True; end; finally Unlock; end; end; function TRtcManagedList.Item(ID:String; NoLock:Boolean=False):PRtcManagedItem; var Index:Integer; begin Result:=nil; if not NoLock then Lock; try Index:=FStrings.IndexOf(ID); Result:=Item(Index,True); finally if not NoLock then Unlock; end; end; function TRtcManagedList.Data(ID: String; NoLock: Boolean=False): TObject; var PItem:PRtcManagedItem; begin Result:=nil; PItem:=Item(ID,NoLock); if Assigned(PItem) then begin Result:=PItem^.Data; end; end; function TRtcManagedList.GetCounts(var OwnedCount, UnownedCount, NullCount: Integer): Integer; var i:Integer; PItem:PRtcManagedItem; begin Lock; try OwnedCount:=0; UnownedCount:=0; NullCount:=0; for i:=0 to FStrings.Count-1 do begin PItem:=Item(i,True); if not Assigned(PItem) then begin Inc(NullCount); end else if PItem^.OwnsItem then begin Inc(OwnedCount); end else begin Inc(UnownedCount); end; end; finally Unlock; Result:=OwnedCount+UnownedCount; //ignore nulls end; end; function TRtcManagedList.GetDetailList(NoLock:Boolean=False): String; var i:Integer; PItem:PRtcManagedItem; Line:String; begin if not NoLock then Lock; try Result:=''; for i:=0 to FStrings.Count-1 do begin Line:=FStrings[i]+'='; PItem:=Item(i,True); if not Assigned(PItem) then begin Line:=Line+'nil'; end else begin if Assigned(PItem^.Data) then begin Line:=Line+PItem^.Data.ClassName; end else begin Line:=Line+'nil' end; Line:=Line+';owned='; if PItem^.OwnsItem then begin Line:=Line+'1'; end else begin Line:=Line+'0'; end; Line:=Line+';created='+FormatDateTime('yyyy-mm-ddThh:nn:ss',PItem^.Created); Line:=Line+';tag='+IntToStr(PItem^.Tag); end; Result:=Result+Line+#13; end; finally if not NoLock then Unlock; end; end; function TRtcManagedList.Data(Index: Integer; NoLock: Boolean=False): TObject; var PItem:PRtcManagedItem; begin Result:=nil; PItem:=Item(Index,NoLock); if Assigned(PItem) then begin Result:=PItem^.Data; end; end; function TRtcManagedList.Item(Index: Integer; NoLock: Boolean): PRtcManagedItem; begin Result:=nil; if not NoLock then Lock; try if Index>=0 then begin Result:=PRtcManagedItem(FStrings.Objects[Index]); end; finally if not NoLock then Unlock; end; end; { TRtcBaseStreamDataProvider } constructor TRtcBaseStreamDataProvider.Create(AOwner:TComponent); begin inherited; BufferSize:=DEFAULT_BUFFER_SIZE; SuccessCode:=HTTP_SUCCESS_CODE; SuccessText:=HTTP_SUCCESS_TEXT; BufferSize:=DEFAULT_BUFFER_SIZE; PermissionName:=''; RequiresRole:=''; RequiresLogin:=True; end; destructor TRtcBaseStreamDataProvider.Destroy; begin inherited; end; procedure TRtcBaseStreamDataProvider.Loaded; begin inherited; if not Assigned(OnCheckRequest) then OnCheckRequest:=NullNotifyEvent; //event required by SDK, even if not used? end; procedure TRtcBaseStreamDataProvider.NullNotifyEvent(Sender: TRtcConnection); begin //Something? end; function TRtcBaseStreamDataProvider.GetRequest(Sender:TRtcConnection):TRtcServerRequest; begin //Easier call to avoid typecasting errors Result:=TRtcDataServer(Sender).Request; end; function TRtcBaseStreamDataProvider.GetResponse(Sender:TRtcConnection):TRtcServerResponse; begin //Easier call to avoid typecasting errors Result:=TRtcDataServer(Sender).Response; end; procedure TRtcBaseStreamDataProvider.DoInitialize(Sender: TRtcConnection); begin SetStatus(GetResponse(Sender),HTTP_NO_CODE,HTTP_NO_TEXT); SetID(GetRequest(Sender).Info,RTC_STREAM_RCV); //Set Message ID for Inbound items SetID(GetRequest(Sender).Info,RTC_STREAM_SND); //Set Message ID for Outbound items end; function TRtcBaseStreamDataProvider.RemainReceive(Sender:TRtcConnection):Integer; begin Result:=GetRequest(Sender).DataSize-GetRequest(Sender).DataIn; end; function TRtcBaseStreamDataProvider.RemainSend(Sender:TRtcConnection):Integer; begin Result:=0; if Assigned(FindSendStream(GetRequest(Sender).Info)) then begin Result:=GetResponse(Sender).DataSize-GetResponse(Sender).DataOut; end; end; procedure TRtcBaseStreamDataProvider.Call_CheckRequest(Sender: TRtcConnection); begin if DoSecurityCheck(Sender,Params.SecurityParams) then begin inherited; if (not GetRequest(Sender).Accepted) and AutoAccept(Sender) then begin TRtcDataServer(Sender).Accept; end; if GetRequest(Sender).Accepted then begin //INITIALIZE DoInitialize(Sender); end; end; end; function TRtcBaseStreamDataProvider.AutoAccept(Sender: TRtcConnection):Boolean; const AUTO_DELIM=';'; var Temp:String; begin Result:=False; Temp:=AutoAcceptMethod; while Length(Temp)>0 do begin //Allow "/get;/grab;/pick;" etc. Result:=SameText(GetNextSection(Temp,AUTO_DELIM),GetRequest(Sender).Method); if Result then break; end; if not Result then begin Temp:=AutoAcceptFilename; while Length(Temp)>0 do begin Result:=MatchesMask(GetNextSection(Temp,AUTO_DELIM),GetRequest(Sender).Filename); //*.txt;testfile.dat;is????.bin,etc. if Result then break; end; end; end; procedure TRtcBaseStreamDataProvider.DoReceive(Sender:TRtcConnection); var Remain:Int64; ErrorCode:Integer; ErrorText:String; Stream:TStream; begin ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; Remain:=RemainReceive(Sender); if GetRequest(Sender).Started and (Remain>0) then begin CreateSaveStream(Sender); end; Stream:=FindRecvStream(GetRequest(Sender).Info); SaveChunk(Sender,Stream,Remain,ErrorCode,ErrorText); if GetRequest(Sender).Complete or (ErrorCode<>HTTP_NO_CODE) then begin if GetRequest(Sender).Complete then begin //setstatus here... DoRequestDone(Sender); DoResponseStart(Sender); if RemainSend(Sender)=0 then begin //After saying request done, nothing planned on outbound Sender.Write; //not a disconnect, just a trigger of writing nothing back end; end else begin Sender.Disconnect; end; end; end; procedure TRtcBaseStreamDataProvider.Call_DataReceived(Sender:TRtcConnection); begin inherited; DoReceive(Sender); end; procedure TRtcBaseStreamDataProvider.DoReadySend(Sender:TRtcConnection); var Remain:Int64; ErrorCode:Integer; ErrorText:String; begin if GetRequest(Sender).Complete then begin Remain:=RemainSend(Sender); SendChunk(Sender,GetRequest(Sender).Info,BufferSize,Remain,ErrorCode,ErrorText); if (Remain<=0) or (ErrorCode<>HTTP_NO_CODE) then begin if RemainSend(Sender)>0 then begin Sender.Disconnect; end; end; end; end; procedure TRtcBaseStreamDataProvider.Call_ReadyToSend(Sender:TRtcConnection); begin inherited; DoReadySend(Sender); end; procedure TRtcBaseStreamDataProvider.CheckActive; begin CheckServerActive(Server,Link); end; function TRtcBaseStreamDataProvider.CreateSendStream(Sender: TRtcConnection):TStream; begin //NOTE!! NOTE!! The Stream IDs are ALWAYS tagged to the request, for consistancy with client //(Client has no access to other items at the initial request) Result:=FindStream(GetRequest(Sender).Info,RTC_STREAM_SND,Sender,FOnGetSendStream); //Outgoing stream has been defined. if Assigned(Result) then begin GetResponse(Sender).DataSize:=Result.Size; end; end; function TRtcBaseStreamDataProvider.CreateSaveStream(Sender: TRtcConnection):TStream; begin Result:=FindStream(GetRequest(Sender).Info,RTC_STREAM_RCV,Sender,FOnGetSaveStream); end; procedure TRtcBaseStreamDataProvider.SetAutoAcceptFilename(Value: String); begin if Params.StreamParams.AutoAcceptFilename<>Value then begin CheckActive; Params.StreamParams.AutoAcceptFilename:=Value; end; end; procedure TRtcBaseStreamDataProvider.SetAutoAcceptMethod(Value: String); begin if Params.StreamParams.AutoAcceptMethod<>Value then begin CheckActive; Params.StreamParams.AutoAcceptMethod:=Value; end; end; procedure TRtcBaseStreamDataProvider.SetBufferSize(Value: Integer); begin if Params.StreamParams.BufferSize<>Value then begin CheckActive; Params.StreamParams.BufferSize:=Value; end; end; procedure TRtcBaseStreamDataProvider.SetMaxDataSize(Value: Integer); begin if Params.StreamParams.MaxDataSize<>Value then begin CheckActive; Params.StreamParams.MaxDataSize:=Value; end; end; procedure TRtcBaseStreamDataProvider.SetSuccessCode(Value: Integer); begin if Params.StreamParams.SuccessCode<>Value then begin CheckActive; Params.StreamParams.SuccessCode:=Value; end; end; procedure TRtcBaseStreamDataProvider.SetSuccessText(Value: String); begin if Params.StreamParams.SuccessText<>Value then begin CheckActive; Params.StreamParams.SuccessText:=Value; end; end; procedure TRtcBaseStreamDataProvider.DoRequestDone(Sender: TRtcConnection); begin if Assigned(FOnRequestDone) then begin Sender.Sync(FOnRequestDone); end; DoSetHeader(Sender); end; procedure TRtcBaseStreamDataProvider.DoResponseStart(Sender: TRtcConnection); begin if not Assigned(FindSendStream(GetRequest(Sender).Info)) then begin CreateSendStream(Sender); //no stream for a sender type? call default stream create if Assigned(FindSendStream(GetRequest(Sender).Info)) then begin //(Sender as TRtcDataServer).WriteHeader; DoReadySend(Sender); end; end; end; procedure TRtcBaseStreamDataProvider.DoResponseDone(Sender: TRtcConnection); begin inherited; if Assigned(FOnResponseDone) then begin Sender.Sync(FOnResponseDone); end; SetStream(GetRequest(Sender).Info,RTC_STREAM_RCV,nil); SetStream(GetRequest(Sender).Info,RTC_STREAM_SND,nil); end; procedure TRtcBaseStreamDataProvider.DoSetHeader(Sender:TRtcConnection; DefaultCode:Integer=HTTP_NO_CODE; DefaultText:String=HTTP_NO_TEXT); var Code:Integer; begin Code:=GetResponse(Sender).StatusCode; //IF A PREVIOUS RESPONSE has been set, it STICKS if (Code=HTTP_NO_CODE) or (DefaultCode<>HTTP_NO_CODE) then begin //Good return can be overridden if DefaultCode>0 then begin SetStatus(GetResponse(Sender),DefaultCode,DefaultText); end else begin SetStatus(GetResponse(Sender),SuccessCode,SuccessText); end; end; end; procedure TRtcBaseStreamDataProvider.SetPermissionName(Value: String); begin if Params.SecurityParams.PermissionName<>Value then begin CheckActive; Params.SecurityParams.PermissionName:=Value; end; end; procedure TRtcBaseStreamDataProvider.SetRequiresLogin(Value: Boolean); begin if Params.SecurityParams.RequiresLogin<>Value then begin CheckActive; Params.SecurityParams.RequiresLogin:=Value; end; end; procedure TRtcBaseStreamDataProvider.SetRequiresRole(Value: String); begin if Params.SecurityParams.RequiresRole<>Value then begin CheckActive; Params.SecurityParams.RequiresRole:=Value; end; end; { TRtcFileDataProvider } constructor TRtcBaseFileDataProvider.Create(AOwner: TComponent); begin inherited; NamedRoot:=''; RelativePath:=True; CanAccessRoot:=False; CompleteAccess:=False; AutoMode:=amNone; ExpandedRoot:=''; end; procedure TRtcBaseFileDataProvider.Loaded; begin inherited; ExpandedRoot:=ResolveDir(NamedRoot,RelativePath); {ToDo: Anything else needs initialized here?} end; function TRtcBaseFileDataProvider.CreateSendStream(Sender:TRtcConnection):TStream; var ErrorCode:Integer; ErrorText:String; Filename:String; begin ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; Result:=inherited CreateSendStream(Sender); if (not Assigned(Result)) and (AutoMode=amSend) then begin //Use INBOUND FILENAME as send Filename:=GetRequest(Sender).Info.AsString[RTC_FILE_SND]; Result:=CreateSendFileStream(Filename,ErrorCode,ErrorText); if Assigned(Result) then begin if CanAccessFile(Filename,Params,Result.Size,ErrorCode,ErrorText) then begin SetStream(GetRequest(Sender).Info,RTC_STREAM_SND,Result); //set outbound stream.. GetResponse(Sender).DataSize:=Result.Size; end else begin FreeAndNil(Result); end; end; end; if not Assigned(Result) then begin //no outbound stream if (ErrorCode=HTTP_NO_CODE) then begin if AutoMode=amSend then begin //we expected one ErrorCode:=HTTP_NOT_FOUND_CODE; ErrorText:=HTTP_NOT_FOUND_TEXT; end; end; SetStatus(GetResponse(Sender),ErrorCode,ErrorText); end; end; function TRtcBaseFileDataProvider.CreateSaveStream(Sender: TRtcConnection):TStream; var ErrorCode:Integer; ErrorText:String; Filename:String; BufferName:String; begin Result:=inherited CreateSaveStream(Sender); if (not Assigned(Result)) and (AutoMode=amReceive) then begin //Use INBOUND FILENAME as send Filename:=GetRequest(Sender).Info.asString[RTC_FILE_RCV]; BufferName:=ResolveBufferFileName(GetRequest(Sender).Info,Filename,Params); if CanAccessFile(BufferName,Params,GetRequest(Sender).DataSize,ErrorCode,ErrorText) then begin Result:=CreateSaveFileStream(BufferName,ErrorCode,ErrorText); SetStream(GetRequest(Sender).Info,RTC_STREAM_RCV,Result); GetRequest(Sender).Info.AsString[RTC_FILE_RCV]:=Filename; GetRequest(Sender).Info.AsString[RTC_FILE_TMP]:=Buffername; end; end; if (not Assigned(Result)) or (ErrorCode<>HTTP_NO_CODE) then begin SetStatus(GetResponse(Sender),ErrorCode,ErrorText); end; end; procedure TRtcBaseFileDataProvider.DoInitialize(Sender: TRtcConnection); begin inherited; case AutoMode of amReceive: GetRequest(Sender).Info.AsString[RTC_FILE_RCV]:=ResolveFilename(GetRequest(Sender).FileName,Params); amSend: GetRequest(Sender).Info.AsString[RTC_FILE_SND]:=ResolveFilename(GetRequest(Sender).FileName,Params); end; end; procedure TRtcBaseFileDataProvider.DoResponseDone(Sender: TRtcConnection); var Filename,BufferName:String; Status:Integer; begin inherited; Filename:=GetRequest(Sender).Info.AsString[RTC_FILE_RCV]; BufferName:=GetRequest(Sender).Info.AsString[RTC_FILE_TMP]; Status:=GetResponse(Sender).StatusCode; if not CleanupFiles(Filename,Buffername,Status in [HTTP_SUCCESS_CODE,HTTP_NO_CODE]) then begin raise(Exception.Create('Could not clean up local buffer files')); end; end; procedure TRtcBaseFileDataProvider.SetExpandedRoot(Value: String); begin if Params.FileParams.ExpandedRoot<>Value then begin CheckActive; Params.FileParams.ExpandedRoot:=Value; end; end; procedure TRtcBaseFileDataProvider.SetAutoMode(Value:TRtcAutoMode); begin if Params.FileParams.AutoMode<>Value then begin CheckActive; Params.FileParams.AutoMode:=Value; end; end; procedure TRtcBaseFileDataProvider.SetRelativePath(Value: Boolean); begin if Params.FileParams.RelativePath<>Value then begin CheckActive; Params.FileParams.RelativePath:=Value; end; end; procedure TRtcBaseFileDataProvider.SetCanAccessRoot(Value: Boolean); begin if Params.FileParams.CanAccessRoot<>Value then begin CheckActive; Params.FileParams.CanAccessRoot:=Value; end; end; procedure TRtcBaseFileDataProvider.SetCompleteAccess(Value: Boolean); begin if Params.FileParams.CompleteAccess<>Value then begin CheckActive; Params.FileParams.CompleteAccess:=Value; end; end; procedure TRtcBaseFileDataProvider.SetNamedRoot(Value: String); begin if Params.FileParams.NamedRoot<>Value then begin CheckActive; Params.FileParams.NamedRoot:=Value; Params.FileParams.ExpandedRoot:=ResolveDir(NamedRoot,RelativePath); end; end; procedure TRtcBaseFileDataProvider.SetTempType(Value: TRtcTempType); begin if Params.FileParams.TempType<>Value then begin CheckActive; Params.FileParams.TempType:=Value; end; end; procedure TRtcBaseStreamDataProvider.Call_DataSent(Sender: TRtcConnection); begin inherited; if RemainSend(Sender)=0 then begin DoResponseDone(Sender); end; end; //============================================================================== { TRtcBaseStreamDataRequest } constructor TRtcBaseStreamDataRequest.Create(AOwner: TComponent); begin inherited; BufferSize:=DEFAULT_BUFFER_SIZE; FDefaultMethod:=''; FDefaultQuery:=''; end; destructor TRtcBaseStreamDataRequest.Destroy; begin inherited; end; procedure TRtcBaseStreamDataRequest.Call_ReadyToSend(Sender: TRtcConnection); begin inherited; DoReadyToSend(Sender); end; procedure TRtcBaseStreamDataRequest.Call_BeginRequest(Sender: TRtcConnection); var Stream:TStream; begin DoInitialize(Sender); inherited; if not GetRequest(Sender).Started then begin Stream:=CreateSendStream(Sender); if Assigned(Stream) then begin //TRtcDataClient(Sender).WriteHeader; DoReadyToSend(Sender); end else begin TRtcDataClient(Sender).WriteHeader; end; end; end; procedure TRtcBaseStreamDataRequest.Call_ResponseDone(Sender:TRtcConnection); begin inherited; DoResponseDone(Sender); end; procedure TRtcBaseStreamDataRequest.Call_DataReceived(Sender: TRtcConnection); begin inherited; DoReceive(Sender); end; procedure TRtcBaseStreamDataRequest.CheckActive; var Active:Boolean; begin Active:=False; if Assigned(Client) then begin Active:=Client.isConnected and (Client.TotalConnectionCount>0); end else if Assigned(Link) then begin Active:=Link.Client.isConnected and (Link.Client.TotalConnectionCount>0); end; if Active then raise(Exception.Create('Cannot set startup params while active')); end; procedure TRtcBaseStreamDataRequest.DoInitialize(Sender: TRtcConnection); begin SetID(GetRequest(Sender).Info,RTC_STREAM_RCV); //Set Message ID for Inbound items SetID(GetRequest(Sender).Info,RTC_STREAM_SND); //Set Message ID for Outbound items SetStatus(GetResponse(Sender),HTTP_NO_CODE,HTTP_NO_TEXT); //MESSAGE ID's SHOULD ALREADY BE SET end; procedure TRtcBaseStreamDataRequest.DoReadyToSend(Sender:TRtcConnection); var Remaining:Int64; ErrorCode:Integer; ErrorText:String; begin Remaining:=RemainSend(Sender); if Remaining>0 then begin SendChunk(Sender,GetRequest(Sender).Info,BufferSize,Remaining,ErrorCode,ErrorText); if (Remaining=0) or (ErrorCode<>HTTP_NO_CODE) then begin if ErrorCode<>HTTP_NO_CODE then begin //Would've like to used not Request.Complete, but gets triggered before Sender.Disconnect; end; end; end; end; procedure TRtcBaseStreamDataRequest.DoResponseDone(Sender: TRtcConnection); begin inherited; SetStream(GetRequest(Sender).Info,RTC_STREAM_SND,nil); SetStream(GetRequest(Sender).Info,RTC_STREAM_RCV,nil); end; function TRtcBaseStreamDataRequest.CreateSaveStream(Sender: TRtcConnection):TStream; begin Result:=FindStream(GetRequest(Sender).Info,RTC_STREAM_RCV,Sender,FOnGetSaveStream); end; procedure TRtcBaseStreamDataRequest.DoReceive(Sender:TRtcConnection); var Remain:Int64; ErrorCode:Integer; ErrorText:String; Stream:TStream; begin ErrorCode:=HTTP_NO_CODE; ErrorText:=HTTP_NO_TEXT; Remain:=RemainReceive(Sender); if Remain>0 then begin //Is there intent to receive information from a provider? if GetResponse(Sender).Started then begin //Brand new, let's get the stream... Stream:=CreateSaveStream(Sender); end else begin //continuation.. Stream:=FindRecvStream(GetRequest(Sender).Info); end; SaveChunk(Sender,Stream,Remain,ErrorCode,ErrorText); end; if (ErrorCode<>HTTP_NO_CODE) then begin Sender.Disconnect; end; end; function TRtcBaseStreamDataRequest.GetRequest(Sender: TRtcConnection): TRtcClientRequest; begin Result:=TRtcDataClient(Sender).Request; end; function TRtcBaseStreamDataRequest.GetResponse(Sender: TRtcConnection): TRtcClientResponse; begin Result:=TRtcDataClient(Sender).Response; end; procedure TRtcBaseStreamDataRequest.SetBufferSize(Value: Integer); begin if Params.StreamParams.BufferSize<>Value then begin CheckActive; Params.StreamParams.BufferSize:=Value end; end; procedure TRtcBaseStreamDataRequest.SetMaxDataSize(Value: Integer); begin if Params.StreamParams.MaxDataSize<>Value then begin CheckActive; Params.StreamParams.MaxDataSize:=Value; end; end; procedure TRtcBaseStreamDataRequest.SetSuccessCode(Value: Integer); begin if Params.StreamParams.SuccessCode<>Value then begin CheckActive; Params.StreamParams.SuccessCode:=Value; end; end; procedure TRtcBaseStreamDataRequest.SetSuccessText(Value: String); begin if Params.StreamParams.SuccessText<>Value then begin CheckActive; Params.StreamParams.SuccessText:=Value; end; end; function TRtcBaseStreamDataRequest.RemainReceive(Sender: TRtcConnection): Integer; begin Result:=GetResponse(Sender).DataSize-GetResponse(Sender).DataIn; end; function TRtcBaseStreamDataRequest.RemainSend(Sender: TRtcConnection): Integer; begin Result:=0; if Assigned(FindSendStream(GetRequest(Sender).Info)) and not GetRequest(Sender).Complete then begin Result:=GetRequest(Sender).DataSize-GetRequest(Sender).DataOut; end; end; procedure TRtcBaseStreamDataRequest.RequestNoPost(ServerName:String; Method:String=''; Query:String=''; SendID:String=''; ReceiveID:String=''); begin Request.Clear; SetID(Request.Info,RTC_STREAM_SND,SendID); //Set Message ID for Outbound items SetID(Request.Info,RTC_STREAM_RCV,ReceiveID); //Set Message ID for Inbound items Request.FileName:=ServerName; if Method='' then begin Method:=DefaultMethod; end; Request.Method:=Method; Request.Query.Clear; if Query='' then begin Query:=DefaultQuery; end; if Query<>'' then Request.Query.Text:=UrlString(Query); Request.Info.asDateTime[RTC_CLIENT_TIME]:=Now; //Pass as a QUERY for header end; procedure TRtcBaseStreamDataRequest.ReceiveStream(ServerName:String; Stream:TStream; Method:String=''; Query:String=''); begin RequestNoPost(ServerName,Method,Query); SetStream(Request.Info,RTC_STREAM_RCV,Stream,False); //Filestream could be !owned and be ok...hmmm.... Post; end; procedure TRtcBaseStreamDataRequest.SendStream(ServerName:String; Stream:TStream; OwnsStream:Boolean=True; Method:String=''; Query:String=''); begin RequestNoPost(ServerName,Method,Query); SetStream(Request.Info,RTC_STREAM_SND,Stream,OwnsStream); Request.DataSize:=Stream.Size; Post; end; procedure TRtcBaseStreamDataRequest.SendReceiveStream(ServerName:String; SendStream,RecvStream:TStream; OwnsSend:Boolean=True; OwnsRecv:Boolean=False; Method:String=''; Query:String=''); begin RequestNoPost(ServerName,Method,Query); SetStream(Request.Info,RTC_STREAM_SND,SendStream,OwnsSend); SetStream(Request.Info,RTC_STREAM_RCV,RecvStream,OwnsRecv); Request.DataSize:=SendStream.Size; Post; end; function TRtcBaseStreamDataRequest.CreateSendStream(Sender: TRtcConnection): TStream; begin Result:=FindStream(GetRequest(Sender).Info,RTC_STREAM_SND,Sender,FOnGetSendStream); //Outgoing stream has been defined. if Assigned(Result) then begin GetRequest(Sender).DataSize:=Result.Size; end; end; procedure TRtcBaseStreamDataRequest.Call_ResponseAbort(Sender: TRtcConnection); begin inherited; DoResponseAbort(Sender); end; procedure TRtcBaseStreamDataRequest.DoResponseAbort(Sender: TRtcConnection); begin SetSendStream(GetRequest(Sender).Info,nil); SetRecvStream(GetRequest(Sender).Info,nil); end; { TRtcBaseFileRequest } constructor TRtcBaseFileRequest.Create(AOwner: TComponent); begin inherited; Params.FileParams.CanAccessRoot:=True; Params.FileParams.CompleteAccess:=True; Params.FileParams.NamedRoot:=''; Params.FileParams.RelativePath:=True; //? end; function TRtcBaseFileRequest.CreateSaveStream(Sender: TRtcConnection):TStream; var Filename:String; Temp:String; ErrorCode:Integer; ErrorText:String; begin Result:=inherited CreateSaveStream(Sender); if not Assigned(Result) then begin //Stream not defined, but user may've set filensmaes Filename:=GetRequest(Sender).Info.AsString[RTC_FILE_RCV]; Temp:=GetRequest(Sender).Info.AsString[RTC_FILE_TMP]; if Length(Filename)=0 then begin raise Exception.Create('No filename set in: '+RTC_FILE_RCV); end else if Length(Temp)>0 then begin Filename:=Temp; end; if Length(Filename)>0 then begin Result:=CreateSaveFileStream(Filename,ErrorCode,ErrorText); if Assigned(Result) then begin SetStream(GetRequest(Sender).Info,RTC_STREAM_RCV,Result); end else begin raise Exception.Create(ErrorText); end; end; end; end; procedure TRtcBaseFileRequest.DoInitialize(Sender: TRtcConnection); begin inherited; end; procedure TRtcBaseFileRequest.DoResponseAbort(Sender: TRtcConnection); var Filename,BufferName:String; begin inherited; Filename:=GetRequest(Sender).Info.AsString[RTC_FILE_RCV]; BufferName:=GetRequest(Sender).Info.AsString[RTC_FILE_TMP]; if not CleanupFiles(Filename,BufferName,False) then begin raise(Exception.Create('Could not clean up local aborted buffer files')); end; end; procedure TRtcBaseFileRequest.DoResponseDone(Sender: TRtcConnection); var Filename,BufferName:String; Status:Integer; begin inherited; Filename:=GetRequest(Sender).Info.AsString[RTC_FILE_RCV]; BufferName:=GetRequest(Sender).Info.AsString[RTC_FILE_TMP]; Status:=GetResponse(Sender).StatusCode; if not CleanupFiles(Filename,BufferName,Status in [HTTP_SUCCESS_CODE,HTTP_NO_CODE]) then begin raise(Exception.Create('Could not clean up local buffer files')); end; end; procedure TRtcBaseFileRequest.Loaded; begin inherited; Params.FileParams.ExpandedRoot:=ResolveDir(Params.FileParams.NamedRoot,Params.FileParams.RelativePath); end; procedure TRtcBaseFileRequest.ReceiveFile(ServerName:String; LocalName:String=''; Method:String=''; Query:String=''; BufferTo:String=''); var Stream:TFileStream; ErrorCode:Integer; ErrorText:String; Filename:String; ReceiveID:String; begin ReceiveID:=SetID(Request.Info,RTC_STREAM_RCV); //Set Message ID for Inbound items if LocalName='' then LocalName:=ExtractFilePath(ServerName); Request.Info[RTC_FILE_RCV]:=LocalName; Filename:=LocalName; if BufferTo='' then begin //No BufferTo name, use same methodology as server's TempType=ttGuid BufferTo:=ResolveBufferFilename(Request.Info,Filename,Params); end; if not SameText(BufferTo,LocalName) then begin Request.Info.AsString[RTC_FILE_TMP]:=BufferTo; //Just a note that we're buffering to this name Filename:=BufferTo; end; if FileExists(LocalName) and not DeleteFile(LocalName) then begin raise Exception.Create('Could not delete target: '+LocalName); end else begin Stream:=TFileStream(CreateSaveFileStream(Filename,ErrorCode,ErrorText)); if Assigned(Stream) then begin RequestNoPost(ServerName,Method,Query,'',ReceiveID); SetStream(Request.Info,RTC_STREAM_RCV,Stream,True); //register our file that we're saving to Post; end else begin raise Exception.Create(ErrorText); end; end; end; procedure TRtcBaseFileRequest.SendFile(LocalName:String; ServerName:String=''; Method:String=''; Query:String=''); var ErrorCode:Integer; ErrorText:String; Stream:TStream; begin if ServerName='' then ServerName:=ExtractFileName(LocalName); RequestNoPost(ServerName,Method,Query); Stream:=CreateSendFileStream(LocalName,ErrorCode,ErrorText); if Assigned(Stream) then begin SetStream(Request.Info,RTC_STREAM_SND,Stream,True); Post; end else begin raise(Exception.Create('Unable to send file: '+IntToStr(ErrorCode)+':'+ErrorText)); end; end; { TRtcSecureFunction } function TRtcSecureFunction.Call_Execute(Sender: TRtcConnection; Param: TRtcFunctionInfo; Res: TRtcValue): boolean; begin if SameText(Param.FunctionName,FunctionName) then begin if DoSecurityCheck(Sender,Params) then begin Result:=inherited Call_Execute(Sender,Param,Res); end else begin Res.asException:='Insufficient Permissions'; Result:=True; end; end else begin Result:=inherited Call_Execute(Sender,Param,Res); end; end; constructor TRtcSecureFunction.Create(AOwner: TComponent); begin inherited; PermissionName:=''; RequiresRole:=''; RequiresLogin:=True; end; procedure TRtcSecureFunction.SetPermissionName(Value: String); begin if Params.PermissionName<>Value then begin //CheckActive? Params.PermissionName:=Value; end; end; procedure TRtcSecureFunction.SetRequiresLogin(Value: Boolean); begin if Params.RequiresLogin<>Value then begin //CheckActive? Params.RequiresLogin:=Value; end; end; procedure TRtcSecureFunction.SetRequiresRole(Value: String); begin if Params.RequiresRole<>Value then begin //CheckActive? Params.RequiresRole:=Value; end; end; initialization ManagedStreams:=TRtcManagedList.Create; finalization FreeAndNil(ManagedStreams); end.