rtcinfo.pas

Delphi快速开发Web Server

                    ft_Array, // rtc_Array
                    ft_ADT, // rtc_Record
                    ft_DataSet, // rtc_DataSet
                    ft_String, // rtc_Text
                    ft_String, // rtc_String
                    ft_WideString, // rtc_WideString
                    ft_Boolean, // rtc_Boolean
                    ft_Integer, // rtc_Integer
                    ft_Largeint, // rtc_LargeInt
                    ft_Float, // rtc_Float
                    ft_Currency, // rtc_Currency
                    ft_DateTime, // rtc_DateTime
                    ft_Blob, // rtc_ByteStream
                    ft_Unknown);

type
  { All RTC components use at least one class declared in this unit.

    For Delphi to add this unit to uses clause,
    all RTC components inherit from this class.

    @exclude }
  TRtc_Component = class(TComponent);

  // Type to use to store Floating-point values (default:double; could be changed to "extended" for maximum precision)
  rtcFloat = double;

  // Type to use to store Integer values (default:LongInt; could be changed to "int64" for maximum precision)
  rtcInteger = longint;

  // Type to use to store LargeInt values (default:int64)
  rtcLargeInt = int64;

  // Type to use to store ByteStream data (default:TMemoryStream);
  rtcByteStream = TMemoryStream;

  // @exclude
  rtcClosingTagsType = array of string;

  { @abstract(Basic class for 'storable' objects)

    This is the object class which has to be extended
    with your object information if you want to pass
    objects to RTC components. }
  TRtcObject = class
    { Implement the Kill method so it releases the object from memory.
      Calling 'Free' from anyone else than the class creator (you)
      could result in freeing objects more than once, which is "unhealthy".
      The Kill method will be called on all objects that still
      remain in the list (info list, job queue, etc) when the
      list is being cleared, for whatever reason. }
    procedure Kill; virtual; abstract;
    end;

  TRtcFunctionInfo = class; // forward

  TRtcValue = class; // forward
  TRtcValueObject = class; // forward
  TRtcDataSet = class; // forward
  TRtcRecord = class; // forward
  TRtcArray = class; // forward
  TRtcVariableName = class; // forward
  TRtcExceptionValue = class; // forward
  TRtcByteStream = class; // forward

  { @abstract(All RTC Value Objects extend this class) }
  TRtcValueObject = class(TRtcObject)
  protected
    // @exclude
    function GetTypeStr:String;
    // @exclude
    procedure CopyFrom(Value:TRtcValueObject); virtual; abstract;

    { Check object type
      @exclude}
    function GetType:TRtcValueTypes; virtual; abstract;

    // @exclude
    class function ObjectFromVariant(const v:Variant):TRtcValueObject;

    // @exclude
    class function ObjectFromType(const typ:TRtcValueTypes):TRtcValueObject;

    {*** RTC format serializing and deserializing functions ***}

    // @exclude
    class function code_toLongString(const typ, s:String):String;
    // @exclude
    class function code_toByteStream(const typ:string; bs:TStream):String;
    // @exclude
    class function code_toShortString(const typ, s:String):String;
    // @exclude
    class function code_toNameString(const s:String):String;
    // @exclude
    class function code_toMidString(const s:String):String;
    // @exclude
    class function code_toEndString(const s:String):String;

    // @exclude
    class function code_checkStrType(const s:String; const at:integer):TRtcValueTypes;
    // @exclude
    class function code_fromLongString(const typ:String; const s:String; var at:integer):String;
    // @exclude
    class procedure code_fromByteStream(const typ:String; const s:String; var at:integer; const bs:TStream);
    // @exclude
    class function code_fromShortString(const typ:String; const s:String; var at:integer):String;
    // @exclude
    class function code_fromNameString(const s: String; var at:integer):String;
    // @exclude
    class function code_fromMidString(const s: String; var at:integer):String;
    // @exclude
    class function code_fromEndString(const s: String; var at:integer):String;

    // @exclude
    class function ObjectFromCode(const s:String; var at:integer):TRtcValueObject; overload;
    // @exclude
    class function ObjectFromCode(const s:String):TRtcValueObject; overload;

    { Fill object information from String, starting after character
      at position 'at' and move 'at' accordingly.
      Before the first call to from_Code, 'at' has to be 0 (zero).
      When the whole String was processed, 'at' will equal length(s).
      @exclude }
    procedure from_Code(const s:String; var at:integer); overload; virtual; abstract;
    { Fill object information from String.
      @exclude }
    procedure from_Code(const s:String); overload;

    {*** XML RPC serilizing and deserializing functions ***}

    // @exclude
    class function xmlrpc_FirstCloseTag(var closing_tags:rtcClosingTagsType):string;
    // @exclude
    class procedure xmlrpc_OpenTag(const tag:string; var closing_tags:rtcClosingTagsType);
    // @exclude
    class function xmlrpc_CloseTag(const tag:string; var closing_tags:rtcClosingTagsType):boolean;
    // @exclude
    class function xmlrpc_TagsToXML(var closing:rtcClosingTagsType):string;

    // @exclude
    class function xmlrpc_checkStrType(const s:String; const at:integer):TRtcValueTypes;
    // @exclude
    class procedure xmlrpc_skipWhitespace(const s:String; var at:integer);
    // @exclude
    class function xmlrpc_checkTag(const s:String; at:integer):string;
    // @exclude
    class procedure xmlrpc_skipTag(const s:String; var at:integer; skipWhitespace:boolean=True);
    // @exclude
    class function xmlrpc_readTag(const s:String; var at:integer; const tag_want:string=''; skipWhitespace:boolean=True):string;
    // @exclude
    class function xmlrpc_readValue(const s:String; var at:integer):string;
    // @exclude
    class function xmlrpc_readTrimValue(const s:String; var at:integer):string;
    // @exclude
    class procedure xmlrpc_skipNull(const s: String; var at: integer);

    // @exclude
    class procedure xmlrpc_readByteStream(const s:String; var at:integer; const bs:TStream);
    // @exclude
    class function xmlrpc_writeByteStream(bs:TStream):string;
    // @exclude
    class function xmlrpc_readString(const s:String; var at:integer):string;
    // @exclude
    class function xmlrpc_writeString(const s:String):String;

    // @exclude
    class procedure xmlrpc_skipValueOpen(const tag:string; const s: String; var at: integer; var closing_tags:rtcClosingTagsType);
    // @exclude
    class procedure xmlrpc_skipValueClose(const s:String; var at:integer; var closing_tags:rtcClosingTagsType);

    // @exclude
    class function ObjectFromXMLrpc(const s:String; var at:integer):TRtcValueObject; overload;
    // @exclude
    class function ObjectFromXMLrpc(const s:String):TRtcValueObject; overload;

    { Fill object information from XML RPC String, starting after character
      at position 'at' and move 'at' accordingly.
      Before the first call to from_XMLRPC, 'at' has to be 0 (zero).
      When the whole String was processed, 'at' will equal length(s).
      @exclude }
    procedure from_XMLrpc(const s:String; var at:integer); overload; virtual; abstract;
    { Fill object information from String.
      @exclude }
    procedure from_XMLrpc(const s:String); overload;

  public
    // @exclude
    procedure Kill; override;

    { Returns exact copy of the object. @html(<br>)
      When assigning the object to structures other than those extending TRtcValueObject,
      if you want to keep one object instance for yourself,
      you can use 'copyOf' to assign a copy of this object instead of the original. }
    function copyOf:TRtcValueObject; virtual; abstract;

    { Create a String containing all object information,
      serialized using a packed RTC-coded format. }
    procedure to_Code(const Result:TRtcHugeString); virtual; abstract;

    { Create a String containing all object information,
      serialized using a packed RTC-coded format. }
    function toCode:String;

    { Create the XML-RPC string containing all object information,
      serialized using the XML RPC standard format. }
    procedure to_XMLRPC(const Result:TRtcHugeString); virtual; abstract;

    { Create the XML-RPC string containing all object information,
      serialized using the XML RPC standard format. }
    function toXMLrpc:String;

    { Create the XML-RPC string containing all object information,
      packed in the XML-RPC request header and footer. }
    function toXMLrpcRequest:string;

    { Create the XML-RPC string containing all object information,
      packed in the XML-RPC response header and footer. }
    function toXMLrpcResponse:string;
    end;

  // @exclude
  TRtcSimpleValue = class(TRtcValueObject)
  public
    function GetBoolean: boolean; virtual;
    function GetCurrency: Currency; virtual;
    function GetDateTime: TDateTime; virtual;
    function GetException: String; virtual;
    function GetVarName: String; virtual;
    function GetInteger: rtcInteger; virtual;
    function GetLargeInt: rtcLargeInt; virtual;
    function GetFloat: rtcFloat; virtual;
    function GetString: String; virtual;
    function GetWideString: WideString; virtual;
    function GetText: String; virtual;
    function GetByteStream: TStream; virtual;

    procedure SetNull(const Value: boolean); virtual;

    procedure SetBoolean(const Value: boolean); virtual;
    procedure SetCurrency(const Value: Currency); virtual;
    procedure SetDateTime(const Value: TDateTime); virtual;
    procedure SetException(const Value: String); virtual;
    procedure SetVarName(const Value: String); virtual;
    procedure SetInteger(const Value: rtcInteger); virtual;
    procedure SetLargeInt(const Value: rtcLargeInt); virtual;
    procedure SetFloat(const Value: rtcFloat); virtual;
    procedure SetString(const Value: String); virtual;
    procedure SetWideString(const Value: WideString); virtual;
    procedure SetText(const Value: String); virtual;
    procedure SetByteStream(const Value:TStream); virtual;

    function GetVariant: Variant; virtual;
    function SetVariant(const Value: Variant):boolean; virtual;
    end;

  // @exclude
  TRtcByteStream = class(TRtcSimpleValue)
  private
    FValue:TStream;

  protected
    class function NullValue:TStream;
    procedure CopyFrom(Value:TRtcValueObject); override;

    { Fill object information from String, starting after character
      at position 'at' and move 'at' accordingly.
      Before the first call to from_Code, 'at' has to be 0 (zero).
      When the whole String was processed, 'at' will equal length(s).
      @exclude }
    procedure from_Code(const s:String; var at:integer); override;

    { Fill object information from XML-RPC String, starting after character
      at position 'at' and move 'at' accordingly.
      Before the first call to from_XMLRPC, 'at' has to be 0 (zero).
      When the whole String was processed, 'at' will equal length(s).
      @exclude }
    procedure from_XMLrpc(const s:String; var at:integer); override;

  public
    constructor Create; overload;
    constructor Create(const Value:TStream); overload;

    destructor Destroy; override;

    procedure SetNull(const Value: boolean); override;

    function GetType:TRtcValueTypes; override;

    function GetByteStream: TStream; override;
    procedure SetByteStream(const Value: TStream); override;

    function GetString: String; override;
    function GetVariant: Variant; override;

    { Returns exact copy of the object. @html(<br>)
      When assigning the object to structures other than those extending TRtcValueObject,
      if you want to keep one object instance for yourself,
      you can use 'copyOf' to assign a copy of this object instead of the original. }
    function copyOf:TRtcValueObject; override;

    { Create a String containing all object information. }
    procedure to_Code(const Result:TRtcHugeString); override;
    { Create a XML-RPC String containing all object information. }
    procedure to_XMLRPC(const Result:TRtcHugeString); override;
    end;