diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index 74fb3b5c7..25d4d7c4d 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -303,76 +303,79 @@ type const AData : Pointer );{$IFDEF USE_INLINE}inline;{$ENDIF} - function GetDataBuffer(var AName : String):PDataBuffer;{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetEnum( + function GetDataBuffer( + var AName : string; + out AResultBuffer : PDataBuffer + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetEnum( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TEnumData - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetBool( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetBool( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Boolean - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetAnsiChar( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetAnsiChar( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : AnsiChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetWideChar( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetWideChar( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : WideChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetFloat( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetFloat( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TFloat_Extended_10 - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetInt( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetInt( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TInt64S - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetInt64( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetInt64( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Int64 - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF HAS_QWORD} - procedure GetUInt64( + function GetUInt64( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : QWord - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF} - procedure GetAnsiStr( + function GetAnsiStr( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : AnsiString - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetWideStr( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetWideStr( const ATypeInfo : PTypeInfo; var AName : String; var AData : WideString - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF WST_UNICODESTRING} - procedure GetUnicodeStr( + function GetUnicodeStr( const ATypeInfo : PTypeInfo; var AName : String; var AData : UnicodeString - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF WST_UNICODESTRING} - procedure GetObj( + function GetObj( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TObject - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetRecord( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} public constructor Create();override; destructor Destroy();override; @@ -429,22 +432,22 @@ type const ATypeInfo : PTypeInfo; const AData ); - procedure Get( + function Get( const ATypeInfo : PTypeInfo; var AName : string; var AData - );overload; - procedure Get( + ) : Boolean;overload; + function Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData - );overload; + ) : Boolean; overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData ); - function ReadBuffer(const AName : string) : string; + function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean; procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); @@ -1162,154 +1165,200 @@ begin TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo); end; -function TBaseBinaryFormatter.GetDataBuffer(var AName: String): PDataBuffer; +function TBaseBinaryFormatter.GetDataBuffer( + var AName: string; + out AResultBuffer : PDataBuffer +) : Boolean; begin - Result := StackTop().Find(AName); - If Not Assigned(Result) Then - Error('Param not found : "%s"',[AName]); + AResultBuffer := StackTop().Find(AName); + Result := ( AResultBuffer <> nil ); end; -procedure TBaseBinaryFormatter.GetEnum( +function TBaseBinaryFormatter.GetEnum( const ATypeInfo: PTypeInfo; var AName: String; var AData: TEnumData -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.EnumData; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.EnumData; end; -procedure TBaseBinaryFormatter.GetBool( +function TBaseBinaryFormatter.GetBool( const ATypeInfo: PTypeInfo; var AName: String; var AData: Boolean -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.BoolData; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.BoolData; end; -procedure TBaseBinaryFormatter.GetAnsiChar( +function TBaseBinaryFormatter.GetAnsiChar( const ATypeInfo: PTypeInfo; var AName: String; var AData: AnsiChar -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.AnsiCharData; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.AnsiCharData; end; -procedure TBaseBinaryFormatter.GetWideChar( +function TBaseBinaryFormatter.GetWideChar( const ATypeInfo: PTypeInfo; var AName: String; var AData: WideChar -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.WideCharData; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.WideCharData; end; -procedure TBaseBinaryFormatter.GetFloat( +function TBaseBinaryFormatter.GetFloat( const ATypeInfo : PTypeInfo; var AName : String; var AData : TFloat_Extended_10 -); -Var - t : PDataBuffer; +) : Boolean; +var + locBuffer : PDataBuffer; begin - t := GetDataBuffer(AName); - Case GetTypeData(ATypeInfo)^.FloatType Of - ftSingle : AData := t^.SingleData; - ftDouble : AData := t^.DoubleData; - ftExtended : AData := t^.ExtendedData; - ftCurr : AData := t^.CurrencyData; - Else - AData := t^.ExtendedData; - End; + Result := GetDataBuffer(AName,locBuffer); + if Result then begin + case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : AData := locBuffer^.SingleData; + ftDouble : AData := locBuffer^.DoubleData; + ftExtended : AData := locBuffer^.ExtendedData; + ftCurr : AData := locBuffer^.CurrencyData; + else + AData := locBuffer^.ExtendedData; + end; + end; end; -procedure TBaseBinaryFormatter.GetInt( +function TBaseBinaryFormatter.GetInt( const ATypeInfo: PTypeInfo; var AName: String; var AData: TInt64S -); -Var - t : PDataBuffer; +) : Boolean; +var + locBuffer : PDataBuffer; begin - t := GetDataBuffer(AName); - Case GetTypeData(ATypeInfo)^.OrdType Of - otSByte : AData := t^.Int8S; - otUByte : AData := t^.Int8U; - otSWord : AData := t^.Int16S; - otUWord : AData := t^.Int16U; - otSLong : AData := t^.Int32S; - otULong : AData := t^.Int32U; - Else - Assert(False); - End; + Result := GetDataBuffer(AName,locBuffer); + if Result then begin + case GetTypeData(ATypeInfo)^.OrdType of + otSByte : AData := locBuffer^.Int8S; + otUByte : AData := locBuffer^.Int8U; + otSWord : AData := locBuffer^.Int16S; + otUWord : AData := locBuffer^.Int16U; + otSLong : AData := locBuffer^.Int32S; + otULong : AData := locBuffer^.Int32U; + Else + Assert(False); + end; + end; end; -procedure TBaseBinaryFormatter.GetInt64( +function TBaseBinaryFormatter.GetInt64( const ATypeInfo: PTypeInfo; var AName: String; var AData: Int64 -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.Int64S; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.Int64S; end; {$IFDEF HAS_QWORD} -procedure TBaseBinaryFormatter.GetUInt64( +function TBaseBinaryFormatter.GetUInt64( const ATypeInfo: PTypeInfo; var AName: String; var AData: QWord -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.Int64U; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.Int64U; end; {$ENDIF HAS_QWORD} -procedure TBaseBinaryFormatter.GetAnsiStr( +function TBaseBinaryFormatter.GetAnsiStr( const ATypeInfo: PTypeInfo; var AName: String; var AData: AnsiString -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.AnsiStrData^.Data; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.AnsiStrData^.Data; end; -procedure TBaseBinaryFormatter.GetWideStr( +function TBaseBinaryFormatter.GetWideStr( const ATypeInfo: PTypeInfo; var AName: String; var AData: WideString -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.WideStrData^.Data; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.WideStrData^.Data; end; {$IFDEF WST_UNICODESTRING} -procedure TBaseBinaryFormatter.GetUnicodeStr( +function TBaseBinaryFormatter.GetUnicodeStr( const ATypeInfo: PTypeInfo; var AName: String; var AData: UnicodeString -); +) : Boolean; +var + locBuffer : PDataBuffer; begin - AData := GetDataBuffer(AName)^.UnicodeStrData^.Data; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer^.UnicodeStrData^.Data; end; {$ENDIF WST_UNICODESTRING} -procedure TBaseBinaryFormatter.GetObj( +function TBaseBinaryFormatter.GetObj( const ATypeInfo: PTypeInfo; var AName: String; var AData: TObject -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); + Result := True; end; -procedure TBaseBinaryFormatter.GetRecord( +function TBaseBinaryFormatter.GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); + Result := True; end; procedure TBaseBinaryFormatter.Clear(); @@ -1731,11 +1780,11 @@ begin end; end; -procedure TBaseBinaryFormatter.Get( +function TBaseBinaryFormatter.Get( const ATypeInfo: PTypeInfo; var AName: String; var AData -); +) : Boolean; Var int64Data : Int64; {$IFDEF HAS_QWORD} @@ -1758,67 +1807,76 @@ begin tkInt64 : Begin int64Data := 0; - GetInt64(ATypeInfo,AName,int64Data); - Int64(AData) := int64Data; + Result := GetInt64(ATypeInfo,AName,int64Data); + if Result then + Int64(AData) := int64Data; End; {$IFDEF HAS_QWORD} tkQWord : Begin uint64Data := 0; - GetUInt64(ATypeInfo,AName,uint64Data); - QWord(AData) := uint64Data; + Result := GetUInt64(ATypeInfo,AName,uint64Data); + if Result then + QWord(AData) := uint64Data; End; {$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; - GetAnsiStr(ATypeInfo,AName,strData); - String(AData) := strData; + Result := GetAnsiStr(ATypeInfo,AName,strData); + if Result then + String(AData) := strData; End; tkWString : begin wideStrData := ''; - GetWideStr(ATypeInfo,AName,wideStrData); - WideString(AData) := wideStrData; + Result := GetWideStr(ATypeInfo,AName,wideStrData); + if Result then + WideString(AData) := wideStrData; end; {$IFDEF WST_UNICODESTRING} tkUString : begin unicodeStrData := ''; - GetUnicodeStr(ATypeInfo,AName,unicodeStrData); - UnicodeString(AData) := unicodeStrData; + Result := GetUnicodeStr(ATypeInfo,AName,unicodeStrData); + if Result then + UnicodeString(AData) := unicodeStrData; end; {$ENDIF WST_UNICODESTRING} tkClass : Begin objData := TObject(AData); - GetObj(ATypeInfo,AName,objData); - TObject(AData) := objData; + Result := GetObj(ATypeInfo,AName,objData); + if Result then + TObject(AData) := objData; End; tkRecord : begin recObject := Pointer(@AData); - GetRecord(ATypeInfo,AName,recObject); + Result := GetRecord(ATypeInfo,AName,recObject); end; {$IFDEF FPC} tkBool : Begin boolData := False; - GetBool(ATypeInfo,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,AName,boolData); + if Result then + Boolean(AData) := boolData; End; {$ENDIF} tkChar : begin ansiCharData := #0; - GetAnsiChar(ATypeInfo,AName,ansiCharData); - AnsiChar(AData) := ansiCharData; + Result := GetAnsiChar(ATypeInfo,AName,ansiCharData); + if Result then + AnsiChar(AData) := ansiCharData; end; tkWChar : begin wideCharData := #0; - GetWideChar(ATypeInfo,AName,wideCharData); - WideChar(AData) := wideCharData; + Result := GetWideChar(ATypeInfo,AName,wideCharData); + if Result then + WideChar(AData) := wideCharData; end; tkInteger, tkEnumeration : Begin @@ -1827,23 +1885,26 @@ begin ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin boolData := False; - GetBool(ATypeInfo,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,AName,boolData); + if Result then + Boolean(AData) := boolData; end else begin {$ENDIF} enumData := 0; If ( ATypeInfo^.Kind = tkInteger ) Then - GetInt(ATypeInfo,AName,enumData) + Result := GetInt(ATypeInfo,AName,enumData) Else - GetEnum(ATypeInfo,AName,enumData); - Case GetTypeData(ATypeInfo)^.OrdType Of - otSByte : ShortInt(AData) := enumData; - otUByte : Byte(AData) := enumData; - otSWord : SmallInt(AData) := enumData; - otUWord : Word(AData) := enumData; - otSLong : LongInt(AData) := enumData; - otULong : LongWord(AData) := enumData; - End; + Result := GetEnum(ATypeInfo,AName,enumData); + if Result then begin + Case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : ShortInt(AData) := enumData; + otUByte : Byte(AData) := enumData; + otSWord : SmallInt(AData) := enumData; + otUWord : Word(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; + End; + end; {$IFNDEF FPC} end; {$ENDIF} @@ -1851,28 +1912,32 @@ begin tkFloat : Begin floatDt := 0; - GetFloat(ATypeInfo,AName,floatDt); - Case GetTypeData(ATypeInfo)^.FloatType Of - ftSingle : Single(AData) := floatDt; - ftDouble : Double(AData) := floatDt; - ftExtended : Extended(AData) := floatDt; - ftCurr : Currency(AData) := floatDt; + Result := GetFloat(ATypeInfo,AName,floatDt); + if Result then begin + Case GetTypeData(ATypeInfo)^.FloatType Of + ftSingle : Single(AData) := floatDt; + ftDouble : Double(AData) := floatDt; + ftExtended : Extended(AData) := floatDt; + ftCurr : Currency(AData) := floatDt; {$IFDEF HAS_COMP} - ftComp : Comp(AData) := floatDt; + ftComp : Comp(AData) := floatDt; {$ENDIF} - End; - End; - End; + End; + end + end; + else + Result := False; + end; end; -procedure TBaseBinaryFormatter.Get( +function TBaseBinaryFormatter.Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData -); +) : Boolean; begin - Get(ATypeInfo,AName,AData); + Result := Get(ATypeInfo,AName,AData); end; procedure TBaseBinaryFormatter.GetScopeInnerValue( @@ -1953,7 +2018,7 @@ begin end; end; -function TBaseBinaryFormatter.ReadBuffer (const AName : string ) : string; +function TBaseBinaryFormatter.ReadBuffer (const AName : string; out AResBuffer : string) : Boolean; Var locStore : IDataStore; bffr : PDataBuffer; @@ -1961,14 +2026,16 @@ Var locStream : TStringStream; begin locName := AName; - bffr := GetDataBuffer(locName); - locStream := TStringStream.Create(''); - try - locStore := CreateBinaryWriter(locStream); - SaveObjectToStream(bffr,locStore); - Result := locStream.DataString; - finally - locStream.Free(); + Result := GetDataBuffer(locName,bffr); + if Result then begin + locStream := TStringStream.Create(''); + try + locStore := CreateBinaryWriter(locStream); + SaveObjectToStream(bffr,locStore); + AResBuffer := locStream.DataString; + finally + locStream.Free(); + end; end; end; diff --git a/wst/trunk/base_json_formatter.pas b/wst/trunk/base_json_formatter.pas index b5c51f1df..98a3034a9 100644 --- a/wst/trunk/base_json_formatter.pas +++ b/wst/trunk/base_json_formatter.pas @@ -269,78 +269,81 @@ type const AData : Pointer );{$IFDEF USE_INLINE}inline;{$ENDIF} - function GetDataBuffer(var AName : String):TJSONData;{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetEnum( + function GetDataBuffer( + var AName : string; + out AResBuffer : TJSONData + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetEnum( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TEnumIntType - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetBool( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetBool( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Boolean - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF FPC} - procedure GetAnsiChar( + function GetAnsiChar( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : AnsiChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetWideChar( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetWideChar( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : WideChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetInt( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetInt( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Integer - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF} - procedure GetInt64( + function GetInt64( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Int64 - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF HAS_QWORD} - procedure GetUInt64( + function GetUInt64( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : QWord - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF HAS_QWORD} - procedure GetFloat( + function GetFloat( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Extended - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetStr( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetStr( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : String - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF WST_UNICODESTRING} - procedure GetUnicodeStr( + function GetUnicodeStr( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : UnicodeString - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF WST_UNICODESTRING} - procedure GetWideStr( + function GetWideStr( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : WideString - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetObj( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetObj( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TObject - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetRecord( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} public procedure SetSerializationStyle(const ASerializationStyle : TSerializationStyle); function GetSerializationStyle():TSerializationStyle; @@ -395,22 +398,22 @@ type const ATypeInfo : PTypeInfo; const AData ); - procedure Get( + function Get( const ATypeInfo : PTypeInfo; var AName : string; var AData - );overload; - procedure Get( + ) : Boolean;overload; + function Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData - );overload; + ) : Boolean;overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData ); - function ReadBuffer(const AName : string) : string; + function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean; procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); @@ -593,167 +596,213 @@ begin TRemotableRecordEncoder.Save(AData,Self,AName,ATypeInfo); end; -function TJsonRpcBaseFormatter.GetDataBuffer(var AName : String) : TJSONData; +function TJsonRpcBaseFormatter.GetDataBuffer( + var AName : string; + out AResBuffer : TJSONData +) : Boolean; begin - Result := StackTop().FindNode(AName); - if not Assigned(Result) then - Error('Param not found : "%s"',[AName]); + AResBuffer := StackTop().FindNode(AName); + Result := ( AResBuffer <> nil ); end; -procedure TJsonRpcBaseFormatter.GetEnum( +function TJsonRpcBaseFormatter.GetEnum( const ATypeInfo : PTypeInfo; var AName : String; var AData : TEnumIntType -); -begin - AData := GetDataBuffer(AName).AsInteger; -end; - -procedure TJsonRpcBaseFormatter.GetBool( - const ATypeInfo : PTypeInfo; - var AName : String; - var AData : Boolean -); -begin - AData := GetDataBuffer(AName).AsBoolean; -end; - -procedure TJsonRpcBaseFormatter.GetAnsiChar( - const ATypeInfo: PTypeInfo; - var AName: String; - var AData: AnsiChar -); -var - tmpString : TJSONStringType; -begin - tmpString := GetDataBuffer(AName).AsString; - if ( Length(tmpString) > 0 ) then - AData := tmpString[1] - else - AData := #0; -end; - -procedure TJsonRpcBaseFormatter.GetWideChar( - const ATypeInfo: PTypeInfo; - var AName: String; - var AData: WideChar -); -var - tmpString : TJSONStringType; -begin - tmpString := GetDataBuffer(AName).AsString; - if ( Length(tmpString) > 0 ) then - AData := tmpString[1] - else - AData := #0; -end; - -procedure TJsonRpcBaseFormatter.GetInt( - const ATypeInfo : PTypeInfo; - var AName : String; - var AData : Integer -); -begin - AData := GetDataBuffer(AName).AsInteger; -end; - -procedure TJsonRpcBaseFormatter.GetInt64( - const ATypeInfo : PTypeInfo; - var AName : String; - var AData : Int64 -); +) : Boolean; var locBuffer : TJSONData; begin - locBuffer := GetDataBuffer(AName); - if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then - AData := locBuffer.AsInteger - else - AData := Round(locBuffer.AsFloat); + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer.AsInteger; +end; + +function TJsonRpcBaseFormatter.GetBool( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : Boolean +) : Boolean; +var + locBuffer : TJSONData; +begin + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer.AsBoolean; +end; + +function TJsonRpcBaseFormatter.GetAnsiChar( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: AnsiChar +) : Boolean; +var + tmpString : TJSONStringType; + locBuffer : TJSONData; +begin + Result := GetDataBuffer(AName,locBuffer); + if Result then begin + tmpString := locBuffer.AsString; + if ( Length(tmpString) > 0 ) then + AData := tmpString[1] + else + AData := #0; + end; +end; + +function TJsonRpcBaseFormatter.GetWideChar( + const ATypeInfo: PTypeInfo; + var AName: String; + var AData: WideChar +) : Boolean; +var + tmpString : TJSONStringType; + locBuffer : TJSONData; +begin + Result := GetDataBuffer(AName,locBuffer); + if Result then begin + tmpString := locBuffer.AsString; + if ( Length(tmpString) > 0 ) then + AData := tmpString[1] + else + AData := #0; + end; +end; + +function TJsonRpcBaseFormatter.GetInt( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : Integer +) : Boolean; +var + locBuffer : TJSONData; +begin + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer.AsInteger; +end; + +function TJsonRpcBaseFormatter.GetInt64( + const ATypeInfo : PTypeInfo; + var AName : String; + var AData : Int64 +) : Boolean; +var + locBuffer : TJSONData; +begin + Result := GetDataBuffer(AName,locBuffer); + if Result then begin + if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then + AData := locBuffer.AsInteger + else + AData := Round(locBuffer.AsFloat); + end; end; {$IFDEF HAS_QWORD} -procedure TJsonRpcBaseFormatter.GetUInt64( +function TJsonRpcBaseFormatter.GetUInt64( const ATypeInfo : PTypeInfo; var AName : String; var AData : QWord -); +) : Boolean; var locBuffer : TJSONData; locExtData : TJSONFloat; tmp : QWord; begin - locBuffer := GetDataBuffer(AName); - if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then begin - AData := locBuffer.AsInteger - end else begin - locExtData := locBuffer.AsFloat; - if ( locExtData > High(Int64) ) then begin - locExtData := locExtData - High(Int64); - AData := High(Int64); - tmp := Round(locExtData); - AData := AData + tmp; + Result := GetDataBuffer(AName,locBuffer); + if Result then begin + if ( locBuffer.JSONType = jtNumber ) and ( TJSONNumber(locBuffer).NumberType = ntInteger ) then begin + AData := locBuffer.AsInteger end else begin - AData := Round(locExtData); + locExtData := locBuffer.AsFloat; + if ( locExtData > High(Int64) ) then begin + locExtData := locExtData - High(Int64); + AData := High(Int64); + tmp := Round(locExtData); + AData := AData + tmp; + end else begin + AData := Round(locExtData); + end; end; end; end; {$ENDIF HAS_QWORD} -procedure TJsonRpcBaseFormatter.GetFloat( +function TJsonRpcBaseFormatter.GetFloat( const ATypeInfo : PTypeInfo; var AName : String; var AData : Extended -); +) : Boolean; +var + locBuffer : TJSONData; begin - AData := GetDataBuffer(AName).AsFloat; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer.AsFloat; end; -procedure TJsonRpcBaseFormatter.GetStr( +function TJsonRpcBaseFormatter.GetStr( const ATypeInfo : PTypeInfo; var AName : String; var AData : String -); +) : Boolean; +var + locBuffer : TJSONData; begin - AData := GetDataBuffer(AName).AsString; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer.AsString; end; {$IFDEF WST_UNICODESTRING} -procedure TJsonRpcBaseFormatter.GetUnicodeStr( +function TJsonRpcBaseFormatter.GetUnicodeStr( const ATypeInfo: PTypeInfo; var AName: String; var AData: UnicodeString -); +) : Boolean; +var + locBuffer : TJSONData; begin - AData := GetDataBuffer(AName).AsString; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer.AsString; end; {$ENDIF WST_UNICODESTRING} -procedure TJsonRpcBaseFormatter.GetWideStr( +function TJsonRpcBaseFormatter.GetWideStr( const ATypeInfo: PTypeInfo; var AName: String; var AData: WideString -); +) : Boolean; +var + locBuffer : TJSONData; begin - AData := GetDataBuffer(AName).AsString; + Result := GetDataBuffer(AName,locBuffer); + if Result then + AData := locBuffer.AsString; end; -procedure TJsonRpcBaseFormatter.GetObj( +function TJsonRpcBaseFormatter.GetObj( const ATypeInfo : PTypeInfo; var AName : String; var AData : TObject -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); + Result := True; end; -procedure TJsonRpcBaseFormatter.GetRecord( +function TJsonRpcBaseFormatter.GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); + Result := True; end; procedure TJsonRpcBaseFormatter.SetSerializationStyle(const ASerializationStyle : TSerializationStyle); @@ -1168,11 +1217,11 @@ begin End; end; -procedure TJsonRpcBaseFormatter.Get( +function TJsonRpcBaseFormatter.Get( const ATypeInfo : PTypeInfo; var AName : String; var AData -); +) : Boolean; Var int64Data : Int64; {$IFDEF HAS_QWORD} @@ -1195,66 +1244,75 @@ begin tkChar : begin ansiCharData := #0; - GetAnsiChar(ATypeInfo,AName,ansiCharData); - AnsiChar(AData) := ansiCharData; + Result := GetAnsiChar(ATypeInfo,AName,ansiCharData); + if Result then + AnsiChar(AData) := ansiCharData; end; tkWChar : begin wideCharData := #0; - GetWideChar(ATypeInfo,AName,wideCharData); - WideChar(AData) := wideCharData; + Result := GetWideChar(ATypeInfo,AName,wideCharData); + if Result then + WideChar(AData) := wideCharData; end; tkInt64 : Begin int64Data := 0; - GetInt64(ATypeInfo,AName,int64Data); - Int64(AData) := int64Data; + Result := GetInt64(ATypeInfo,AName,int64Data); + if Result then + Int64(AData) := int64Data; End; {$IFDEF HAS_QWORD} tkQWord : Begin uint64Data := 0; - GetUInt64(ATypeInfo,AName,uint64Data); - QWord(AData) := uint64Data; + Result := GetUInt64(ATypeInfo,AName,uint64Data); + if Result then + QWord(AData) := uint64Data; End; {$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; - GetStr(ATypeInfo,AName,strData); - String(AData) := strData; + Result := GetStr(ATypeInfo,AName,strData); + if Result then + String(AData) := strData; End; {$IFDEF WST_UNICODESTRING} tkUString : Begin unicodeStrData := ''; - GetUnicodeStr(ATypeInfo,AName,unicodeStrData); - UnicodeString(AData) := unicodeStrData; + Result := GetUnicodeStr(ATypeInfo,AName,unicodeStrData); + if Result then + UnicodeString(AData) := unicodeStrData; End; {$ENDIF WST_UNICODESTRING} tkWString : Begin WideStrData := ''; - GetWideStr(ATypeInfo,AName,WideStrData); - WideString(AData) := WideStrData; + Result := GetWideStr(ATypeInfo,AName,WideStrData); + if Result then + WideString(AData) := WideStrData; End; tkClass : Begin objData := TObject(AData); - GetObj(ATypeInfo,AName,objData); - TObject(AData) := objData; + Result := GetObj(ATypeInfo,AName,objData); + if Result then + TObject(AData) := objData; End; tkRecord : begin recObject := Pointer(@AData); - GetRecord(ATypeInfo,AName,recObject); + Result := GetRecord(ATypeInfo,AName,recObject); end; {$IFDEF FPC} tkBool : Begin boolData := False; - GetBool(ATypeInfo,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,AName,boolData); + if Result then + Boolean(AData) := boolData; End; {$ENDIF} tkInteger, tkEnumeration : @@ -1264,23 +1322,26 @@ begin ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin boolData := False; - GetBool(ATypeInfo,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,AName,boolData); + if Result then + Boolean(AData) := boolData; end else begin {$ENDIF} enumData := 0; - If ( ATypeInfo^.Kind = tkInteger ) Then - GetInt64(ATypeInfo,AName,enumData) - Else - GetEnum(ATypeInfo,AName,enumData); - Case GetTypeData(ATypeInfo)^.OrdType Of - otSByte : ShortInt(AData) := enumData; - otUByte : Byte(AData) := enumData; - otSWord : SmallInt(AData) := enumData; - otUWord : Word(AData) := enumData; - otSLong : LongInt(AData) := enumData; - otULong : LongWord(AData) := enumData; - End; + if ( ATypeInfo^.Kind = tkInteger ) then + Result := GetInt64(ATypeInfo,AName,enumData) + else + Result := GetEnum(ATypeInfo,AName,enumData); + if Result then begin + case GetTypeData(ATypeInfo)^.OrdType of + otSByte : ShortInt(AData) := enumData; + otUByte : Byte(AData) := enumData; + otSWord : SmallInt(AData) := enumData; + otUWord : Word(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; + end; + end; {$IFDEF WST_DELPHI} end; {$ENDIF} @@ -1288,28 +1349,30 @@ begin tkFloat : Begin floatDt := 0; - GetFloat(ATypeInfo,AName,floatDt); - Case GetTypeData(ATypeInfo)^.FloatType Of - ftSingle : Single(AData) := floatDt; - ftDouble : Double(AData) := floatDt; - ftExtended : Extended(AData) := floatDt; - ftCurr : Currency(AData) := floatDt; + Result := GetFloat(ATypeInfo,AName,floatDt); + if Result then begin + case GetTypeData(ATypeInfo)^.FloatType of + ftSingle : Single(AData) := floatDt; + ftDouble : Double(AData) := floatDt; + ftExtended : Extended(AData) := floatDt; + ftCurr : Currency(AData) := floatDt; {$IFDEF HAS_COMP} - ftComp : Comp(AData) := floatDt; + ftComp : Comp(AData) := floatDt; {$ENDIF} - End; + end; + end; End; End; end; -procedure TJsonRpcBaseFormatter.Get( +function TJsonRpcBaseFormatter.Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData -); +) : Boolean; begin - Get(ATypeInfo,AName,AData); + Result := Get(ATypeInfo,AName,AData); end; procedure TJsonRpcBaseFormatter.GetScopeInnerValue(const ATypeInfo : PTypeInfo; var AData); @@ -1435,12 +1498,18 @@ begin End; end; -function TJsonRpcBaseFormatter.ReadBuffer(const AName : string) : string; +function TJsonRpcBaseFormatter.ReadBuffer( + const AName : string; + out AResBuffer : string +) : Boolean; var locName : string; + locBuffer : TJSONData; begin locName := AName; - Result := GetDataBuffer(locName).AsJSON; + Result := GetDataBuffer(locName,locBuffer); + if Result then + AResBuffer := locBuffer.AsJSON; end; procedure TJsonRpcBaseFormatter.WriteBuffer(const AValue: string); diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 819bca401..fa1049bbb 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -195,22 +195,22 @@ type const ATypeInfo : PTypeInfo; const AData ); - procedure Get( + function Get( const ATypeInfo : PTypeInfo; var AName : string; var AData - );overload; - procedure Get( + ) : Boolean; overload; + function Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData - );overload; + ) : Boolean; overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData ); - function ReadBuffer(const AName : string) : string; + function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean; //Please use this method if and _only_ if you do not have another way achieve your aim! procedure WriteBuffer(const AValue : string); @@ -6078,7 +6078,7 @@ var buffer : string; locObj : TStringBufferRemotable; begin - buffer := AStore.ReadBuffer(AName); + AStore.ReadBuffer(AName,buffer); if ( AObject = nil ) then AObject := Create(); locObj := AObject as TStringBufferRemotable;; diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index 15074ab5c..739128951 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -231,89 +231,93 @@ type const AData : Pointer );{$IFDEF USE_INLINE}inline;{$ENDIF} - function GetNodeValue(const ANameSpace : string; var AName : String):DOMString; - procedure GetEnum( + function GetNodeValue( + const ANameSpace : string; + var AName : string; + out AResBuffer : DOMString + ) : Boolean; + function GetEnum( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : TEnumIntType - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetBool( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetBool( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : Boolean - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetAnsiChar( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetAnsiChar( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : AnsiChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetWideChar( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetWideChar( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : WideChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF FPC} - procedure GetInt( + function GetInt( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : Integer - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF} - procedure GetInt64( + function GetInt64( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : Int64 - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF HAS_QWORD} - procedure GetUInt64( + function GetUInt64( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : QWord - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF HAS_QWORD} - procedure GetFloat( + function GetFloat( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : Extended - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetStr( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetStr( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : String - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF WST_UNICODESTRING} - procedure GetUnicodeStr( + function GetUnicodeStr( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : UnicodeString - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF WST_UNICODESTRING} - procedure GetWideStr( + function GetWideStr( Const ATypeInfo : PTypeInfo; const ANameSpace : string; Var AName : String; Var AData : WideString - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetObj( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetObj( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TObject - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetRecord( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} protected function GetXmlDoc():TwstXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF} function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF} @@ -422,22 +426,22 @@ type const ATypeInfo : PTypeInfo; const AData ); - procedure Get( + function Get( const ATypeInfo : PTypeInfo; var AName : string; var AData - );overload; - procedure Get( + ) : Boolean; overload; + function Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData - );overload; + ) : Boolean;overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData ); - function ReadBuffer(const AName : string) : string; + function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean; procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); @@ -1006,7 +1010,11 @@ begin Result := InternalPutData(ANameSpace,AName,ATypeInfo,wst_FormatFloat(ATypeInfo,AData)); end; -function TSOAPBaseFormatter.GetNodeValue(const ANameSpace : string; var AName: String): DOMString; +function TSOAPBaseFormatter.GetNodeValue( + const ANameSpace : string; + var AName : string; + out AResBuffer : DOMString +): Boolean; var locElt : TDOMNode; namespaceShortName, strNodeName, s : string; @@ -1031,176 +1039,220 @@ begin locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName); end; - if Assigned(locElt) then begin + Result := ( locElt <> nil ); + if Result then begin if locElt.HasChildNodes then - Result := locElt.FirstChild.NodeValue + AResBuffer := locElt.FirstChild.NodeValue else - Result := locElt.NodeValue; - end else begin - Error('Param or Attribute not found : "%s"',[AName]); + AResBuffer := locElt.NodeValue; end; end; -procedure TSOAPBaseFormatter.GetEnum( +function TSOAPBaseFormatter.GetEnum( const ATypeInfo: PTypeInfo; const ANameSpace : string; var AName: String; var AData: TEnumIntType -); +) : Boolean; Var - locBuffer : String; + locBuffer : DOMString; + locStrBuffer : String; begin - locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(ANameSpace,AName)); - If IsStrEmpty(locBuffer) Then - AData := 0 - Else - AData := GetEnumValue(ATypeInfo,locBuffer) + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then begin + locStrBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(locBuffer); + If IsStrEmpty(locStrBuffer) Then + AData := 0 + Else + AData := GetEnumValue(ATypeInfo,locStrBuffer) + end; End; -procedure TSOAPBaseFormatter.GetBool( +function TSOAPBaseFormatter.GetBool( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : String; var AData : Boolean -); +) : Boolean; Var - locBuffer : String; + locBuffer : DOMString; + locStrBuffer : String; begin - locBuffer := LowerCase(Trim(GetNodeValue(ANameSpace,AName))); - If IsStrEmpty(locBuffer) Then - AData := False - Else - AData := StrToBool(locBuffer); + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then begin + locStrBuffer := LowerCase(Trim(locBuffer)); + If IsStrEmpty(locStrBuffer) Then + AData := False + Else + AData := StrToBool(locStrBuffer); + end; end; -procedure TSOAPBaseFormatter.GetAnsiChar( +function TSOAPBaseFormatter.GetAnsiChar( const ATypeInfo: PTypeInfo; const ANameSpace: string; var AName: String; var AData: AnsiChar -); +) : Boolean; var tmpString : DOMString; begin - tmpString := GetNodeValue(ANameSpace,AName); - if ( Length(tmpString) > 0 ) then - AData := AnsiChar(tmpString[1]) - else - AData := #0; + Result := GetNodeValue(ANameSpace,AName,tmpString); + if Result then begin + if ( Length(tmpString) > 0 ) then + AData := AnsiChar(tmpString[1]) + else + AData := #0; + end; end; -procedure TSOAPBaseFormatter.GetWideChar( +function TSOAPBaseFormatter.GetWideChar( const ATypeInfo: PTypeInfo; const ANameSpace: string; var AName: String; var AData: WideChar -); +) : Boolean; var tmpString : DOMString; begin - tmpString := GetNodeValue(ANameSpace,AName); - if ( Length(tmpString) > 0 ) then - AData := tmpString[1] - else - AData := #0; + Result := GetNodeValue(ANameSpace,AName,tmpString); + if Result then begin + if ( Length(tmpString) > 0 ) then + AData := tmpString[1] + else + AData := #0; + end; end; {$IFDEF FPC} -procedure TSOAPBaseFormatter.GetInt( +function TSOAPBaseFormatter.GetInt( const ATypeInfo: PTypeInfo; const ANameSpace : string; var AName: String; var AData: Integer -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := StrToIntDef(Trim(GetNodeValue(ANameSpace,AName)),0); + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then + AData := StrToIntDef(Trim(locBuffer),0); end; {$ENDIF} -procedure TSOAPBaseFormatter.GetInt64( +function TSOAPBaseFormatter.GetInt64( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : String; var AData : Int64 -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := StrToInt64Def(Trim(GetNodeValue(ANameSpace,AName)),0); + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then + AData :=StrToInt64Def(Trim(locBuffer),0); end; {$IFDEF HAS_QWORD} -procedure TSOAPBaseFormatter.GetUInt64( +function TSOAPBaseFormatter.GetUInt64( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : String; var AData : QWord -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := StrToQWordDef(Trim(GetNodeValue(ANameSpace,AName)),0); + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then + AData := StrToQWordDef(Trim(locBuffer),0); end; {$ENDIF HAS_QWORD} -procedure TSOAPBaseFormatter.GetFloat( +function TSOAPBaseFormatter.GetFloat( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : String; var AData : Extended -); +) : Boolean; +var + locBuffer : DOMString; begin + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then begin {$IFDEF HAS_FORMAT_SETTINGS} - AData := StrToFloatDef(Trim(GetNodeValue(ANameSpace,AName)),0,wst_FormatSettings); + AData := StrToFloatDef(Trim(locBuffer),0,wst_FormatSettings); {$ELSE} - AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(ANameSpace,AName))),0); + AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(locBuffer)),0); {$ENDIF HAS_FORMAT_SETTINGS} + end; end; -procedure TSOAPBaseFormatter.GetStr( +function TSOAPBaseFormatter.GetStr( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : String; var AData : String -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := GetNodeValue(ANameSpace,AName); + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then + AData := locBuffer; end; {$IFDEF WST_UNICODESTRING} -procedure TSOAPBaseFormatter.GetUnicodeStr( +function TSOAPBaseFormatter.GetUnicodeStr( const ATypeInfo: PTypeInfo; const ANameSpace: string; var AName: String; var AData: UnicodeString -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := GetNodeValue(ANameSpace,AName); + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then + AData := locBuffer; end; {$ENDIF WST_UNICODESTRING} -procedure TSOAPBaseFormatter.GetWideStr( +function TSOAPBaseFormatter.GetWideStr( const ATypeInfo: PTypeInfo; const ANameSpace: string; var AName: String; var AData: WideString -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := GetNodeValue(ANameSpace,AName); + Result := GetNodeValue(ANameSpace,AName,locBuffer); + if Result then + AData := locBuffer; end; -procedure TSOAPBaseFormatter.GetObj( +function TSOAPBaseFormatter.GetObj( const ATypeInfo : PTypeInfo; var AName : String; var AData : TObject -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); + Result := True; end; -procedure TSOAPBaseFormatter.GetRecord( +function TSOAPBaseFormatter.GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); + Result := True; end; function TSOAPBaseFormatter.GetXmlDoc(): TwstXMLDocument; @@ -1955,12 +2007,12 @@ begin StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer)); end; -procedure TSOAPBaseFormatter.Get( +function TSOAPBaseFormatter.Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : String; var AData -); +) : Boolean; Var int64Data : Int64; {$IFDEF HAS_QWORD} @@ -1983,66 +2035,75 @@ begin tkChar : begin ansiCharData := #0; - GetAnsiChar(ATypeInfo,ANameSpace,AName,ansiCharData); - AnsiChar(AData) := ansiCharData; + Result := GetAnsiChar(ATypeInfo,ANameSpace,AName,ansiCharData); + if Result then + AnsiChar(AData) := ansiCharData; end; tkWChar : begin wideCharData := #0; - GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData); - WideChar(AData) := wideCharData; + Result := GetWideChar(ATypeInfo,ANameSpace,AName,wideCharData); + if Result then + WideChar(AData) := wideCharData; end; tkInt64 : Begin int64Data := 0; - GetInt64(ATypeInfo,ANameSpace,AName,int64Data); - Int64(AData) := int64Data; + Result := GetInt64(ATypeInfo,ANameSpace,AName,int64Data); + if Result then + Int64(AData) := int64Data; End; {$IFDEF HAS_QWORD} tkQWord : Begin uint64Data := 0; - GetUInt64(ATypeInfo,ANameSpace,AName,uint64Data); - QWord(AData) := uint64Data; + Result := GetUInt64(ATypeInfo,ANameSpace,AName,uint64Data); + if Result then + QWord(AData) := uint64Data; End; {$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; - GetStr(ATypeInfo,ANameSpace,AName,strData); - String(AData) := strData; + Result := GetStr(ATypeInfo,ANameSpace,AName,strData); + if Result then + String(AData) := strData; End; {$IFDEF WST_UNICODESTRING} tkUString : begin unicodeStrData := ''; - GetUnicodeStr(ATypeInfo,ANameSpace,AName,unicodeStrData); - UnicodeString(AData) := unicodeStrData; + Result := GetUnicodeStr(ATypeInfo,ANameSpace,AName,unicodeStrData); + if Result then + UnicodeString(AData) := unicodeStrData; end; {$ENDIF WST_UNICODESTRING} tkWString : begin wideStrData := ''; - GetWideStr(ATypeInfo,ANameSpace,AName,wideStrData); - WideString(AData) := wideStrData; + Result := GetWideStr(ATypeInfo,ANameSpace,AName,wideStrData); + if Result then + WideString(AData) := wideStrData; end; tkClass : Begin objData := TObject(AData); - GetObj(ATypeInfo,AName,objData); - TObject(AData) := objData; + Result := GetObj(ATypeInfo,AName,objData); + if Result then + TObject(AData) := objData; End; tkRecord : begin recObject := Pointer(@AData); - GetRecord(ATypeInfo,AName,recObject); + Result := GetRecord(ATypeInfo,AName,recObject); end; {$IFDEF FPC} tkBool : Begin boolData := False; - GetBool(ATypeInfo,ANameSpace,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,ANameSpace,AName,boolData); + if Result then + Boolean(AData) := boolData; End; {$ENDIF} tkInteger, tkEnumeration : @@ -2052,51 +2113,58 @@ begin ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin boolData := False; - GetBool(ATypeInfo,ANameSpace,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,ANameSpace,AName,boolData); + if Result then + Boolean(AData) := boolData; end else begin {$ENDIF} enumData := 0; - If ( ATypeInfo^.Kind = tkInteger ) Then - GetInt64(ATypeInfo,ANameSpace,AName,enumData) - Else - GetEnum(ATypeInfo,ANameSpace,AName,enumData); - Case GetTypeData(ATypeInfo)^.OrdType Of - otSByte : ShortInt(AData) := enumData; - otUByte : Byte(AData) := enumData; - otSWord : SmallInt(AData) := enumData; - otUWord : Word(AData) := enumData; - otSLong : LongInt(AData) := enumData; - otULong : LongWord(AData) := enumData; - End; + if ( ATypeInfo^.Kind = tkInteger ) then + Result := GetInt64(ATypeInfo,ANameSpace,AName,enumData) + else + Result := GetEnum(ATypeInfo,ANameSpace,AName,enumData); + if Result then begin + case GetTypeData(ATypeInfo)^.OrdType of + otSByte : ShortInt(AData) := enumData; + otUByte : Byte(AData) := enumData; + otSWord : SmallInt(AData) := enumData; + otUWord : Word(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; + end; + end; {$IFDEF WST_DELPHI} end; {$ENDIF} end; tkFloat : - Begin + begin floatDt := 0; - GetFloat(ATypeInfo,ANameSpace,AName,floatDt); - Case GetTypeData(ATypeInfo)^.FloatType Of - ftSingle : Single(AData) := floatDt; - ftDouble : Double(AData) := floatDt; - ftExtended : Extended(AData) := floatDt; - ftCurr : Currency(AData) := floatDt; + Result := GetFloat(ATypeInfo,ANameSpace,AName,floatDt); + if Result then begin + case GetTypeData(ATypeInfo)^.FloatType of + ftSingle : Single(AData) := floatDt; + ftDouble : Double(AData) := floatDt; + ftExtended : Extended(AData) := floatDt; + ftCurr : Currency(AData) := floatDt; {$IFDEF CPU86} - ftComp : Comp(AData) := floatDt; + ftComp : Comp(AData) := floatDt; {$ENDIF} - End; - End; - End; + end; + end; + end; + else + Result := False; + end; end; -procedure TSOAPBaseFormatter.Get( +function TSOAPBaseFormatter.Get( const ATypeInfo : PTypeInfo; var AName : string; var AData -); +) : Boolean; begin - Get(ATypeInfo,'',AName,AData); + Result := Get(ATypeInfo,'',AName,AData); end; procedure TSOAPBaseFormatter.GetScopeInnerValue( @@ -2202,7 +2270,7 @@ begin end; end; -function TSOAPBaseFormatter.ReadBuffer (const AName : string ) : string; +function TSOAPBaseFormatter.ReadBuffer(const AName : string; out AResBuffer : string) : Boolean; Var locElt : TDOMNode; namespaceShortName, strNodeName : string; @@ -2221,11 +2289,9 @@ begin locElt := GetCurrentScopeObject().GetAttributeNode(strNodeName); end; - if Assigned(locElt) then begin - Result := NodeToBuffer(locElt); - end else begin - Error('Param or Attribute not found : "%s"',[AName]); - end; + Result := ( locElt <> nil ); + if Result then + AResBuffer := NodeToBuffer(locElt); end; procedure TSOAPBaseFormatter.SaveToStream(AStream: TStream); diff --git a/wst/trunk/base_xmlrpc_formatter.pas b/wst/trunk/base_xmlrpc_formatter.pas index 1d4b605ec..007c523ba 100644 --- a/wst/trunk/base_xmlrpc_formatter.pas +++ b/wst/trunk/base_xmlrpc_formatter.pas @@ -242,76 +242,76 @@ type const AData : Pointer );{$IFDEF USE_INLINE}inline;{$ENDIF} - function GetNodeValue(var AName : String):DOMString; - procedure GetEnum( + function GetNodeValue(var AName : string; out AResBuffer : DOMString) : Boolean; + function GetEnum( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TEnumIntType - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetAnsiChar( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetAnsiChar( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : AnsiChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetWideChar( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetWideChar( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : WideChar - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetBool( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetBool( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Boolean - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetInt( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetInt( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Integer - ); - procedure GetInt64( + ) : Boolean; + function GetInt64( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Int64 - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF HAS_QWORD} - procedure GetUInt64( + function GetUInt64( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : QWord - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF HAS_QWORD} - procedure GetFloat( + function GetFloat( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : Extended - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetStr( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetStr( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : String - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$IFDEF WST_UNICODESTRING} - procedure GetUnicodeStr( + function GetUnicodeStr( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : UnicodeString - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} {$ENDIF WST_UNICODESTRING} - procedure GetWideStr( + function GetWideStr( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : WideString - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetObj( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetObj( Const ATypeInfo : PTypeInfo; Var AName : String; Var AData : TObject - );{$IFDEF USE_INLINE}inline;{$ENDIF} - procedure GetRecord( + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} + function GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer - );{$IFDEF USE_INLINE}inline;{$ENDIF} + ) : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF} protected function GetXmlDoc():TXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF} function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF} @@ -409,22 +409,22 @@ type const ATypeInfo : PTypeInfo; const AData ); - procedure Get( + function Get( const ATypeInfo : PTypeInfo; var AName : string; var AData - );overload; - procedure Get( + ) : Boolean;overload; + function Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData - );overload; + ) : Boolean;overload; procedure GetScopeInnerValue( const ATypeInfo : PTypeInfo; var AData ); - function ReadBuffer(const AName : string) : string; + function ReadBuffer(const AName : string; out AResBuffer : string) : Boolean; procedure WriteBuffer(const AValue : string); procedure SaveToStream(AStream : TStream); @@ -949,7 +949,10 @@ begin Result := InternalPutData(AName,xdtdouble,wst_FormatFloat(ATypeInfo,AData)); end; -function TXmlRpcBaseFormatter.GetNodeValue(var AName: string): DOMString; +function TXmlRpcBaseFormatter.GetNodeValue( + var AName: string; + out AResBuffer : DOMString +) : Boolean; var locElt : TDOMNode; stkTop : TStackItem; @@ -957,161 +960,205 @@ begin stkTop := StackTop(); locElt := stkTop.FindNode(AName) as TDOMElement; - if Assigned(locElt) then begin + Result := ( locElt <> nil ); + if Result then begin if locElt.HasChildNodes then begin - Result := locElt.FirstChild.NodeValue + AResBuffer := locElt.FirstChild.NodeValue end else begin if ( stkTop.FoundState = fsFoundNil ) then - Result := '' + AResBuffer := '' else - Result := locElt.NodeValue; + AResBuffer := locElt.NodeValue; end; - end else begin - Error('Param or Attribute not found : "%s"',[AName]); end; end; -procedure TXmlRpcBaseFormatter.GetEnum( +function TXmlRpcBaseFormatter.GetEnum( const ATypeInfo: PTypeInfo; var AName: String; var AData: TEnumIntType -); -Var - locBuffer : String; +) : Boolean; +var + locBuffer : DOMString; + locStr : string; begin - locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(AName)); - If IsStrEmpty(locBuffer) Then - AData := 0 - Else - AData := GetEnumValue(ATypeInfo,locBuffer) + Result := GetNodeValue(AName,locBuffer); + if Result then begin + locStr := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(locBuffer); + If IsStrEmpty(locStr) Then + AData := 0 + Else + AData := GetEnumValue(ATypeInfo,locStr) + end; End; -procedure TXmlRpcBaseFormatter.GetBool( +function TXmlRpcBaseFormatter.GetBool( const ATypeInfo : PTypeInfo; var AName : String; var AData : Boolean -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := ( GetNodeValue(AName) = XML_RPC_TRUE ); + Result := GetNodeValue(AName,locBuffer); + if Result then + AData := ( locBuffer = XML_RPC_TRUE ); end; -procedure TXmlRpcBaseFormatter.GetInt( +function TXmlRpcBaseFormatter.GetInt( const ATypeInfo: PTypeInfo; var AName: String; var AData: Integer -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := StrToIntDef(Trim(GetNodeValue(AName)),0); + Result := GetNodeValue(AName,locBuffer); + if Result then + AData := StrToIntDef(Trim(locBuffer),0); end; -procedure TXmlRpcBaseFormatter.GetAnsiChar( +function TXmlRpcBaseFormatter.GetAnsiChar( const ATypeInfo: PTypeInfo; var AName: String; var AData: AnsiChar -); +) : Boolean; var locBuffer : DOMString; begin - locBuffer := GetNodeValue(AName); - if ( Length(locBuffer) = 0 ) then - AData := #0 - else - AData := AnsiChar(locBuffer[1]); + Result := GetNodeValue(AName,locBuffer); + if Result then begin + if ( Length(locBuffer) = 0 ) then + AData := #0 + else + AData := AnsiChar(locBuffer[1]); + end; end; -procedure TXmlRpcBaseFormatter.GetWideChar( +function TXmlRpcBaseFormatter.GetWideChar( const ATypeInfo: PTypeInfo; var AName: String; var AData: WideChar -); +) : Boolean; var locBuffer : DOMString; begin - locBuffer := GetNodeValue(AName); - if ( Length(locBuffer) = 0 ) then - AData := #0 - else - AData := locBuffer[1]; + Result := GetNodeValue(AName,locBuffer); + if Result then begin + if ( Length(locBuffer) = 0 ) then + AData := #0 + else + AData := locBuffer[1]; + end; end; -procedure TXmlRpcBaseFormatter.GetInt64( +function TXmlRpcBaseFormatter.GetInt64( const ATypeInfo : PTypeInfo; var AName : String; var AData : Int64 -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := StrToInt64Def(Trim(GetNodeValue(AName)),0); + Result := GetNodeValue(AName,locBuffer); + if Result then + AData := StrToInt64Def(Trim(locBuffer),0); end; {$IFDEF HAS_QWORD} -procedure TXmlRpcBaseFormatter.GetUInt64( +function TXmlRpcBaseFormatter.GetUInt64( const ATypeInfo : PTypeInfo; var AName : String; var AData : QWord -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := StrToQWordDef(Trim(GetNodeValue(AName)),0); + Result := GetNodeValue(AName,locBuffer); + if Result then + AData := StrToQWordDef(Trim(locBuffer),0); end; {$ENDIF HAS_QWORD} -procedure TXmlRpcBaseFormatter.GetFloat( +function TXmlRpcBaseFormatter.GetFloat( const ATypeInfo : PTypeInfo; var AName : String; var AData : Extended -); +) : Boolean; +var + locBuffer : DOMString; begin + Result := GetNodeValue(AName,locBuffer); + if Result then begin {$IFDEF HAS_FORMAT_SETTINGS} - AData := StrToFloatDef(Trim(GetNodeValue(AName)),0,wst_FormatSettings); + AData := StrToFloatDef(Trim(locBuffer),0,wst_FormatSettings); {$ELSE} - AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(GetNodeValue(AName))),0); + AData := StrToFloatDef(TranslateDotToDecimalSeperator(Trim(locBuffer)),0); {$ENDIF HAS_FORMAT_SETTINGS} + end; end; -procedure TXmlRpcBaseFormatter.GetStr( +function TXmlRpcBaseFormatter.GetStr( const ATypeInfo : PTypeInfo; var AName : String; var AData : String -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := GetNodeValue(AName); + Result := GetNodeValue(AName,locBuffer); + if Result then + AData := locBuffer; end; {$IFDEF WST_UNICODESTRING} -procedure TXmlRpcBaseFormatter.GetUnicodeStr( +function TXmlRpcBaseFormatter.GetUnicodeStr( const ATypeInfo: PTypeInfo; var AName: String; var AData: UnicodeString -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := GetNodeValue(AName); + Result := GetNodeValue(AName,locBuffer); + if Result then + AData := locBuffer; end; {$ENDIF WST_UNICODESTRING} -procedure TXmlRpcBaseFormatter.GetWideStr( +function TXmlRpcBaseFormatter.GetWideStr( const ATypeInfo: PTypeInfo; var AName: String; var AData: WideString -); +) : Boolean; +var + locBuffer : DOMString; begin - AData := GetNodeValue(AName); + Result := GetNodeValue(AName,locBuffer); + if Result then + AData := locBuffer; end; -procedure TXmlRpcBaseFormatter.GetObj( +function TXmlRpcBaseFormatter.GetObj( const ATypeInfo : PTypeInfo; var AName : String; var AData : TObject -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TBaseRemotableClass(GetTypeData(ATypeInfo)^.ClassType).Load(AData, Self,AName,ATypeInfo); + Result := True; end; -procedure TXmlRpcBaseFormatter.GetRecord( +function TXmlRpcBaseFormatter.GetRecord( const ATypeInfo : PTypeInfo; var AName : String; var AData : Pointer -); +) : Boolean; begin + { TODO -cEXCEPTION_SAFE : Load() should be a function ! } TRemotableRecordEncoder.Load(AData, Self,AName,ATypeInfo); + Result := True; end; function TXmlRpcBaseFormatter.GetXmlDoc(): TwstXMLDocument; @@ -1535,11 +1582,11 @@ begin StackTop().ScopeObject.AppendChild(FDoc.CreateTextNode(dataBuffer)); end; -procedure TXmlRpcBaseFormatter.Get( +function TXmlRpcBaseFormatter.Get( const ATypeInfo : PTypeInfo; var AName : String; var AData -); +) : Boolean; Var int64Data : Int64; {$IFDEF HAS_QWORD} @@ -1562,66 +1609,75 @@ begin tkChar : begin ansiCharData := #0; - GetAnsiChar(ATypeInfo,AName,ansiCharData); - AnsiChar(AData) := ansiCharData; + Result := GetAnsiChar(ATypeInfo,AName,ansiCharData); + if Result then + AnsiChar(AData) := ansiCharData; end; tkWChar : begin wideCharData := #0; - GetWideChar(ATypeInfo,AName,wideCharData); - WideChar(AData) := wideCharData; + Result := GetWideChar(ATypeInfo,AName,wideCharData); + if Result then + WideChar(AData) := wideCharData; end; tkInt64 : Begin int64Data := 0; - GetInt64(ATypeInfo,AName,int64Data); - Int64(AData) := int64Data; + Result := GetInt64(ATypeInfo,AName,int64Data); + if Result then + Int64(AData) := int64Data; End; {$IFDEF HAS_QWORD} tkQWord : Begin uint64Data := 0; - GetUInt64(ATypeInfo,AName,uint64Data); - QWord(AData) := uint64Data; + Result := GetUInt64(ATypeInfo,AName,uint64Data); + if Result then + QWord(AData) := uint64Data; End; {$ENDIF HAS_QWORD} tkLString{$IFDEF FPC},tkAString{$ENDIF} : Begin strData := ''; - GetStr(ATypeInfo,AName,strData); - String(AData) := strData; + Result := GetStr(ATypeInfo,AName,strData); + if Result then + String(AData) := strData; End; {$IFDEF WST_UNICODESTRING} tkUString : begin unicodeStrData := ''; - GetUnicodeStr(ATypeInfo,AName,unicodeStrData); - UnicodeString(AData) := unicodeStrData; + Result := GetUnicodeStr(ATypeInfo,AName,unicodeStrData); + if Result then + UnicodeString(AData) := unicodeStrData; end; {$ENDIF WST_UNICODESTRING} tkWString : begin wideStrData := ''; - GetWideStr(ATypeInfo,AName,wideStrData); - WideString(AData) := wideStrData; + Result := GetWideStr(ATypeInfo,AName,wideStrData); + if Result then + WideString(AData) := wideStrData; end; tkClass : Begin objData := TObject(AData); - GetObj(ATypeInfo,AName,objData); - TObject(AData) := objData; + Result := GetObj(ATypeInfo,AName,objData); + if Result then + TObject(AData) := objData; End; tkRecord : begin recObject := Pointer(@AData); - GetRecord(ATypeInfo,AName,recObject); + Result := GetRecord(ATypeInfo,AName,recObject); end; {$IFDEF FPC} tkBool : Begin boolData := False; - GetBool(ATypeInfo,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,AName,boolData); + if Result then + Boolean(AData) := boolData; End; {$ENDIF} tkInteger, tkEnumeration : @@ -1631,52 +1687,59 @@ begin ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin boolData := False; - GetBool(ATypeInfo,AName,boolData); - Boolean(AData) := boolData; + Result := GetBool(ATypeInfo,AName,boolData); + if Result then + Boolean(AData) := boolData; end else begin {$ENDIF} enumData := 0; - If ( ATypeInfo^.Kind = tkInteger ) Then - GetInt64(ATypeInfo,AName,enumData) - Else - GetEnum(ATypeInfo,AName,enumData); - Case GetTypeData(ATypeInfo)^.OrdType Of - otSByte : ShortInt(AData) := enumData; - otUByte : Byte(AData) := enumData; - otSWord : SmallInt(AData) := enumData; - otUWord : Word(AData) := enumData; - otSLong : LongInt(AData) := enumData; - otULong : LongWord(AData) := enumData; - End; + if ( ATypeInfo^.Kind = tkInteger ) then + Result := GetInt64(ATypeInfo,AName,enumData) + else + Result := GetEnum(ATypeInfo,AName,enumData); + if Result then begin + case GetTypeData(ATypeInfo)^.OrdType Of + otSByte : ShortInt(AData) := enumData; + otUByte : Byte(AData) := enumData; + otSWord : SmallInt(AData) := enumData; + otUWord : Word(AData) := enumData; + otSLong : LongInt(AData) := enumData; + otULong : LongWord(AData) := enumData; + end; + end; {$IFDEF WST_DELPHI} end; {$ENDIF} End; tkFloat : - Begin + begin floatDt := 0; - GetFloat(ATypeInfo,AName,floatDt); - Case GetTypeData(ATypeInfo)^.FloatType Of - ftSingle : Single(AData) := floatDt; - ftDouble : Double(AData) := floatDt; - ftExtended : Extended(AData) := floatDt; - ftCurr : Currency(AData) := floatDt; + Result := GetFloat(ATypeInfo,AName,floatDt); + if Result then begin + case GetTypeData(ATypeInfo)^.FloatType of + ftSingle : Single(AData) := floatDt; + ftDouble : Double(AData) := floatDt; + ftExtended : Extended(AData) := floatDt; + ftCurr : Currency(AData) := floatDt; {$IFDEF HAS_COMP} - ftComp : Comp(AData) := floatDt; + ftComp : Comp(AData) := floatDt; {$ENDIF} - End; - End; - End; + end; + end; + end; + else + Result := False; + end; end; -procedure TXmlRpcBaseFormatter.Get( +function TXmlRpcBaseFormatter.Get( const ATypeInfo : PTypeInfo; const ANameSpace : string; var AName : string; var AData -); +) : Boolean; begin - Get(ATypeInfo,AName,AData); + Result := Get(ATypeInfo,AName,AData); end; procedure TXmlRpcBaseFormatter.GetScopeInnerValue( @@ -1774,7 +1837,10 @@ begin end; end; -function TXmlRpcBaseFormatter.ReadBuffer (const AName : string ) : string; +function TXmlRpcBaseFormatter.ReadBuffer( + const AName : string; + out AResBuffer : string +) : Boolean; var locElt : TDOMNode; stkTop : TStackItem; @@ -1784,11 +1850,9 @@ begin locName := AName; locElt := stkTop.FindNode(locName); - if Assigned(locElt) then begin - Result := NodeToBuffer(locElt); - end else begin - Error('Param or Attribute not found : "%s"',[AName]); - end; + Result := ( locElt <> nil ); + if Result then + AResBuffer := NodeToBuffer(locElt); end; procedure TXmlRpcBaseFormatter.SaveToStream(AStream: TStream); diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas index 45ec1474a..a3e1e5adc 100644 --- a/wst/trunk/object_serializer.pas +++ b/wst/trunk/object_serializer.pas @@ -29,12 +29,16 @@ type TPropSerializationInfo = class; - TPropertyReadProc = procedure( + TPropertyReadProc = function( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase + ) : Boolean; + TPropertyWriteProc = procedure( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase ); - TPropertyWriteProc = TPropertyReadProc; { TPropSerializationInfo } @@ -125,12 +129,18 @@ type {$ENDIF TRemotableTypeInitializer_Initialize} end; -resourcestring - SERR_NoReaderProc = 'No reader proc for that type, Prop : "(%s : %s)".'; - SERR_NoSerializerFoThisType = 'No serializer for this type : %s.'; - SERR_SerializerInitializationException = 'Unable to initialize the serializer of that type : "%s".'; - implementation +uses + wst_consts; + +function ErrorFunc( + AObject : TObject; + APropInfo : TPropSerializationInfo; + AStore : IFormatterBase +) : Boolean; +begin + raise Exception.CreateFmt(SERR_NoReaderProc,[APropInfo.Name,APropInfo.PropInfo^.Name]); +end; procedure ErrorProc( AObject : TObject; @@ -138,7 +148,7 @@ procedure ErrorProc( AStore : IFormatterBase ); begin - raise Exception.CreateFmt(SERR_NoReaderProc,[APropInfo.Name,APropInfo.FPropInfo^.Name]); + raise Exception.CreateFmt(SERR_NoReaderProc,[APropInfo.Name,APropInfo.PropInfo^.Name]); end; type @@ -163,27 +173,28 @@ type // Simple readers {$IFDEF HAS_TKBOOL} -procedure BoolReader( +function BoolReader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : Boolean; begin locData := False; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType,locName,locData); - SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); + Result := AStore.Get(APropInfo.PropInfo^.PropType,locName,locData); + if Result then + SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); end; {$ENDIF HAS_TKBOOL} -procedure ClassReader( +function ClassReader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; objData : TObject; @@ -193,8 +204,8 @@ begin objData := GetObjectProp(AObject,APropInfo.PropInfo); objDataCreateHere := not Assigned(objData); try - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,objData); - if objDataCreateHere then + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,objData); + if Result and objDataCreateHere then SetObjectProp(AObject,APropInfo.PropInfo,objData); finally if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then @@ -202,11 +213,11 @@ begin end; end; -procedure FloatReader( +function FloatReader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var propName : string; floatBuffer : TFloatBuffer; @@ -219,38 +230,46 @@ begin case GetTypeData(pt)^.FloatType of ftSingle : begin - AStore.Get(pt,propName,floatBuffer.SingleData); - floatDt := floatBuffer.SingleData; + Result := AStore.Get(pt,propName,floatBuffer.SingleData); + if Result then + floatDt := floatBuffer.SingleData; end; ftDouble : begin - AStore.Get(pt,propName,floatBuffer.DoubleData); - floatDt := floatBuffer.DoubleData; + Result := AStore.Get(pt,propName,floatBuffer.DoubleData); + if Result then + floatDt := floatBuffer.DoubleData; end; ftExtended : begin - AStore.Get(pt,propName,floatBuffer.ExtendedData); - floatDt := floatBuffer.ExtendedData; + Result := AStore.Get(pt,propName,floatBuffer.ExtendedData); + if Result then + floatDt := floatBuffer.ExtendedData; end; ftCurr : begin - AStore.Get(pt,propName,floatBuffer.CurrencyData); - floatDt := floatBuffer.CurrencyData; + Result := AStore.Get(pt,propName,floatBuffer.CurrencyData); + if Result then + floatDt := floatBuffer.CurrencyData; end; ftComp : begin - AStore.Get(pt,propName,floatBuffer.CompData); - floatDt := floatBuffer.CompData; + Result := AStore.Get(pt,propName,floatBuffer.CompData); + if Result then + floatDt := floatBuffer.CompData; end; + else + Result := False; end; - SetFloatProp(AObject,APropInfo.PropInfo,floatDt); + if Result then + SetFloatProp(AObject,APropInfo.PropInfo,floatDt); end; -procedure IntEnumReader( +function IntEnumReader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var propName : string; int64Data : Int64; @@ -266,134 +285,149 @@ begin if ( pt^.Kind = tkEnumeration ) and ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) then begin - AStore.Get(pt,propName,boolData); - SetPropValue(AObject,propName,boolData); + Result := AStore.Get(pt,propName,boolData); + if Result then + SetPropValue(AObject,propName,boolData); end else begin {$ENDIF} enumData.ULongIntData := 0; Case GetTypeData(pt)^.OrdType Of otSByte : Begin - AStore.Get(pt,propName,enumData.ShortIntData); - int64Data := enumData.ShortIntData; + Result := AStore.Get(pt,propName,enumData.ShortIntData); + if Result then + int64Data := enumData.ShortIntData; End; otUByte : Begin - AStore.Get(pt,propName,enumData.ByteData); - int64Data := enumData.ByteData; + Result := AStore.Get(pt,propName,enumData.ByteData); + if Result then + int64Data := enumData.ByteData; End; otSWord : Begin - AStore.Get(pt,propName,enumData.SmallIntData); - int64Data := enumData.SmallIntData; + Result := AStore.Get(pt,propName,enumData.SmallIntData); + if Result then + int64Data := enumData.SmallIntData; End; otUWord : Begin - AStore.Get(pt,propName,enumData.WordData); - int64Data := enumData.WordData; + Result := AStore.Get(pt,propName,enumData.WordData); + if Result then + int64Data := enumData.WordData; End; otSLong: Begin - AStore.Get(pt,propName,enumData.SLongIntData); - int64Data := enumData.SLongIntData; + Result := AStore.Get(pt,propName,enumData.SLongIntData); + if Result then + int64Data := enumData.SLongIntData; End; otULong : Begin - AStore.Get(pt,propName,enumData.ULongIntData); - int64Data := enumData.ULongIntData; + Result := AStore.Get(pt,propName,enumData.ULongIntData); + if Result then + int64Data := enumData.ULongIntData; End; + else + Result := False; End; - SetOrdProp(AObject,APropInfo.PropInfo,int64Data); + if Result then + SetOrdProp(AObject,APropInfo.PropInfo,int64Data); {$IFDEF WST_DELPHI} end; {$ENDIF} end; -procedure Int64Reader( +function Int64Reader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : Int64; begin locData := 0; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); - SetInt64Prop(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); + if Result then + SetInt64Prop(AObject,APropInfo.PropInfo,locData); end; -procedure StringReader( +function StringReader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : string; begin locData := ''; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); - SetStrProp(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); + if Result then + SetStrProp(AObject,APropInfo.PropInfo,locData); end; {$IFDEF WST_UNICODESTRING} -procedure UnicodeStringReader( +function UnicodeStringReader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : UnicodeString; begin locData := ''; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); - SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); + if Result then + SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData); end; {$ENDIF WST_UNICODESTRING} -procedure WideStringReader( +function WideStringReader( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : WideString; begin locData := ''; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); - SetWideStrProp(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},locName,locData); + if Result then + SetWideStrProp(AObject,APropInfo.PropInfo,locData); end; // Qualified readers {$IFDEF HAS_TKBOOL} -procedure BoolReaderQualifier( +function BoolReaderQualifier( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : Boolean; begin locData := False; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType,APropInfo.NameSpace,locName,locData); - SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); + Result := AStore.Get(APropInfo.PropInfo^.PropType,APropInfo.NameSpace,locName,locData); + if Result then + SetOrdProp(AObject,APropInfo.PropInfo,Ord(locData)); end; {$ENDIF HAS_TKBOOL} -procedure ClassReaderQualified( +function ClassReaderQualified( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; objData : TObject; @@ -403,8 +437,8 @@ begin objData := GetObjectProp(AObject,APropInfo.PropInfo); objDataCreateHere := not Assigned(objData); try - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,objData); - if objDataCreateHere then + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,objData); + if objDataCreateHere and Result then SetObjectProp(AObject,APropInfo.PropInfo,objData); finally if objDataCreateHere and ( objData <> GetObjectProp(AObject,APropInfo.PropInfo) ) then @@ -412,11 +446,11 @@ begin end; end; -procedure FloatReaderQualified( +function FloatReaderQualified( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var propName : string; floatBuffer : TFloatBuffer; @@ -429,53 +463,62 @@ begin case GetTypeData(pt)^.FloatType of ftSingle : begin - AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.SingleData); - floatDt := floatBuffer.SingleData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.SingleData); + if Result then + floatDt := floatBuffer.SingleData; end; ftDouble : begin - AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.DoubleData); - floatDt := floatBuffer.DoubleData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.DoubleData); + if Result then + floatDt := floatBuffer.DoubleData; end; ftExtended : begin - AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.ExtendedData); - floatDt := floatBuffer.ExtendedData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.ExtendedData); + if Result then + floatDt := floatBuffer.ExtendedData; end; ftCurr : begin - AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CurrencyData); - floatDt := floatBuffer.CurrencyData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CurrencyData); + if Result then + floatDt := floatBuffer.CurrencyData; end; ftComp : begin - AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CompData); - floatDt := floatBuffer.CompData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,floatBuffer.CompData); + if Result then + floatDt := floatBuffer.CompData; end; + else + Result := False; end; - SetFloatProp(AObject,APropInfo.PropInfo,floatDt); + if Result then + SetFloatProp(AObject,APropInfo.PropInfo,floatDt); end; -procedure Int64ReaderQualified( +function Int64ReaderQualified( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : Int64; begin locData := 0; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); - SetInt64Prop(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); + if Result then + SetInt64Prop(AObject,APropInfo.PropInfo,locData); end; -procedure IntEnumReaderQualified( +function IntEnumReaderQualified( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var propName : string; int64Data : Int64; @@ -491,94 +534,107 @@ begin if ( pt^.Kind = tkEnumeration ) and ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) then begin - AStore.Get(pt,APropInfo.NameSpace,propName,boolData); - SetPropValue(AObject,propName,boolData); + Result := AStore.Get(pt,APropInfo.NameSpace,propName,boolData); + if Result then + SetPropValue(AObject,propName,boolData); end else begin {$ENDIF} enumData.ULongIntData := 0; Case GetTypeData(pt)^.OrdType Of otSByte : Begin - AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ShortIntData); - int64Data := enumData.ShortIntData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ShortIntData); + if Result then + int64Data := enumData.ShortIntData; End; otUByte : Begin - AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ByteData); - int64Data := enumData.ByteData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ByteData); + if Result then + int64Data := enumData.ByteData; End; otSWord : Begin - AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SmallIntData); - int64Data := enumData.SmallIntData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SmallIntData); + if Result then + int64Data := enumData.SmallIntData; End; otUWord : Begin - AStore.Get(pt,APropInfo.NameSpace,propName,enumData.WordData); - int64Data := enumData.WordData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.WordData); + if Result then + int64Data := enumData.WordData; End; otSLong: Begin - AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SLongIntData); - int64Data := enumData.SLongIntData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.SLongIntData); + if Result then + int64Data := enumData.SLongIntData; End; otULong : Begin - AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ULongIntData); - int64Data := enumData.ULongIntData; + Result := AStore.Get(pt,APropInfo.NameSpace,propName,enumData.ULongIntData); + if Result then + int64Data := enumData.ULongIntData; End; + else + Result := False; End; - SetOrdProp(AObject,APropInfo.PropInfo,int64Data); + if Result then + SetOrdProp(AObject,APropInfo.PropInfo,int64Data); {$IFDEF WST_DELPHI} end; {$ENDIF} end; -procedure StringReaderQualified( +function StringReaderQualified( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : string; begin locData := ''; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); - SetStrProp(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); + if Result then + SetStrProp(AObject,APropInfo.PropInfo,locData); end; {$IFDEF WST_UNICODESTRING} -procedure UnicodeStringReaderQualified( +function UnicodeStringReaderQualified( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : UnicodeString; begin locData := ''; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); - SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); + if Result then + SetUnicodeStrProp(AObject,APropInfo.PropInfo,locData); end; {$ENDIF WST_UNICODESTRING} -procedure WideStringReaderQualified( +function WideStringReaderQualified( AObject : TObject; APropInfo : TPropSerializationInfo; AStore : IFormatterBase -); +) : Boolean; var locName : string; locData : WideString; begin locData := ''; locName := APropInfo.ExternalName; - AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); - SetWideStrProp(AObject,APropInfo.PropInfo,locData); + Result := AStore.Get(APropInfo.PropInfo^.PropType{$IFDEF WST_DELPHI}^{$ENDIF},APropInfo.NameSpace,locName,locData); + if Result then + SetWideStrProp(AObject,APropInfo.PropInfo,locData); end; // Simple Writers @@ -1005,47 +1061,55 @@ end; type - TReaderWriterInfo = record + TReaderInfo = record Simple : TPropertyReadProc; Qualified : TPropertyReadProc; end; + TWriterInfo = record + Simple : TPropertyWriteProc; + Qualified : TPropertyWriteProc; + end; + var {$IFDEF FPC} - ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( - ( // Readers - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkUnknown + //ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( + ReaderInfoMap : array[TTypeKind] of TReaderInfo = ( + // Readers + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkUnknown ( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkInteger - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkChar + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkChar ( Simple : @IntEnumReader; Qualified : @IntEnumReaderQualified ;) , //tkEnumeration ( Simple : @FloatReader; Qualified : @FloatReaderQualified ;) , //tkFloat - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkSet - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkMethod + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkSet + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkMethod ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkSString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkLString ( Simple : @StringReader; Qualified : @StringReaderQualified ;) , //tkAString ( Simple : @WideStringReader; Qualified : @WideStringReaderQualified ;) , //tkWString - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkVariant - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkArray - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkRecord - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkInterface + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkVariant + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkArray + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkRecord + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkInterface ( Simple : @ClassReader; Qualified : @ClassReaderQualified ;) , //tkClass - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkObject - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkWChar + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkObject + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkWChar ( Simple : @BoolReader; Qualified : @BoolReaderQualifier ;) , //tkBool ( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkInt64 ( Simple : @Int64Reader; Qualified : @Int64ReaderQualified ;) , //tkQWord - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkDynArray - ( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkInterfaceRaw + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) , //tkDynArray + ( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) //tkInterfaceRaw {$IFDEF WST_TKPROCVAR} - ,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkProcVar + ,( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) //tkProcVar {$ENDIF WST_TKPROCVAR} {$IFDEF WST_UNICODESTRING} ,( Simple : @UnicodeStringReader; Qualified : @UnicodeStringReaderQualified ;) //tkUString - ,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkUChar + ,( Simple : @ErrorFunc; Qualified : @ErrorFunc ;) //tkUChar {$ENDIF WST_UNICODESTRING} - ), - ( // Writers + ); + + WriterInfoMap : array[TTypeKind] of TWriterInfo = ( + // Writers ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkUnknown ( Simple : @IntEnumWriter; Qualified : @IntEnumWriterQualified ;) , //tkInteger ( Simple : @ErrorProc; Qualified : @ErrorProc ;) , //tkChar @@ -1076,36 +1140,38 @@ var ,( Simple : @UnicodeStringWriter; Qualified : @UnicodeStringWriterQualified ;) //tkUString ,( Simple : @ErrorProc; Qualified : @ErrorProc ;) //tkUChar {$ENDIF WST_UNICODESTRING} - ) + ); {$ENDIF FPC} {$IFDEF WST_DELPHI} - ReaderWriterInfoMap : array[0..1] of array[TTypeKind] of TReaderWriterInfo = ( - ( // Readers - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown + ReaderInfoMap : array[TTypeKind] of TReaderInfo = ( + // Readers + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkUnknown ( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkInteger - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkChar + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkChar ( Simple : IntEnumReader; Qualified : IntEnumReaderQualified ;) , //tkEnumeration ( Simple : FloatReader; Qualified : FloatReaderQualified ;) , //tkFloat ( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkString - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkSet + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkSet ( Simple : ClassReader; Qualified : ClassReaderQualified ;) , //tkClass - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkMethod - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkWChar + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkMethod + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkWChar ( Simple : StringReader; Qualified : StringReaderQualified ;) , //tkLString ( Simple : WideStringReader; Qualified : WideStringReaderQualified ;) , //tkWString - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkVariant - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkArray - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkRecord - ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkInterface + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkVariant + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkArray + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkRecord + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) , //tkInterface ( Simple : Int64Reader; Qualified : Int64ReaderQualified ;) , //tkInt64 - ( Simple : ErrorProc; Qualified : ErrorProc ;) //tkDynArray + ( Simple : ErrorFunc; Qualified : ErrorFunc ;) //tkDynArray {$IFDEF WST_UNICODESTRING} ,( Simple : UnicodeStringReader; Qualified : UnicodeStringReaderQualified ;) //tkUString {$ENDIF WST_UNICODESTRING} - ), - ( // Writers + ); + + WriterInfoMap : array[TTypeKind] of TWriterInfo = ( + // Writers ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkUnknown ( Simple : IntEnumWriter; Qualified : IntEnumWriterQualified ;) , //tkInteger ( Simple : ErrorProc; Qualified : ErrorProc ;) , //tkChar @@ -1127,8 +1193,7 @@ var {$IFDEF WST_UNICODESTRING} ,( Simple : UnicodeStringWriter; Qualified : UnicodeStringWriterQualified ;) //tkUString {$ENDIF WST_UNICODESTRING} - ) - ); + ); {$ENDIF WST_DELPHI} { TObjectSerializer } @@ -1170,8 +1235,8 @@ begin serInfo.FName := ppi^.Name; serInfo.FPersisteType := st; serInfo.FPropInfo := ppi; - serInfo.FReaderProc := ReaderWriterInfoMap[0][ppi^.PropType^.Kind].Simple; - serInfo.FWriterProc := ReaderWriterInfoMap[1][ppi^.PropType^.Kind].Simple; + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Simple; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Simple; if Target.IsAttributeProperty(ppi^.Name) then serInfo.FStyle := ssAttibuteSerialization else @@ -1194,8 +1259,8 @@ begin if ( thisRegItem.NameSpace <> regItem.NameSpace ) then begin serInfo.FNameSpace := regItem.NameSpace; serInfo.FQualifiedName := True; - serInfo.FReaderProc := ReaderWriterInfoMap[0][ppi^.PropType^.Kind].Qualified; - serInfo.FWriterProc := ReaderWriterInfoMap[1][ppi^.PropType^.Kind].Qualified; + serInfo.FReaderProc := ReaderInfoMap[ppi^.PropType^.Kind].Qualified; + serInfo.FWriterProc := WriterInfoMap[ppi^.PropType^.Kind].Qualified; end; end; end; @@ -1294,13 +1359,10 @@ begin locSerInfo := TPropSerializationInfo(FSerializationInfos[i]); if ( locSerInfo.Style <> AStore.GetSerializationStyle() ) then AStore.SetSerializationStyle(locSerInfo.Style); - try - locSerInfo.ReaderProc(AObject,locSerInfo,AStore); - except - on e : EBaseRemoteException do begin - if ( locSerInfo.PersisteType = pstAlways ) then - raise; - end; + if ( not locSerInfo.ReaderProc(AObject,locSerInfo,AStore) ) and + ( locSerInfo.PersisteType = pstAlways ) + then begin + AStore.Error(SERR_ParamaterNotFound,[locSerInfo.ExternalName]); end; end; end; diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 69eb6c11f..91d799cb3 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -697,6 +697,7 @@ begin if ( A = nil ) and ( B = nil ) then begin Result := True end else if ( A <> nil ) and ( B <> nil ) then begin + Result := False; if ( A^.NilObject = B^.NilObject ) and ( A^.Count = B^.Count ) and ( CompareNodes(A^.InnerData,B^.InnerData) ) @@ -730,7 +731,7 @@ var ok : Boolean; begin if ( A = nil ) and ( B = nil ) then begin - Result := True + ok := True end else if ( A <> nil ) and ( B <> nil ) then begin if ( A^.Count = B^.Count ) then begin ok := True; @@ -748,7 +749,7 @@ begin ok := False; end; end else begin - Result := ok; + ok := False; end; Result := ok; end; @@ -4850,7 +4851,7 @@ const {$ENDIF FPC} {$IFDEF DELPHI} s_XML_BUFFER : AnsiString = - ' ' + + ' ' + ' 1 ' + ' 0 ' + ' SampleStringContent ' + @@ -4890,7 +4891,7 @@ begin f.BeginObjectRead(strName,TypeInfo(TClass_A)); strName := 'inst'; f.BeginObjectRead(strName,TypeInfo(TTestSmallClass2)); - strBuffer := f.ReadBuffer('ObjProperty'); + Check(f.ReadBuffer('ObjProperty',strBuffer)); f.EndScopeRead(); f.EndScopeRead(); CheckEquals(SpecialTrim(s_XML_BUFFER),SpecialTrim(strBuffer)); diff --git a/wst/trunk/wst_consts.pas b/wst/trunk/wst_consts.pas index 2ccbc7e10..dfa58a382 100644 --- a/wst/trunk/wst_consts.pas +++ b/wst/trunk/wst_consts.pas @@ -21,7 +21,11 @@ resourcestring SERR_InvalidCollectionLength = 'Invalid collection length : %d.'; SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.'; SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.'; - SERR_InvalidParameter = 'Invalid parameter : "%s".'; + SERR_InvalidParameter = 'Invalid parameter : "%s".'; + SERR_NoReaderProc = 'No reader proc for that type, Prop : "(%s : %s)".'; + SERR_NoSerializerFoThisType = 'No serializer for this type : "%s".'; + SERR_ParamaterNotFound = 'Parameter non found : "%s".'; + SERR_SerializerInitializationException = 'Unable to initialize the serializer of that type : "%s".'; implementation