pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Record support :

Browse Source 
- Field may be hidden by calling SetFieldSerializationVisibility()
  - Field may be mapped to XML Attribute by calling RegisterAttributeProperty()

Some methods and routines have been marked "inline". By default the "inline" modifier is not enable. To enable it
uncomment the "//{$DEFINE USE_INLINE}" line in wst_global.inc.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@244 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2007-08-19 21:04:16 +00:00
parent 11a897fc26
commit 1069954eba
16 changed files with 720 additions and 380 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
wst/trunk/base_binary_formatter.pas
View File

@ -16,7 +16,7 @@ interface
uses
Classes, SysUtils, Contnrs, TypInfo,
base_service_intf, binary_streamer;
base_service_intf, binary_streamer, wst_types;
{$DEFINE wst_binary_header}
@ -30,8 +30,11 @@ const
type
EBinaryFormatterException = class(EServiceException)
End;
end;
EBinaryException = class(EBaseRemoteException)
end;
TDataName = AnsiString;
TDataType = (
dtInt8U, dtInt8S,
@ -178,94 +181,94 @@ type
protected
function HasScope():Boolean;
procedure CheckScope();
procedure ClearStack();
procedure PushStack(AScopeObject : PDataBuffer;Const AScopeType : TScopeType = stObject);
function StackTop():TStackItem;
function PopStack():TStackItem;
function GetRootData() : PDataBuffer;
procedure ClearStack();{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PushStack(AScopeObject : PDataBuffer;Const AScopeType : TScopeType = stObject);{$IFDEF USE_INLINE}inline;{$ENDIF}
function StackTop():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PopStack():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetRootData() : PDataBuffer;{$IFDEF USE_INLINE}inline;{$ENDIF}
protected
procedure PutFloat(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TFloat_Extended_10
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutInt(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TInt64S
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutStr(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : String
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutEnum(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TEnumData
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutBool(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Boolean
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Int64
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutObj(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TObject
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutRecord(
const AName : string;
const ATypeInfo : PTypeInfo;
const AData : Pointer
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetDataBuffer(var AName : String):PDataBuffer;
function GetDataBuffer(var AName : String):PDataBuffer;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetEnum(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TEnumData
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetBool(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Boolean
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetFloat(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TFloat_Extended_10
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TInt64S
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt64(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Int64
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetStr(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : String
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetObj(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TObject
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetRecord(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Pointer
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
public
constructor Create();override;
destructor Destroy();override;

326
wst/trunk/base_service_intf.pas
View File

@ -1097,7 +1097,7 @@ type
FPool : TIntfPool;
FTimeOut: PtrUInt;
private
procedure PreparePool();
procedure PreparePool();{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure SetPooled(const AValue: Boolean);
procedure SetPoolMax(const AValue: PtrInt);
procedure SetPoolMin(const AValue: PtrInt);
@ -1138,7 +1138,7 @@ type
FExternalNames : TStrings;
FInternalNames : TStrings;
private
procedure CreateInternalObjects();
procedure CreateInternalObjects();{$IFDEF USE_INLINE}inline;{$ENDIF}
public
constructor Create(
ANameSpace : string;
@ -1146,12 +1146,12 @@ type
Const ADeclaredName : string = ''
);
destructor Destroy();override;
function AddPascalSynonym(const ASynonym : string):TTypeRegistryItem;//inline;
function IsSynonym(const APascalTypeName : string):Boolean;//inline;
function AddPascalSynonym(const ASynonym : string):TTypeRegistryItem;
function IsSynonym(const APascalTypeName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure RegisterExternalPropertyName(const APropName, AExtPropName : string);
function GetExternalPropertyName(const APropName : string) : string;
function GetInternalPropertyName(const AExtPropName : string) : string;
function GetExternalPropertyName(const APropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetInternalPropertyName(const AExtPropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure RegisterObject(const APropName : string; const AObject : TObject);
function GetObject(const APropName : string) : TObject;
@ -1167,8 +1167,8 @@ type
TTypeRegistry = class
Private
FList : TObjectList;
function GetCount: Integer;
function GetItemByIndex(Index: Integer): TTypeRegistryItem;
function GetCount: Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetItemByIndex(Index: Integer): TTypeRegistryItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetItemByTypeInfo(Index: PTypeInfo): TTypeRegistryItem;
Public
constructor Create();
@ -1222,8 +1222,18 @@ const
PROP_LIST_DELIMITER = ';';
FIELDS_STRING = '__FIELDS__';
function GetTypeRegistry():TTypeRegistry;
function GetTypeRegistry():TTypeRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure RegisterStdTypes();
procedure RegisterAttributeProperty(
const ATypeInfo : PTypeInfo; // must be tkClass or tkRecord
const AProperty : shortstring
);
procedure SetFieldSerializationVisibility(
const ATypeInfo : PTypeInfo; // must be tkRecord
const AField : shortstring;
const AVisibility : Boolean
);
function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType;
@ -1336,6 +1346,62 @@ begin
r.Register(sXSD_NS,TypeInfo(TComplexBooleanContentRemotable),'boolean').AddPascalSynonym('TComplexBooleanContentRemotable');
end;
procedure SetFieldSerializationVisibility(
const ATypeInfo : PTypeInfo; // must be tkRecord
const AField : shortstring;
const AVisibility : Boolean
);
var
recordData : TRecordRttiDataObject;
begin
if Assigned(ATypeInfo) and ( ATypeInfo^.Kind = tkRecord ) and
( not IsStrEmpty(AField) )
then begin
recordData := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetObject(FIELDS_STRING) as TRecordRttiDataObject;
if Assigned(recordData) then begin
recordData.GetField(AField)^.Visible := AVisibility;
end else begin
raise EServiceConfigException.CreateFmt('Record extended RTTI informations not found in type registry : "%s".',[ATypeInfo^.Name]);
end;
end else begin
raise EServiceConfigException.Create('Invalid parameters.');
end;
end;
procedure RegisterAttributeProperty(
const ATypeInfo : PTypeInfo;
const AProperty : shortstring
);
var
ok : Boolean;
recordData : TRecordRttiDataObject;
begin
ok := False;
if Assigned(ATypeInfo) and
( not IsStrEmpty(AProperty) )
then begin
case ATypeInfo^.Kind of
tkClass :
begin
if GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TAbstractComplexRemotable) then begin
TAbstractComplexRemotableClass(GetTypeData(ATypeInfo)^.ClassType).RegisterAttributeProperty(AProperty);
ok := True;
end;
end;
tkRecord :
begin
recordData := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetObject(FIELDS_STRING) as TRecordRttiDataObject;
if Assigned(recordData) then begin
recordData.GetField(AProperty)^.IsAttribute := True;
ok := True;
end;
end;
end;
end;
if not ok then
raise EServiceConfigException.Create('Invalid parameters.');
end;
{$IFDEF FPC}
function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType;
begin
@ -2392,7 +2458,7 @@ begin
inherited Destroy();
end;
function TTypeRegistryItem.AddPascalSynonym(const ASynonym: string):TTypeRegistryItem; //inline;
function TTypeRegistryItem.AddPascalSynonym(const ASynonym: string):TTypeRegistryItem;
begin
Result := Self;
if AnsiSameText(ASynonym,DataType^.Name) then
@ -2405,7 +2471,7 @@ begin
FSynonymTable.Add(AnsiLowerCase(ASynonym));
end;
function TTypeRegistryItem.IsSynonym(const APascalTypeName: string): Boolean;//inline;
function TTypeRegistryItem.IsSynonym(const APascalTypeName: string): Boolean;
begin
Result := AnsiSameText(APascalTypeName,DataType^.Name);
if ( not Result ) and Assigned(FSynonymTable) then
@ -4614,64 +4680,66 @@ begin
ss := AStore.GetSerializationStyle();
for i := 0 to Pred(typData^.FieldCount) do begin
p := @(typData^.Fields[i]);
pt := p^.TypeInfo^;//{$IFNDEF FPC}^{$ENDIF};
{if IsAttributeProperty(p^.Name) then begin
if ( ss <> ssAttibuteSerialization ) then
ss := ssAttibuteSerialization;
end else begin
if ( ss <> ssNodeSerialization ) then
ss := ssNodeSerialization;
end;
if ( ss <> AStore.GetSerializationStyle() ) then
AStore.SetSerializationStyle(ss);}
AStore.SetSerializationStyle(ssNodeSerialization);
prpName := typRegItem.GetExternalPropertyName(p^.Name);
recFieldAddress := recStart;
Inc(recFieldAddress,p^.Offset);
case pt^.Kind of
tkInt64 : AStore.Put(prpName,pt,PInt64(recFieldAddress)^);
{$IFDEF HAS_QWORD}
tkQWord : AStore.Put(prpName,pt,PQWord(recFieldAddress)^);
{$ENDIF}
tkLString{$IFDEF FPC},tkAString{$ENDIF} : AStore.Put(prpName,pt,PString(recFieldAddress)^);
tkClass : AStore.Put(prpName,pt,PObject(recFieldAddress)^);
tkRecord : AStore.Put(prpName,pt,Pointer(recFieldAddress)^);
{$IFDEF FPC}
tkBool : AStore.Put(prpName,pt,PBoolean(recFieldAddress)^);
{$ENDIF}
tkEnumeration,tkInteger :
begin
{$IFNDEF FPC}
if ( pt^.Kind = tkEnumeration ) and
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin
AStore.Put(prpName,pt,PBoolean(recFieldAddress)^);
end else begin
if p^.Visible then begin
pt := p^.TypeInfo^;
if p^.IsAttribute then begin
if ( ss <> ssAttibuteSerialization ) then
ss := ssAttibuteSerialization;
end else begin
if ( ss <> ssNodeSerialization ) then
ss := ssNodeSerialization;
end;
if ( ss <> AStore.GetSerializationStyle() ) then
AStore.SetSerializationStyle(ss);
AStore.SetSerializationStyle(ss);
prpName := typRegItem.GetExternalPropertyName(p^.Name);
recFieldAddress := recStart;
Inc(recFieldAddress,p^.Offset);
case pt^.Kind of
tkInt64 : AStore.Put(prpName,pt,PInt64(recFieldAddress)^);
{$IFDEF HAS_QWORD}
tkQWord : AStore.Put(prpName,pt,PQWord(recFieldAddress)^);
{$ENDIF}
case GetTypeData(pt)^.OrdType of
otSByte : AStore.Put(prpName,pt,PShortInt(recFieldAddress)^);
otUByte : AStore.Put(prpName,pt,PByte(recFieldAddress)^);
otSWord : AStore.Put(prpName,pt,PSmallInt(recFieldAddress)^);
otUWord : AStore.Put(prpName,pt,PWord(recFieldAddress)^);
otSLong : AStore.Put(prpName,pt,PLongint(recFieldAddress)^);
otULong : AStore.Put(prpName,pt,PLongWord(recFieldAddress)^);
tkLString{$IFDEF FPC},tkAString{$ENDIF} : AStore.Put(prpName,pt,PString(recFieldAddress)^);
tkClass : AStore.Put(prpName,pt,PObject(recFieldAddress)^);
tkRecord : AStore.Put(prpName,pt,Pointer(recFieldAddress)^);
{$IFDEF FPC}
tkBool : AStore.Put(prpName,pt,PBoolean(recFieldAddress)^);
{$ENDIF}
tkEnumeration,tkInteger :
begin
{$IFNDEF FPC}
if ( pt^.Kind = tkEnumeration ) and
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin
AStore.Put(prpName,pt,PBoolean(recFieldAddress)^);
end else begin
{$ENDIF}
case GetTypeData(pt)^.OrdType of
otSByte : AStore.Put(prpName,pt,PShortInt(recFieldAddress)^);
otUByte : AStore.Put(prpName,pt,PByte(recFieldAddress)^);
otSWord : AStore.Put(prpName,pt,PSmallInt(recFieldAddress)^);
otUWord : AStore.Put(prpName,pt,PWord(recFieldAddress)^);
otSLong : AStore.Put(prpName,pt,PLongint(recFieldAddress)^);
otULong : AStore.Put(prpName,pt,PLongWord(recFieldAddress)^);
end;
{$IFNDEF FPC}
end;
{$IFNDEF FPC}
{$ENDIF}
end;
{$ENDIF}
end;
tkFloat :
begin
case GetTypeData(pt)^.FloatType of
ftSingle : AStore.Put(prpName,pt,PSingle(recFieldAddress)^);
ftDouble : AStore.Put(prpName,pt,PDouble(recFieldAddress)^);
ftExtended : AStore.Put(prpName,pt,PExtended(recFieldAddress)^);
ftCurr : AStore.Put(prpName,pt,PCurrency(recFieldAddress)^);
{$IFDEF HAS_COMP}
ftComp : AStore.Put(prpName,pt,PComp(recFieldAddress)^);
{$ENDIF}
tkFloat :
begin
case GetTypeData(pt)^.FloatType of
ftSingle : AStore.Put(prpName,pt,PSingle(recFieldAddress)^);
ftDouble : AStore.Put(prpName,pt,PDouble(recFieldAddress)^);
ftExtended : AStore.Put(prpName,pt,PExtended(recFieldAddress)^);
ftCurr : AStore.Put(prpName,pt,PCurrency(recFieldAddress)^);
{$IFDEF HAS_COMP}
ftComp : AStore.Put(prpName,pt,PComp(recFieldAddress)^);
{$ENDIF}
end;
end;
end;
end;
end;
end;
end;
@ -4694,7 +4762,6 @@ var
pt : PTypeInfo;
propName : String;
p : PRecordFieldInfo;
persistType : TPropStoreType;
oldSS,ss : TSerializationStyle;
typRegItem : TTypeRegistryItem;
typDataObj : TObject;
@ -4718,70 +4785,71 @@ begin
recStart := PByte(ARecord);
for i := 0 to Pred(typData^.FieldCount) do begin
p := @(typData^.Fields[i]);
persistType := pstOptional;// IsStoredPropClass(objTypeData^.ClassType,p);
pt := p^.TypeInfo^;//{$IFNDEF FPC}^{$ENDIF};
propName := typRegItem.GetExternalPropertyName(p^.Name);
{if IsAttributeProperty(p^.Name) then begin
ss := ssAttibuteSerialization;
end else begin
ss := ssNodeSerialization;
end;
if ( ss <> AStore.GetSerializationStyle() ) then
AStore.SetSerializationStyle(ss);}
AStore.SetSerializationStyle(ssNodeSerialization);
recFieldAddress := recStart;
Inc(recFieldAddress,p^.Offset);
try
Case pt^.Kind Of
tkInt64 : AStore.Get(pt,propName,PInt64(recFieldAddress)^);
{$IFDEF HAS_QWORD}
tkQWord : AStore.Get(pt,propName,PQWord(recFieldAddress)^);
{$ENDIF}
tkLString{$IFDEF FPC}, tkAString{$ENDIF} : AStore.Get(pt,propName,PString(recFieldAddress)^);
{$IFDEF FPC}
tkBool : AStore.Get(pt,propName,PBoolean(recFieldAddress)^);
{$ENDIF}
tkClass : AStore.Get(pt,propName,PObject(recFieldAddress)^);
tkRecord : AStore.Get(pt,propName,Pointer(recFieldAddress)^);
tkEnumeration,tkInteger :
Begin
{$IFNDEF FPC}
if ( pt^.Kind = tkEnumeration ) and
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin
AStore.Get(pt,propName,PBoolean(recFieldAddress)^);
end else begin
{$ENDIF}
case GetTypeData(pt)^.OrdType Of
otSByte : AStore.Get(pt,propName,PShortInt(recFieldAddress)^);
otUByte : AStore.Get(pt,propName,PByte(recFieldAddress)^);
otSWord : AStore.Get(pt,propName,PSmallInt(recFieldAddress)^);
otUWord : AStore.Get(pt,propName,PWord(recFieldAddress)^);
otSLong : AStore.Get(pt,propName,PLongint(recFieldAddress)^);
otULong : AStore.Get(pt,propName,PLongWord(recFieldAddress)^);
end;
{$IFNDEF FPC}
end;
{$ENDIF}
End;
tkFloat :
begin
case GetTypeData(pt)^.FloatType of
ftSingle : AStore.Get(pt,propName,PSingle(recFieldAddress)^);
ftDouble : AStore.Get(pt,propName,PDouble(recFieldAddress)^);
ftExtended : AStore.Get(pt,propName,PExtended(recFieldAddress)^);
ftCurr : AStore.Get(pt,propName,PCurrency(recFieldAddress)^);
{$IFDEF HAS_COMP}
ftComp : AStore.Get(pt,propName,PComp(recFieldAddress)^);
{$ENDIF}
end;
end;
End;
except
on E : EServiceException do begin
if ( persistType = pstAlways ) then
raise;
if p^.Visible then begin
pt := p^.TypeInfo^;
propName := typRegItem.GetExternalPropertyName(p^.Name);
if p^.IsAttribute then begin
ss := ssAttibuteSerialization;
end else begin
ss := ssNodeSerialization;
end;
if ( ss <> AStore.GetSerializationStyle() ) then
AStore.SetSerializationStyle(ss);
AStore.SetSerializationStyle(ss);
recFieldAddress := recStart;
Inc(recFieldAddress,p^.Offset);
//try
Case pt^.Kind Of
tkInt64 : AStore.Get(pt,propName,PInt64(recFieldAddress)^);
{$IFDEF HAS_QWORD}
tkQWord : AStore.Get(pt,propName,PQWord(recFieldAddress)^);
{$ENDIF}
tkLString{$IFDEF FPC}, tkAString{$ENDIF} : AStore.Get(pt,propName,PString(recFieldAddress)^);
{$IFDEF FPC}
tkBool : AStore.Get(pt,propName,PBoolean(recFieldAddress)^);
{$ENDIF}
tkClass : AStore.Get(pt,propName,PObject(recFieldAddress)^);
tkRecord : AStore.Get(pt,propName,Pointer(recFieldAddress)^);
tkEnumeration,tkInteger :
Begin
{$IFNDEF FPC}
if ( pt^.Kind = tkEnumeration ) and
( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) )
then begin
AStore.Get(pt,propName,PBoolean(recFieldAddress)^);
end else begin
{$ENDIF}
case GetTypeData(pt)^.OrdType Of
otSByte : AStore.Get(pt,propName,PShortInt(recFieldAddress)^);
otUByte : AStore.Get(pt,propName,PByte(recFieldAddress)^);
otSWord : AStore.Get(pt,propName,PSmallInt(recFieldAddress)^);
otUWord : AStore.Get(pt,propName,PWord(recFieldAddress)^);
otSLong : AStore.Get(pt,propName,PLongint(recFieldAddress)^);
otULong : AStore.Get(pt,propName,PLongWord(recFieldAddress)^);
end;
{$IFNDEF FPC}
end;
{$ENDIF}
End;
tkFloat :
begin
case GetTypeData(pt)^.FloatType of
ftSingle : AStore.Get(pt,propName,PSingle(recFieldAddress)^);
ftDouble : AStore.Get(pt,propName,PDouble(recFieldAddress)^);
ftExtended : AStore.Get(pt,propName,PExtended(recFieldAddress)^);
ftCurr : AStore.Get(pt,propName,PCurrency(recFieldAddress)^);
{$IFDEF HAS_COMP}
ftComp : AStore.Get(pt,propName,PComp(recFieldAddress)^);
{$ENDIF}
end;
end;
End;
{except
on E : EServiceException do begin
if ( persistType = pstAlways ) then
raise;
end;
end;}
end;
end;
end;

52
wst/trunk/base_soap_formatter.pas
View File

@ -139,12 +139,12 @@ type
FKeepedEncoding : TSOAPEncodingStyle;
FSerializationStyle : TSerializationStyle;
procedure InternalClear(const ACreateDoc : Boolean);
procedure InternalClear(const ACreateDoc : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF}
function NextNameSpaceCounter():Integer;//inline;
function HasScope():Boolean;//inline;
function NextNameSpaceCounter():Integer;{$IFDEF USE_INLINE}inline;{$ENDIF}
function HasScope():Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure CheckScope();//inline;
procedure CheckScope();{$IFDEF USE_INLINE}inline;{$ENDIF}
function InternalPutData(
Const AName : String;
Const ATypeInfo : PTypeInfo;
@ -154,89 +154,89 @@ type
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TEnumIntType
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutBool(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Boolean
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Int64
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutStr(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : String
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutFloat(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Extended
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutObj(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TObject
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutRecord(
const AName : string;
const ATypeInfo : PTypeInfo;
const AData : Pointer
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetNodeValue(var AName : String):DOMString;
procedure GetEnum(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TEnumIntType
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetBool(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Boolean
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
procedure GetInt(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Integer
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF}
procedure GetInt64(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Int64
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetFloat(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Extended
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetStr(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : String
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetObj(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TObject
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetRecord(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Pointer
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
protected
function GetXmlDoc():TwstXMLDocument;
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;
function GetXmlDoc():TwstXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PushStack(
AScopeObject : TDOMNode;
const AStyle : TArrayStyle;
const AItemName : string
):TStackItem;overload;
):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
function FindAttributeByValueInNode(
Const AAttValue : String;
Const ANode : TDOMNode;
@ -252,13 +252,13 @@ type
function GetNameSpaceShortName(
const ANameSpace : string;
const ACreateIfNotFound : Boolean
):shortstring;
):shortstring;{$IFDEF USE_INLINE}inline;{$ENDIF}
protected
function GetCurrentScope():String;
function GetCurrentScopeObject():TDOMElement;
function StackTop():TStackItem;
function PopStack():TStackItem;
procedure ClearStack();
function StackTop():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PopStack():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure ClearStack();{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure BeginScope(
Const AScopeName,ANameSpace : string;
Const ANameSpaceShortName : string ;

52
wst/trunk/base_xmlrpc_formatter.pas
View File

@ -150,66 +150,66 @@ type
FStack : TObjectStack;
FSerializationStyle: TSerializationStyle;
private
procedure InternalClear(const ACreateDoc : Boolean);
procedure InternalClear(const ACreateDoc : Boolean);{$IFDEF USE_INLINE}inline;{$ENDIF}
function HasScope():Boolean;//inline;
function HasScope():Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure CheckScope();//inline;
procedure CheckScope();{$IFDEF USE_INLINE}inline;{$ENDIF}
function InternalPutData(
const AName : string;
const AType : TXmlRpcDataType;
const AData : string
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutEnum(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TEnumIntType
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
function PutBool(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Boolean
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
{$ENDIF}
function PutInt64(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Int64
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutStr(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : String
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PutFloat(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : Extended
):TDOMNode;
):TDOMNode;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutObj(
Const AName : String;
Const ATypeInfo : PTypeInfo;
Const AData : TObject
);
); {$IFDEF USE_INLINE}inline;{$ENDIF}
procedure PutRecord(
const AName : string;
const ATypeInfo : PTypeInfo;
const AData : Pointer
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetNodeValue(var AName : String):DOMString;
procedure GetEnum(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TEnumIntType
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
{$IFDEF FPC}
procedure GetBool(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Boolean
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetInt(
Const ATypeInfo : PTypeInfo;
Var AName : String;
@ -220,36 +220,36 @@ type
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Int64
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetFloat(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : Extended
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetStr(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : String
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetObj(
Const ATypeInfo : PTypeInfo;
Var AName : String;
Var AData : TObject
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure GetRecord(
const ATypeInfo : PTypeInfo;
var AName : String;
var AData : Pointer
);
);{$IFDEF USE_INLINE}inline;{$ENDIF}
protected
function GetXmlDoc():TXMLDocument;
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;
function GetXmlDoc():TXMLDocument;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PushStack(AScopeObject : TDOMNode):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PushStack(
AScopeObject : TDOMNode;
const AStyle : TArrayStyle;
const AItemName : string
):TStackItem;overload;
function PushStackParams(AScopeObject : TDOMNode) : TStackItem;
):TStackItem;overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PushStackParams(AScopeObject : TDOMNode) : TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
function FindAttributeByValueInNode(
Const AAttValue : String;
Const ANode : TDOMNode;
@ -264,10 +264,10 @@ type
function FindAttributeByNameInScope(Const AAttName : String):String;
protected
function GetCurrentScope():String;
function GetCurrentScopeObject():TDOMElement;
function StackTop():TStackItem;
function PopStack():TStackItem;
procedure ClearStack();
function GetCurrentScopeObject():TDOMElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
function StackTop():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
function PopStack():TStackItem;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure ClearStack();{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure BeginScope(
Const AScopeName,ANameSpace : string;
Const ANameSpaceShortName : string ;

4
wst/trunk/binary_formatter.pas
View File

@ -100,7 +100,7 @@ end;
procedure TBinaryFormatter.BeginCallRead(ACallContext : ICallContext);
Var
s,nme : string;
e : EBaseRemoteException;
e : EBinaryException;
begin
ClearStack();
PushStack(GetRootData(),stObject);
@ -109,7 +109,7 @@ begin
s := StackTop().GetByIndex(0)^.Name;
If AnsiSameText(s,'Fault') Then Begin
BeginObjectRead(s,nil);
e := EBaseRemoteException.Create('');
e := EBinaryException.Create('');
Try
nme := 'faultcode';
Get(TypeInfo(string),nme,s);

11
wst/trunk/binary_streamer.pas
View File

@ -17,10 +17,7 @@ unit binary_streamer;
interface
uses
Classes, SysUtils, Types;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
Classes, SysUtils, Types, wst_types;
Const
MAX_ARRAY_LENGTH = 1024*1024;
@ -30,7 +27,7 @@ Type
TInt8U = Byte; TInt8S = ShortInt;
TInt16U = Word; TInt16S = SmallInt;
TInt32U = LongWord; TInt32S = LongInt;
TInt64S = Int64;TInt64U = QWord;
TInt64S = Int64; TInt64U = QWord;
TBoolData = Boolean;
TEnumData = Int64;
TStringData = AnsiString;
@ -89,8 +86,8 @@ Type
function ReadCurrency():TFloat_Currency_8;
End;
function CreateBinaryReader(AStream : TStream):IDataStoreReader;
function CreateBinaryWriter(AStream : TStream):IDataStore;
function CreateBinaryReader(AStream : TStream):IDataStoreReader;{$IFDEF USE_INLINE}inline;{$ENDIF}
function CreateBinaryWriter(AStream : TStream):IDataStore;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure ReverseBytes(var AData; const ALength : Integer);{$IFDEF USE_INLINE}{$IFDEF ENDIAN_BIG}inline;{$ENDIF}{$ENDIF}
function Reverse_16(const AValue:Word):Word;{$IFDEF USE_INLINE}inline;{$ENDIF}

6
wst/trunk/imp_utils.pas
View File

@ -29,8 +29,8 @@ Type
TPublishedPropertyManager = class(TInterfacedObject,IPropertyManager)
Private
FParent : TObject;
procedure Error(Const AMsg:string);overload;
procedure Error(Const AMsg:string; Const AArgs : array of const);overload;
procedure Error(Const AMsg:string);overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure Error(Const AMsg:string; Const AArgs : array of const);overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
Protected
procedure SetProperty(Const AName,AValue:string);
procedure SetProperties(Const APropsStr:string);
@ -42,7 +42,7 @@ Type
constructor Create(AParent : TObject);
End;
function IsStrEmpty(Const AStr:String):Boolean;
function IsStrEmpty(Const AStr:String):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetToken(var ABuffer : string; const ADelimiter : string): string;
function ExtractOptionName(const ACompleteName : string):string;

30
wst/trunk/record_rtti.pas
View File

@ -27,6 +27,8 @@ type
Name : shortstring;
TypeInfo : PPTypeInfo;
Offset : PtrUInt;
IsAttribute : Boolean;
Visible : Boolean;
end;
PRecordTypeData = ^TRecordTypeData;
@ -44,6 +46,8 @@ type
constructor Create(const AData : PRecordTypeData; const AFieldList : string);
destructor Destroy();override;
function GetRecordTypeData() : PRecordTypeData;
function FindField(const AFieldName : shortstring) : PRecordFieldInfo;
function GetField(const AFieldName : shortstring) : PRecordFieldInfo;
end;
function MakeRecordTypeInfo(ARawTypeInfo : PTypeInfo) : PRecordTypeData;
@ -182,6 +186,7 @@ begin
fieldInfo := @(resBuffer^.Fields[(i - 1)]);
fieldInfo^.TypeInfo := fld^.TypeInfo;
fieldInfo^.Offset := fld^.Offset;
fieldInfo^.Visible := True;
end;
Result := resBuffer;
end;
@ -258,6 +263,7 @@ begin
Inc(Temp,sizeof(Info));
Offset := PLongint(Temp)^;
fieldInfo^.Offset := Offset;
fieldInfo^.Visible := True;
Inc(Temp,sizeof(Offset));
end;
Result := resBuffer;
@ -306,6 +312,30 @@ begin
Result := PRecordTypeData(Data);
end;
function TRecordRttiDataObject.FindField(const AFieldName : shortstring) : PRecordFieldInfo;
var
i : PtrInt;
locData : PRecordTypeData;
locField : shortstring;
begin
Result := nil;
locData := PRecordTypeData(Data);
locField := UpperCase(AFieldName);
for i := 0 to Pred(locData^.FieldCount) do begin
if ( locField = UpperCase(locData^.Fields[i].Name) ) then begin
Result := @(locData^.Fields[i]);
Break;
end;
end;
end;
function TRecordRttiDataObject.GetField(const AFieldName : shortstring) : PRecordFieldInfo;
begin
Result := FindField(AFieldName);
if ( Result = nil ) then
raise Exception.CreateFmt('"%s" is not a field of "%s".',[AFieldName,GetRecordTypeData()^.Name]);
end;
initialization
{$IFDEF WST_RECORD_RTTI}
RawTypeInfoList := TList.Create();

21
wst/trunk/samples/http_server/http_server.lpi
View File

@ -12,7 +12,7 @@
<MainUnit Value="0"/>
<IconPath Value=".\"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="1"/>
<ActiveEditorIndexAtStart Value="2"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -35,7 +35,7 @@
<PackageName Value="indylaz"/>
</Item1>
</RequiredPackages>
<Units Count="72">
<Units Count="73">
<Unit0>
<Filename Value="http_server.pas"/>
<IsPartOfProject Value="True"/>
@ -421,8 +421,8 @@
<Unit53>
<Filename Value="..\..\config_objects.pas"/>
<UnitName Value="config_objects"/>
<CursorPos X="74" Y="99"/>
<TopLine Value="85"/>
<CursorPos X="19" Y="14"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
@ -555,8 +555,19 @@
<TopLine Value="176"/>
<UsageCount Value="13"/>
</Unit71>
<Unit72>
<Filename Value="..\..\wst_global.inc"/>
<CursorPos X="35" Y="3"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit72>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="..\..\config_objects.pas"/>
<Caret Line="14" Column="19" TopLine="1"/>
</Position1>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>

11
wst/trunk/samples/user_client_console/user_client_console.lpi
View File

@ -355,16 +355,7 @@
<UsageCount Value="10"/>
</Unit42>
</Units>
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="user_client_console.pas"/>
<Caret Line="252" Column="5" TopLine="250"/>
</Position1>
<Position2>
<Filename Value="user_client_console.pas"/>
<Caret Line="8" Column="111" TopLine="1"/>
</Position2>
</JumpHistory>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>

16
wst/trunk/server_binary_formatter.pas
View File

@ -20,18 +20,12 @@ uses
base_service_intf, server_service_intf,
base_binary_formatter;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
const
sBINARY_CONTENT_TYPE = 'binary';
sPROTOCOL_NAME = sBINARY_CONTENT_TYPE;
procedure Server_service_RegisterBinaryFormat();
implementation
Type
type
{ TBinaryFormatter }
@ -51,6 +45,12 @@ Type
);
procedure EndExceptionList();
End;
procedure Server_service_RegisterBinaryFormat();
implementation
Type
{ TBinaryFormatterFactory }

12
wst/trunk/service_intf.pas
View File

@ -85,10 +85,10 @@ Type
private
procedure LoadProperties();
protected
function GetTarget():String;
function GetSerializer() : IFormatterClient;
function GetCallHandler() : ICallMaker;
function GetTransport() : ITransport;
function GetTarget():String;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetSerializer() : IFormatterClient;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetCallHandler() : ICallMaker;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetTransport() : ITransport;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure MakeCall();
class function GetServiceType() : PTypeInfo;virtual;abstract;
@ -147,8 +147,8 @@ Type
);
End;
function GetFormaterRegistry():IFormaterQueryRegistry;
function GetTransportRegistry():ITransportRegistry;
function GetFormaterRegistry():IFormaterQueryRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetTransportRegistry():ITransportRegistry;{$IFDEF USE_INLINE}inline;{$ENDIF}
implementation
uses imp_utils, metadata_repository;

11
wst/trunk/tests/test_suite/test_utilities.pas
View File

@ -1,3 +1,14 @@
{ This file is part of the Web Service Toolkit
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$INCLUDE wst_global.inc}
unit test_utilities;

144
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -1,6 +1,6 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2006 by Inoussa OUEDRAOGO
Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
@ -503,6 +503,17 @@ type
procedure ExceptBlock_server();
procedure ExceptBlock_client();
end;
{ TTest_BinaryFormatterExceptionBlock }
TTest_BinaryFormatterExceptionBlock = class(TTestCase)
protected
function CreateFormatter():IFormatterResponse;
function CreateFormatterClient():IFormatterClient;
published
procedure ExceptBlock_server();
procedure ExceptBlock_client();
end;
implementation
uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_rtti,
@ -514,7 +525,8 @@ uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_r
, DOM, XMLRead, wst_fpc_xml
{$ENDIF}
, server_service_soap, soap_formatter,
server_service_xmlrpc, xmlrpc_formatter;
server_service_xmlrpc, xmlrpc_formatter,
binary_streamer, server_binary_formatter, binary_formatter;
function TTestFormatterSimpleType.Support_ComplextType_with_SimpleContent( ): Boolean;
begin
@ -3725,6 +3737,130 @@ begin
end;
end;
{ TTest_BinaryFormatterExceptionBlock }
function TTest_BinaryFormatterExceptionBlock.CreateFormatter() : IFormatterResponse;
begin
Result := server_binary_formatter.TBinaryFormatter.Create() as IFormatterResponse;
end;
function TTest_BinaryFormatterExceptionBlock.CreateFormatterClient() : IFormatterClient;
begin
Result := binary_formatter.TBinaryFormatter.Create() as IFormatterClient;
end;
function loc_FindObj(const AOwner: PDataBuffer; const AName : TDataName) : PDataBuffer;
Var
p : PObjectBufferItem;
Begin
Assert(AOwner^.DataType >= dtObject);
Result := Nil;
p:= AOwner^.ObjectData^.Head;
While Assigned(p) Do Begin
If AnsiSameText(AName,p^.Data^.Name) Then Begin
Result := p^.Data;
Exit;
End;
p := p^.Next;
End;
End;
procedure TTest_BinaryFormatterExceptionBlock.ExceptBlock_server();
const VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.';
var
f : IFormatterResponse;
strm : TMemoryStream;
root, bodyNode, faultNode, tmpNode : PDataBuffer;
excpt_code, excpt_msg : string;
begin
root := nil;
f := CreateFormatter();
f.BeginExceptionList(VAL_CODE,VAL_MSG);
f.EndExceptionList();
strm := TMemoryStream.Create();
try
f.SaveToStream(strm);
strm.Position := 0;
root := LoadObjectFromStream(CreateBinaryReader(strm));
Check(Assigned(root));
CheckEquals(Ord(dtObject), Ord(root^.DataType),'root^.DataType');
Check(Assigned(root^.ObjectData),'root^.ObjectData');
CheckEquals(False,root^.ObjectData^.NilObject,'root^.NilObject');
Check(root^.ObjectData^.Count > 0, 'root^.Count');
bodyNode := root^.ObjectData^.Head^.Data;
Check(Assigned(bodyNode),'body');
CheckEquals(Ord(dtObject), Ord(bodyNode^.DataType),'body.DataType');
CheckEquals(False,bodyNode^.ObjectData^.NilObject,'body.NilObject');
Check(bodyNode^.ObjectData^.Count > 0, 'body.Count');
faultNode := bodyNode^.ObjectData^.Head^.Data;
Check(Assigned(faultNode),'fault');
CheckEquals(Ord(dtObject), Ord(faultNode^.DataType),'fault.DataType');
CheckEquals(False,faultNode^.ObjectData^.NilObject,'fault.NilObject');
Check(faultNode^.ObjectData^.Count > 0, 'fault.Count');
tmpNode := loc_FindObj(faultNode,'faultcode');
Check(Assigned(tmpNode),'faultcode');
CheckEquals(Ord(dtString), Ord(tmpNode^.DataType),'faultcode.DataType');
excpt_code := tmpNode^.StrData^.Data;
CheckEquals(VAL_CODE,excpt_code,'faultCode');
tmpNode := loc_FindObj(faultNode,'faultstring');
Check(Assigned(tmpNode),'faultstring');
CheckEquals(Ord(dtString), Ord(tmpNode^.DataType),'faultstring.DataType');
excpt_msg := tmpNode^.StrData^.Data;
CheckEquals(VAL_MSG,excpt_msg,'faultString');
finally
FreeAndNil(strm);
ClearObj(root);
end;
end;
procedure TTest_BinaryFormatterExceptionBlock.ExceptBlock_client();
const
VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.';
var
f : IFormatterClient;
strm : TMemoryStream;
root, bodyNode, faultNode, tmpNode : PDataBuffer;
excpt_code, excpt_msg : string;
locStore : IDataStore;
begin
excpt_code := '';
excpt_msg := '';
root := CreateObjBuffer(dtObject,'ROOT');
try
bodyNode := CreateObjBuffer(dtObject,'Body',root);
faultNode := CreateObjBuffer(dtObject,'Fault',bodyNode);
CreateObjBuffer(dtString,'faultCode',faultNode)^.StrData^.Data := VAL_CODE;
CreateObjBuffer(dtString,'faultString',faultNode)^.StrData^.Data := VAL_MSG;
f := CreateFormatterClient();
strm := TMemoryStream.Create();
try
locStore := CreateBinaryWriter(strm);
SaveObjectToStream(root,locStore);
locStore := nil;
strm.Position := 0;
f.LoadFromStream(strm);
try
f.BeginCallRead(nil);
Check(False,'BeginCallRead() should raise an exception.');
except
on e : EBinaryException do begin
excpt_code := e.FaultCode;
excpt_msg := e.FaultString;
end;
end;
CheckEquals(VAL_CODE,excpt_code,'faultCode');
CheckEquals(VAL_MSG,excpt_msg,'faultString');
finally
FreeAndNil(strm);
end;
finally
ClearObj(root);
end;
end;
initialization
RegisterStdTypes();
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1');
@ -3766,6 +3902,8 @@ initialization
{$IFDEF WST_RECORD_RTTI}
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestRecord_TYPEINFO_FUNC__()),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestRecord)].GetExternalPropertyName('__FIELDS__')));
{$ENDIF WST_RECORD_RTTI}
RegisterAttributeProperty(TypeInfo(TTestSmallRecord),'fieldWord');
RegisterAttributeProperty(TypeInfo(TTestRecord),'fieldWord');
{$IFDEF FPC}
RegisterTest(TTestArray);
@ -3782,6 +3920,7 @@ initialization
RegisterTest(TTestXmlRpcFormatter);
RegisterTest(TTest_SoapFormatterExceptionBlock);
RegisterTest(TTest_XmlRpcFormatterExceptionBlock);
RegisterTest(TTest_BinaryFormatterExceptionBlock);
{$ELSE}
RegisterTest(TTestArray.Suite);
RegisterTest(TTestSOAPFormatter.Suite);
@ -3797,6 +3936,7 @@ initialization
RegisterTest(TTestXmlRpcFormatter.Suite);
RegisterTest(TTest_SoapFormatterExceptionBlock.Suite);
RegisterTest(TTest_XmlRpcFormatterExceptionBlock.Suite);
RegisterTest(TTest_BinaryFormatterExceptionBlock.Suite);
{$ENDIF}

352
wst/trunk/tests/test_suite/wst_test_suite.lpi
View File

@ -27,7 +27,7 @@
<PackageName Value="FPCUnitTestRunner"/>
</Item1>
</RequiredPackages>
<Units Count="74">
<Units Count="75">
<Unit0>
<Filename Value="wst_test_suite.lpr"/>
<IsPartOfProject Value="True"/>
@ -40,12 +40,12 @@
<Filename Value="testformatter_unit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="testformatter_unit"/>
<CursorPos X="3" Y="901"/>
<TopLine Value="890"/>
<EditorIndex Value="11"/>
<CursorPos X="27" Y="3935"/>
<TopLine Value="3914"/>
<EditorIndex Value="5"/>
<UsageCount Value="200"/>
<Bookmarks Count="1">
<Item0 X="17" Y="1046" ID="3"/>
<Item0 X="17" Y="1058" ID="3"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit1>
@ -55,27 +55,23 @@
<UnitName Value="server_service_soap"/>
<CursorPos X="8" Y="182"/>
<TopLine Value="161"/>
<EditorIndex Value="7"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="31" Y="148"/>
<TopLine Value="148"/>
<EditorIndex Value="8"/>
<CursorPos X="33" Y="31"/>
<TopLine Value="22"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="..\..\base_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_binary_formatter"/>
<CursorPos X="31" Y="19"/>
<TopLine Value="13"/>
<EditorIndex Value="14"/>
<CursorPos X="28" Y="223"/>
<TopLine Value="211"/>
<EditorIndex Value="8"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit4>
@ -83,8 +79,8 @@
<Filename Value="..\..\base_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="19" Y="10"/>
<TopLine Value="10"/>
<CursorPos X="26" Y="1232"/>
<TopLine Value="1220"/>
<EditorIndex Value="0"/>
<UsageCount Value="200"/>
<Bookmarks Count="2">
@ -97,42 +93,36 @@
<Filename Value="..\..\base_soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="3" Y="1127"/>
<TopLine Value="1116"/>
<EditorIndex Value="4"/>
<CursorPos X="29" Y="225"/>
<TopLine Value="209"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="..\..\binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_formatter"/>
<CursorPos X="12" Y="108"/>
<TopLine Value="103"/>
<EditorIndex Value="15"/>
<CursorPos X="28" Y="112"/>
<TopLine Value="48"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\binary_streamer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_streamer"/>
<CursorPos X="1" Y="14"/>
<CursorPos X="95" Y="90"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="200"/>
<Bookmarks Count="1">
<Item0 X="38" Y="490" ID="2"/>
<Item0 X="38" Y="487" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="..\..\server_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_binary_formatter"/>
<CursorPos X="22" Y="21"/>
<TopLine Value="1"/>
<EditorIndex Value="9"/>
<CursorPos X="9" Y="123"/>
<TopLine Value="27"/>
<EditorIndex Value="4"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
</Unit9>
@ -175,9 +165,9 @@
<Filename Value="..\..\metadata_wsdl.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_wsdl"/>
<CursorPos X="1" Y="22"/>
<TopLine Value="1"/>
<EditorIndex Value="16"/>
<CursorPos X="43" Y="869"/>
<TopLine Value="834"/>
<EditorIndex Value="9"/>
<UsageCount Value="206"/>
<Loaded Value="True"/>
</Unit14>
@ -186,63 +176,63 @@
<UnitName Value="DOM"/>
<CursorPos X="15" Y="429"/>
<TopLine Value="413"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit15>
<Unit16>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="13" Y="235"/>
<TopLine Value="215"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit16>
<Unit17>
<Filename Value="..\..\server_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_intf"/>
<CursorPos X="25" Y="14"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<TopLine Value="97"/>
<EditorIndex Value="3"/>
<UsageCount Value="203"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="15" Y="15"/>
<TopLine Value="1"/>
<EditorIndex Value="13"/>
<UsageCount Value="16"/>
<CursorPos X="15" Y="22"/>
<TopLine Value="10"/>
<EditorIndex Value="6"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit18>
<Unit19>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="3" Y="316"/>
<TopLine Value="304"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit19>
<Unit20>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\objpas\classes\lists.inc"/>
<CursorPos X="3" Y="407"/>
<TopLine Value="404"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit20>
<Unit21>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\fcl\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="3" Y="474"/>
<TopLine Value="471"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit21>
<Unit22>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
<CursorPos X="27" Y="121"/>
<TopLine Value="104"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit22>
<Unit23>
<Filename Value="D:\lazarusClean\fpc\2.0.4\source\rtl\inc\objpas.inc"/>
<CursorPos X="9" Y="166"/>
<TopLine Value="142"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit23>
<Unit24>
<Filename Value="D:\Lazarus\components\fpcunit\guitestrunner.pas"/>
@ -251,22 +241,22 @@
<UnitName Value="GuiTestRunner"/>
<CursorPos X="34" Y="32"/>
<TopLine Value="25"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit24>
<Unit25>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\fcl\fpcunit\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="21" Y="94"/>
<TopLine Value="83"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit25>
<Unit26>
<Filename Value="..\..\imp_utils.pas"/>
<UnitName Value="imp_utils"/>
<CursorPos X="15" Y="50"/>
<TopLine Value="8"/>
<EditorIndex Value="3"/>
<UsageCount Value="10"/>
<CursorPos X="12" Y="47"/>
<TopLine Value="182"/>
<EditorIndex Value="7"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit26>
<Unit27>
@ -274,7 +264,7 @@
<UnitName Value="XMLRead"/>
<CursorPos X="43" Y="13"/>
<TopLine Value="1"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit27>
<Unit28>
<Filename Value="test_parserdef.pas"/>
@ -282,168 +272,166 @@
<UnitName Value="test_parserdef"/>
<CursorPos X="93" Y="76"/>
<TopLine Value="11"/>
<UsageCount Value="198"/>
<UsageCount Value="200"/>
</Unit28>
<Unit29>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\objpash.inc"/>
<CursorPos X="8" Y="190"/>
<TopLine Value="133"/>
<UsageCount Value="4"/>
<UsageCount Value="3"/>
</Unit29>
<Unit30>
<Filename Value="..\..\wst.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit30>
<Unit31>
<Filename Value="..\..\..\..\..\lazarusClean\fpc\2.0.4\source\rtl\inc\heaph.inc"/>
<CursorPos X="43" Y="100"/>
<TopLine Value="83"/>
<UsageCount Value="2"/>
<UsageCount Value="1"/>
</Unit31>
<Unit32>
<Filename Value="..\test_fpc\interface_problem\interface_problem.pas"/>
<UnitName Value="interface_problem"/>
<CursorPos X="1" Y="10"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit32>
<Unit33>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_xmlrpc_formatter"/>
<CursorPos X="32" Y="64"/>
<TopLine Value="49"/>
<EditorIndex Value="5"/>
<UsageCount Value="136"/>
<Loaded Value="True"/>
<CursorPos X="35" Y="355"/>
<TopLine Value="330"/>
<UsageCount Value="151"/>
</Unit33>
<Unit34>
<Filename Value="..\..\ws_helper\pscanner.pp"/>
<UnitName Value="PScanner"/>
<CursorPos X="19" Y="505"/>
<TopLine Value="491"/>
<UsageCount Value="17"/>
<UsageCount Value="16"/>
</Unit34>
<Unit35>
<Filename Value="..\..\ws_helper\pascal_parser_intf.pas"/>
<UnitName Value="pascal_parser_intf"/>
<CursorPos X="62" Y="296"/>
<TopLine Value="296"/>
<UsageCount Value="27"/>
<UsageCount Value="26"/>
</Unit35>
<Unit36>
<Filename Value="..\..\ws_helper\pastree.pp"/>
<UnitName Value="PasTree"/>
<CursorPos X="18" Y="254"/>
<TopLine Value="243"/>
<UsageCount Value="17"/>
<UsageCount Value="16"/>
</Unit36>
<Unit37>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\packages\fcl-xml\src\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="38" Y="225"/>
<TopLine Value="203"/>
<UsageCount Value="16"/>
<UsageCount Value="15"/>
</Unit37>
<Unit38>
<Filename Value="..\..\wst_rtti_filter\cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="3" Y="75"/>
<TopLine Value="70"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit38>
<Unit39>
<Filename Value="..\..\wst_rtti_filter\dom_cursors.pas"/>
<UnitName Value="dom_cursors"/>
<CursorPos X="3" Y="182"/>
<TopLine Value="180"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit39>
<Unit40>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\packages\fcl-fpcunit\src\fpcunit.pp"/>
<UnitName Value="fpcunit"/>
<CursorPos X="1" Y="446"/>
<TopLine Value="434"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit40>
<Unit41>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\i386\i386.inc"/>
<CursorPos X="1" Y="1284"/>
<TopLine Value="1268"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit41>
<Unit42>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\classes\streams.inc"/>
<CursorPos X="1" Y="107"/>
<TopLine Value="95"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit42>
<Unit43>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="3" Y="30"/>
<TopLine Value="23"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit43>
<Unit44>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\packages\fcl-xml\src\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="14" Y="351"/>
<TopLine Value="336"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit44>
<Unit45>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\win32\system.pp"/>
<UnitName Value="System"/>
<CursorPos X="22" Y="33"/>
<TopLine Value="18"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit45>
<Unit46>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\packages\fcl-base\src\inc\contnrs.pp"/>
<UnitName Value="contnrs"/>
<CursorPos X="3" Y="964"/>
<TopLine Value="962"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit46>
<Unit47>
<Filename Value="..\..\wst_delphi.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit47>
<Unit48>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\strutils.pp"/>
<UnitName Value="strutils"/>
<CursorPos X="10" Y="29"/>
<TopLine Value="14"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit48>
<Unit49>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\inc\objpash.inc"/>
<CursorPos X="20" Y="168"/>
<TopLine Value="166"/>
<UsageCount Value="5"/>
<CursorPos X="26" Y="173"/>
<TopLine Value="156"/>
<UsageCount Value="9"/>
</Unit49>
<Unit50>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\inc\objpas.inc"/>
<CursorPos X="11" Y="442"/>
<TopLine Value="556"/>
<UsageCount Value="5"/>
<CursorPos X="11" Y="333"/>
<TopLine Value="375"/>
<UsageCount Value="9"/>
</Unit50>
<Unit51>
<Filename Value="..\..\wst_fpc_xml.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wst_fpc_xml"/>
<CursorPos X="3" Y="53"/>
<TopLine Value="51"/>
<UsageCount Value="82"/>
<CursorPos X="65" Y="85"/>
<TopLine Value="56"/>
<UsageCount Value="97"/>
</Unit51>
<Unit52>
<Filename Value="..\..\wst_global.inc"/>
<CursorPos X="20" Y="11"/>
<CursorPos X="3" Y="4"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit52>
@ -452,16 +440,16 @@
<UnitName Value="CustApp"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit53>
<Unit54>
<Filename Value="test_utilities.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_utilities"/>
<CursorPos X="71" Y="3"/>
<TopLine Value="3"/>
<EditorIndex Value="17"/>
<UsageCount Value="73"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="10"/>
<UsageCount Value="88"/>
<Loaded Value="True"/>
</Unit54>
<Unit55>
@ -469,60 +457,60 @@
<UnitName Value="fpcunit"/>
<CursorPos X="66" Y="231"/>
<TopLine Value="231"/>
<UsageCount Value="13"/>
<UsageCount Value="12"/>
</Unit55>
<Unit56>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\packages\fcl-fpcunit\src\testregistry.pp"/>
<UnitName Value="testregistry"/>
<CursorPos X="11" Y="32"/>
<TopLine Value="17"/>
<UsageCount Value="15"/>
<UsageCount Value="14"/>
</Unit56>
<Unit57>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\packages\fcl-fpcunit\src\testdecorator.pp"/>
<UnitName Value="testdecorator"/>
<CursorPos X="3" Y="30"/>
<TopLine Value="1"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit57>
<Unit58>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\packages\fcl-fpcunit\src\DUnitCompatibleInterface.inc"/>
<CursorPos X="21" Y="9"/>
<TopLine Value="1"/>
<UsageCount Value="12"/>
<UsageCount Value="11"/>
</Unit58>
<Unit59>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="79" Y="218"/>
<TopLine Value="203"/>
<UsageCount Value="10"/>
<CursorPos X="53" Y="41"/>
<TopLine Value="37"/>
<UsageCount Value="9"/>
</Unit59>
<Unit60>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="89" Y="122"/>
<TopLine Value="106"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit60>
<Unit61>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\sysutils\sysinth.inc"/>
<CursorPos X="24" Y="63"/>
<TopLine Value="46"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit61>
<Unit62>
<Filename Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<UnitName Value="wsdl2pas_imp"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="31"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit62>
<Unit63>
<Filename Value="..\..\..\..\..\..\lazarus2204\fpc\2.0.4\source\fcl\xml\dom.pp"/>
<UnitName Value="DOM"/>
<CursorPos X="3" Y="196"/>
<TopLine Value="191"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit63>
<Unit64>
<Filename Value="..\..\type_lib_edtr\umoduleedit.pas"/>
@ -532,7 +520,7 @@
<UnitName Value="umoduleedit"/>
<CursorPos X="47" Y="21"/>
<TopLine Value="18"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit64>
<Unit65>
<Filename Value="..\..\type_lib_edtr\ubindingedit.pas"/>
@ -542,7 +530,7 @@
<UnitName Value="ubindingedit"/>
<CursorPos X="41" Y="21"/>
<TopLine Value="18"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit65>
<Unit66>
<Filename Value="..\..\type_lib_edtr\ufarrayedit.pas"/>
@ -552,7 +540,7 @@
<UnitName Value="ufarrayedit"/>
<CursorPos X="41" Y="9"/>
<TopLine Value="5"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit66>
<Unit67>
<Filename Value="..\..\type_lib_edtr\uftypealiasedit.pas"/>
@ -562,7 +550,7 @@
<UnitName Value="uftypealiasedit"/>
<CursorPos X="22" Y="9"/>
<TopLine Value="7"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit67>
<Unit68>
<Filename Value="..\..\type_lib_edtr\ufrmsaveoption.pas"/>
@ -572,22 +560,22 @@
<UnitName Value="ufrmsaveoption"/>
<CursorPos X="22" Y="9"/>
<TopLine Value="6"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit68>
<Unit69>
<Filename Value="..\..\..\..\..\..\lazarus_23_215XX\fpc\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="4" Y="64"/>
<TopLine Value="64"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit69>
<Unit70>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_xmlrpc"/>
<CursorPos X="14" Y="144"/>
<TopLine Value="136"/>
<EditorIndex Value="10"/>
<UsageCount Value="27"/>
<CursorPos X="10" Y="131"/>
<TopLine Value="116"/>
<EditorIndex Value="1"/>
<UsageCount Value="42"/>
<Loaded Value="True"/>
</Unit70>
<Unit71>
@ -595,52 +583,152 @@
<UnitName Value="XMLRead"/>
<CursorPos X="6" Y="37"/>
<TopLine Value="31"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit71>
<Unit72>
<Filename Value="..\..\xmlrpc_formatter.pas"/>
<UnitName Value="xmlrpc_formatter"/>
<CursorPos X="31" Y="131"/>
<TopLine Value="116"/>
<EditorIndex Value="12"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
<UsageCount Value="11"/>
</Unit72>
<Unit73>
<Filename Value="..\..\record_rtti.pas"/>
<UnitName Value="record_rtti"/>
<CursorPos X="3" Y="248"/>
<TopLine Value="13"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="265"/>
<EditorIndex Value="2"/>
<UsageCount Value="10"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit73>
<Unit74>
<Filename Value="..\..\wst_rtl_imp.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit74>
</Units>
<JumpHistory Count="6" HistoryIndex="5">
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1211" Column="10" TopLine="1211"/>
<Caret Line="4784" Column="33" TopLine="4769"/>
</Position1>
<Position2>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Caret Line="1356" Column="38" TopLine="1346"/>
</Position2>
<Position3>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="4614" Column="1" TopLine="4572"/>
<Caret Line="1403" Column="82" TopLine="1388"/>
</Position3>
<Position4>
<Filename Value="..\..\server_binary_formatter.pas"/>
<Caret Line="121" Column="11" TopLine="111"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1422" Column="82" TopLine="1406"/>
</Position4>
<Position5>
<Filename Value="..\..\server_binary_formatter.pas"/>
<Caret Line="21" Column="22" TopLine="1"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1816" Column="31" TopLine="1795"/>
</Position5>
<Position6>
<Filename Value="..\..\base_binary_formatter.pas"/>
<Caret Line="19" Column="31" TopLine="13"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3848" Column="31" TopLine="3827"/>
</Position6>
<Position7>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="4784" Column="55" TopLine="4778"/>
</Position7>
<Position8>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position8>
<Position9>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1191" Column="17" TopLine="1176"/>
</Position9>
<Position10>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1231" Column="32" TopLine="1216"/>
</Position10>
<Position11>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1228" Column="13" TopLine="1213"/>
</Position11>
<Position12>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position12>
<Position13>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1191" Column="32" TopLine="1176"/>
</Position13>
<Position14>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1235" Column="84" TopLine="1220"/>
</Position14>
<Position15>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1403" Column="82" TopLine="1388"/>
</Position15>
<Position16>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1421" Column="82" TopLine="1406"/>
</Position16>
<Position17>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1816" Column="31" TopLine="1789"/>
</Position17>
<Position18>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="3848" Column="31" TopLine="3827"/>
</Position18>
<Position19>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="4786" Column="25" TopLine="4777"/>
</Position19>
<Position20>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1359" Column="50" TopLine="1337"/>
</Position20>
<Position21>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="4783" Column="27" TopLine="4761"/>
</Position21>
<Position22>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1359" Column="47" TopLine="1337"/>
</Position22>
<Position23>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="4740" Column="9" TopLine="4668"/>
</Position23>
<Position24>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="4808" Column="35" TopLine="4794"/>
</Position24>
<Position25>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="180" Column="15" TopLine="177"/>
</Position25>
<Position26>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<Caret Line="144" Column="14" TopLine="130"/>
</Position26>
<Position27>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="3890" Column="49" TopLine="3890"/>
</Position27>
<Position28>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="1483" Column="30" TopLine="1465"/>
</Position28>
<Position29>
<Filename Value="testformatter_unit.pas"/>
<Caret Line="3538" Column="39" TopLine="3538"/>
</Position29>
<Position30>
<Filename Value="..\..\record_rtti.pas"/>
<Caret Line="265" Column="32" TopLine="232"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>

1
wst/trunk/wst_global.inc
View File

@ -7,6 +7,7 @@
{$UNDEF USE_INLINE}
{$DEFINE WST_RECORD_RTTI}
{$ENDIF}
{$IFDEF CPU86}
{$DEFINE HAS_COMP}
{$ENDIF}