Fix AnsiString bug, and allow for more interfaces

git-svn-id: svn://svn.code.sf.net/p/indysoap/code-0/trunk@17 75be9796-0ac5-4f83-a77f-cba69ea37c88
ashumkin · Aug 13, 2013 · 16919e0 · 16919e0
1 parent 955b65f
commit 16919e0
Show file tree

Hide file tree

Showing 41 changed files with 1,015 additions and 576 deletions.
diff --git a/source/IdSoapExecutableMemory.pas b/source/IdSoapExecutableMemory.pas
@@ -24,7 +24,7 @@
   IdSoapDebug, IdSoapClasses;
 
 Type
-  TIdSoapExecutableMemoryPoolItemSize = (s32, s64, s128, s1024, s16k);
+  TIdSoapExecutableMemoryPoolItemSize = (s32, s64, s128, s1024, s16k, s64k);
 
   TIdSoapExecutableMemoryPoolItem = class (TIdBaseObject)
   Private
@@ -65,7 +65,7 @@   TIdSoapExecutableMemoryPoolManager = class (TIdBaseObject)
   End;
 
 Const
-  ITEM_SIZE : array [TIdSoapExecutableMemoryPoolItemSize] of Integer = (32, 64, 128, 1024, 16384);
+  ITEM_SIZE : array [TIdSoapExecutableMemoryPoolItemSize] of Integer = (32, 64, 128, 1024, 16384, 65535);
 
 
 Implementation
@@ -169,6 +169,7 @@ function TIdSoapExecutableMemoryPool.Acquire(iSize: Integer; var iId: Integer):
     65..128 : aSize := s128;
     129..1024 : aSize := s1024;
     1025..16384 : aSize := s16k;
+    16385..65535 : aSize := s64k;
   Else
    // aSize := s32;
     raise Exception('Unable to allocate executable memory of size '+inttostr(iSize));

diff --git a/source/IdSoapITIBuilder.pas b/source/IdSoapITIBuilder.pas
@@ -106,7 +106,11 @@ procedure SaveITIToResources(AResInfo: String; AITI: TIdSoapITI);
   LITIBinStreamer: TIdSoapITIBinStreamer;
   LResourceName: String;
   LResourceFile: String;
+  {$IFDEF UNICODE}
+  p : pointer;
+  {$ELSE}
   LResType : String;
+  {$ENDIF}
 begin
   IdRequire(Assigned(AITI) and (AITI is TIdSoapITI) , 'IdSoapITIBuilder.SaveITIToResources: .IdSoapCfg AITI is nil');
   if AResInfo = '' then
@@ -133,8 +137,13 @@ procedure SaveITIToResources(AResInfo: String; AITI: TIdSoapITI);
       LResourceCreator.Add(LResourceEntry);
       LResourceEntry.Size := LResourceStream.Size;
       move(LResourceStream.Memory^,LResourceEntry.Data^,LResourceEntry.Size);
+      {$IFDEF UNICODE}
+      cardinal(p) := 10;
+      LResourceEntry.ResType := p;
+      {$ELSE}
       LResType := #10;
       LResourceEntry.ResType := pchar(LResType);
+      {$ENDIF}
       LResourceEntry.Name := LResourceName;
       LResourceCreator.SaveToFile(LResourceFile);
     finally

diff --git a/source/IdSoapResourceFile.pas b/source/IdSoapResourceFile.pas
@@ -271,42 +271,49 @@ procedure SaveIdent(AStream: TFileStream; AData: PChar);
   LWideChar: WideChar;
   LWideString: WideString;
 begin
-  Assert(AData <> '','You must have a non empty string for a TYPE or resource NAME');
   if (Cardinal(AData) and $ffff0000) = 0 then
     begin
     LWord := $ffff;
     AStream.WriteBuffer(LWord,sizeof(LWord));
     LWord := Cardinal(AData) and $ffff;
     AStream.WriteBuffer(LWord,sizeof(LWord));
     end
-  else if copy(AData,1,1) = '#' then  // its a number
-    begin
-    val(copy(AData,2,MaxInt),LCardinal,LErr);
-    if LErr <> 0 then
-      begin
-      raise Exception.Create('Invalid number for resource name "' + AData + '"');
-      end;
-    if LCardinal > $ffff then
-      begin
-      raise Exception.Create('Invalid WORD size "' + AData + '"');
-      end;
-    LWord := $ffff;
-    AStream.WriteBuffer(LWord,sizeof(LWord));
-    AStream.WriteBuffer(LCardinal,sizeof(Word));  // only write a word size here
-    end
   else
-    begin
-    LWideString := '';
-    repeat
-      LWideChar := WideChar(ord(AData^));
-      if LWideChar <> #0 then
+  begin
+    Assert(AData <> '','You must have a non empty string for a TYPE or resource NAME');
+    if copy(AData,1,1) = '#' then  // its a number
+      begin
+      val(copy(AData,2,MaxInt),LCardinal,LErr);
+      if LErr <> 0 then
         begin
-        LWideString := LWideString + LWideChar;
+        raise Exception.Create('Invalid number for resource name "' + AData + '"');
         end;
-      inc(AData);
-      until LWideChar = #0;
-    AStream.WriteBuffer(LWideString[1],(length(LWideString)+1) * Sizeof(WideChar));
-    end;
+      if LCardinal > $ffff then
+        begin
+        raise Exception.Create('Invalid WORD size "' + AData + '"');
+        end;
+      LWord := $ffff;
+      AStream.WriteBuffer(LWord,sizeof(LWord));
+      AStream.WriteBuffer(LCardinal,sizeof(Word));  // only write a word size here
+      end
+    else
+      begin
+      {$IFDEF UNICODE}
+      LWideString := AData;
+      {$ELSE}
+      LWideString := '';
+      repeat
+        LWideChar := WideChar(ord(AData^));
+        if LWideChar <> #0 then
+          begin
+          LWideString := LWideString + LWideChar;
+          end;
+        inc(AData);
+        until LWideChar = #0;
+      {$ENDIF}
+      AStream.WriteBuffer(LWideString[1],(length(LWideString)+1) * Sizeof(WideChar));
+      end;
+  end;
 end;
 
 procedure TIdSoapResourceFile.LoadFromFile(AFilename: String);

diff --git a/source/IdSoapRpcBin.pas b/source/IdSoapRpcBin.pas
@@ -76,6 +76,7 @@   TIdSoapReaderBin = class(TIdSoapReader)
     function GetParamSingle(ANode: TIdSoapNode; const AName: String): Single; Override;
     function GetParamSmallInt(ANode: TIdSoapNode; const AName: String): SmallInt; Override;
     function GetParamString(ANode: TIdSoapNode; const AName: String): String; Override;
+    function GetParamAnsiString(ANode: TIdSoapNode; const AName: String): AnsiString; Override;
     function GetParamWideChar(ANode: TIdSoapNode; const AName: String): WideChar; Override;
     function GetParamWideString(ANode: TIdSoapNode; const AName: String): WideString; Override;
     function GetParamWord(ANode: TIdSoapNode; const AName: String): Word; Override;
@@ -863,6 +864,36 @@ function TIdSoapReaderBin.GetParamString(ANode: TIdSoapNode; const AName: String
     end;
 end;
 
+function TIdSoapReaderBin.GetParamAnsiString(ANode: TIdSoapNode; const AName: String): AnsiString;
+const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapReaderBin.GetParamAnsiString';
+var
+  LType : Byte;
+  tmp : String;
+begin
+  Assert(self.TestValid(TIdSoapReaderBin), ASSERT_LOCATION+': Self is not valid');
+  // GetParamPosition will check other parameters
+  if GetParamExists(ANode, AName) then
+    begin
+    FStream.Position := GetParamPosition(ANode, AName);
+    LType := StreamReadByte(FStream);
+    Assert(LType = ID_SOAP_BIN_TYPE_STRING, ASSERT_LOCATION+': Value is actually '+DescribeParamType(LType));
+    SetLength(tmp, StreamReadCardinal(FStream));
+    if length(tmp) > 0 then
+      begin
+      StreamReadBinary(FStream, @result[1], Length(result) {$IFDEF UNICODE}*2{$ENDIF});
+      if seoUseCrLf in EncodingOptions then
+        begin
+        result := IdSoapAdjustLineBreaks(result, tislbsCRLF);
+        end;
+      end;
+    result := tmp;
+    end
+  else
+    begin
+    result := '';
+    end;
+end;
+
 function TIdSoapReaderBin.GetGeneralParam(ANode: TIdSoapNode; const AName: string; var VNil: boolean; var VValue, VTypeNS, VType: string): boolean;
 const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapReaderBin.GetParamBinary';
 var

diff --git a/source/IdSoapRpcPacket.pas b/source/IdSoapRpcPacket.pas
@@ -184,6 +184,7 @@   TIdSoapNode = class(TIdBaseObject)
     function GetParamSingle(const AName: String): Single;
     function GetParamSmallInt(const AName: String): SmallInt;
     function GetParamString(const AName: String): String;
+    function GetParamAnsiString(const AName: String): AnsiString;
     function GetParamWideChar(const AName: String): WideChar;
     function GetParamWideString(const AName: String): WideString;
     function GetParamWord(const AName: String): Word;
@@ -210,6 +211,7 @@   TIdSoapNode = class(TIdBaseObject)
     procedure SetParamString(const AName, AValue: String);
     procedure SetParamWideChar(const AName: String; const AValue: WideChar);
     procedure SetParamWideString(const AName: String; const AValue: WideString);
+    procedure SetParamAnsiString(const AName: String; const AValue: AnsiString);
     procedure SetParamWord(const AName: String; const AValue: Word);
     procedure SetParamEnumeration(const AName: String; ATypeInfo: PTypeInfo; ATypeName, ANamespace : string; AItiLink : TIdSoapITIBaseObject; const AValue: Integer);
     procedure SetParamRef(const AName, AType, ATypeNS, AValue: String);
@@ -270,6 +272,7 @@   TIdSoapNode = class(TIdBaseObject)
     property ParamSingle[const AName: String]: Single Read GetParamSingle write SetParamSingle;
     property ParamSmallInt[const AName: String]: SmallInt Read GetParamSmallInt write SetParamSmallInt;
     property ParamString[const AName: String]: String Read GetParamString write SetParamString;
+    property ParamAnsiString[const AName: String]: AnsiString Read GetParamAnsiString write SetParamAnsiString;
     property ParamWideChar[const AName: String]: WideChar Read GetParamWideChar write SetParamWideChar;
     property ParamWideString[const AName: String]: WideString Read GetParamWideString write SetParamWideString;
     property ParamWord[const AName: String]: Word Read GetParamWord write SetParamWord;
@@ -475,6 +478,7 @@   TIdSoapReader = class(TIdBaseSoapPacket)
     function GetParamSingle(ANode: TIdSoapNode; const AName: String): Single; Virtual; Abstract;
     function GetParamSmallInt(ANode: TIdSoapNode; const AName: String): SmallInt; Virtual; Abstract;
     function GetParamString(ANode: TIdSoapNode; const AName: String): String; Virtual; Abstract;
+    function GetParamAnsiString(ANode: TIdSoapNode; const AName: String): AnsiString; Virtual; Abstract;
     function GetParamWideChar(ANode: TIdSoapNode; const AName: String): WideChar; Virtual; Abstract;
     function GetParamWideString(ANode: TIdSoapNode; const AName: String): WideString; Virtual; Abstract;
     function GetParamWord(ANode: TIdSoapNode; const AName: String): Word; Virtual; Abstract;
@@ -529,6 +533,7 @@   TIdSoapReader = class(TIdBaseSoapPacket)
     property ParamSingle[ANode: TIdSoapNode; const AName: String]: Single Read GetParamSingle;
     property ParamSmallInt[ANode: TIdSoapNode; const AName: String]: SmallInt Read GetParamSmallInt;
     property ParamString[ANode: TIdSoapNode; const AName: String]: String Read GetParamString;
+    property ParamAnsiString[ANode: TIdSoapNode; const AName: String]: AnsiString Read GetParamAnsiString;
     property ParamWideChar[ANode: TIdSoapNode; const AName: String]: WideChar Read GetParamWideChar;
     property ParamWideString[ANode: TIdSoapNode; const AName: String]: WideString Read GetParamWideString;
     property ParamWord[ANode: TIdSoapNode; const AName: String]: Word Read GetParamWord;
@@ -1014,6 +1019,21 @@ function TIdSoapNode.GetParamString(const AName: String): String;
     end;
 end;
 
+function TIdSoapNode.GetParamAnsiString(const AName: String): AnsiString;
+const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapNode.GetParamString';
+begin
+  Assert(Self.TestValid(TIdSoapNode), ASSERT_LOCATION+': self is not valid');
+  Assert(AName <> '', ASSERT_LOCATION+': Name is blank');
+  if (FOwner is TIdSoapReader) then
+    begin
+    result := (FOwner as TIdSoapReader).ParamAnsiString[Self, AName];
+    end
+  else
+    begin
+    raise EIdSoapRequirementFail.create(ASSERT_LOCATION+': Attempt to get a parameter for unsuitable packet type '+FOwner.ClassName);
+    end;
+end;
+
 function TIdSoapNode.GetParamWideChar(const AName: String): WideChar;
 const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapNode.GetParamWideChar';
 begin
@@ -1374,6 +1394,21 @@ procedure TIdSoapNode.SetParamWideString(const AName: String; const AValue: Wide
     end;
 end;
 
+procedure TIdSoapNode.SetParamAnsiString(const AName: String; const AValue: AnsiString);
+const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapNode.SetParamWideString';
+begin
+  Assert(Self.TestValid(TIdSoapNode), ASSERT_LOCATION+': self is not valid');
+  Assert(AName <> '', ASSERT_LOCATION+': Name is blank');
+  if (FOwner is TIdSoapWriter) then
+    begin
+    (FOwner as TIdSoapWriter).DefineParamAnsiString(Self, AName, AValue);
+    end
+  else
+    begin
+    raise EIdSoapRequirementFail.create(ASSERT_LOCATION+': Attempt to set a parameter for unsuitable packet type '+FOwner.ClassName);
+    end;
+end;
+
 procedure TIdSoapNode.SetParamWord(const AName: String; const AValue: Word);
 const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapNode.SetParamWord';
 begin

diff --git a/source/IdSoapRpcXml.pas b/source/IdSoapRpcXml.pas
@@ -86,6 +86,7 @@   TIdSoapReaderXML = class(TIdSoapReader)
     function GetParamSingle(ANode: TIdSoapNode; const AName: String): Single; Override;
     function GetParamSmallInt(ANode: TIdSoapNode; const AName: String): SmallInt; Override;
     function GetParamString(ANode: TIdSoapNode; const AName: String): String; Override;
+    function GetParamAnsiString(ANode: TIdSoapNode; const AName: String): AnsiString; Override;
     function GetParamWideChar(ANode: TIdSoapNode; const AName: String): WideChar; Override;
     function GetParamWideString(ANode: TIdSoapNode; const AName: String): WideString; Override;
     function GetParamWord(ANode: TIdSoapNode; const AName: String): Word; Override;
@@ -1791,6 +1792,33 @@ function TIdSoapReaderXML.GetParamString(ANode: TIdSoapNode; const AName: String
     end;
 end;
 
+function TIdSoapReaderXML.GetParamAnsiString(ANode: TIdSoapNode; const AName: String): AnsiString;
+const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapReaderXML.GetParamAnsiString';
+Var
+  LParam : TIdReaderParameter;
+begin
+  assert(self.TestValid(TIdSoapReaderXML), ASSERT_LOCATION+': self is not valid');
+  if ANode = nil then
+    begin
+    ANode := BaseNode;
+    end;
+  // GetParameter will check other parameters
+  LParam := GetParameter(ANode, AName);
+  if assigned(LParam) and (not LParam.FIsNil) then
+    begin
+    EnforceType(AName, LParam, [ID_SOAP_NS_SCHEMA_2001], [ID_SOAP_XSI_TYPE_STRING], ASSERT_LOCATION);
+    result := LParam.FValue;
+    if seoUseCrLf in EncodingOptions then
+      begin
+      result := IdSoapAdjustLineBreaks(Result, tislbsCRLF);
+      end;
+    end
+  else
+    begin
+    result := '';
+    end;
+end;
+
 function TIdSoapReaderXML.GetParamInteger(ANode: TIdSoapNode; const AName: String): Integer;
 const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapReaderXML.GetParamInteger';
 Var

diff --git a/source/IdSoapServer.pas b/source/IdSoapServer.pas
@@ -140,6 +140,7 @@   TIdSoapListener = class(TIdSoapITIProvider)
     function  ProcessParamClass(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData; AParamType: PTypeInfo): Integer;
     function  ProcessParamShortString(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
     function  ProcessParamLongString(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
+    function  ProcessParamAnsiString(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
     function  ProcessParamWideString(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
     function  ProcessParamChar(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
     function  ProcessParamWideChar(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
@@ -673,7 +674,7 @@ function TIdSoapListener.ProcessParameter(ABaseNode: TIdSoapNode; AParamName : s
     tkDynArray:     result := ProcessParamDynArray(LParamName, LBasicType,AServerContext,AParam,AParamIndex,AReader,AAsm,ABaseNode,AData,LParamType);
     tkClass:        result := ProcessParamClass(LParamName, AServerContext,AParam,AParamIndex,AReader,AAsm,ABaseNode,AData,LParamType);
     tkString:       result := ProcessParamShortString(LParamName, AServerContext,AParam,AParamIndex,AReader,AAsm,ABaseNode,AData);
-    tkLString:      result := ProcessParamLongString(LParamName, AServerContext,AParam,AParamIndex,AReader,AAsm,ABaseNode,AData);
+    tkLString:      result := ProcessParamAnsiString(LParamName, AServerContext,AParam,AParamIndex,AReader,AAsm,ABaseNode,AData);
     {$IFDEF UNICODE}
     tkUString:      result := ProcessParamLongString(LParamName, AServerContext,AParam,AParamIndex,AReader,AAsm,ABaseNode,AData);
     {$ENDIF}
@@ -1582,6 +1583,59 @@ function TIdSoapListener.ProcessParamLongString(AParamName : string; AServerCont
     end;
 end;
 
+function TIdSoapListener.ProcessParamAnsiString(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
+const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapListener.ProcessParamLongString';
+var
+  LPString: PAnsiString;
+begin
+  Assert(self.TestValid(TIdSoapListener), ASSERT_LOCATION+': self not valid');
+  Assert(AParamName <> '', ASSERT_LOCATION+': No parameter names defined');
+  Assert(AServerContext.TestValid(TIdSoapServerRequestContext),ASSERT_LOCATION+': AServerContext is invalid');
+  Assert(AParam.TestValid(TIdSoapITIParameter),ASSERT_LOCATION+': AParam is invalid');
+  Assert(AParamIndex >= -1,ASSERT_LOCATION+': AParamIndex is invalid');
+  Assert(AReader.TestValid(TIdSoapReader),ASSERT_LOCATION+': AReader is invalid');
+  Assert((AAsm = nil) or AAsm.TestValid(TIdSoapDynamicAsm),ASSERT_LOCATION+': AAsm is invalid');
+  result := sizeof(Pointer);  // either way its a pointer
+  if Assigned(ABaseNode) then
+    begin
+    Assert(ABaseNode.TestValid(TIdSoapNode),ASSERT_LOCATION+': ABaseNode is invalid');
+    end;
+  if AParam.ParamFlag in [pfVar, pfOut] then
+    begin
+    LPString := AServerContext.GetTempAnsiString;
+    if AParam.ParamFlag = pfVar then
+      begin
+      LPString^ := AReader.ParamString[nil, AParamName];
+      end
+    else if AParam.ParamFlag = pfOut then
+      begin
+      LPString^ := '';
+      end;
+    AServerContext.ParamPtr[AParamIndex] := LPString;
+    if Assigned(AAsm) then
+      begin
+      AAsm.AsmPushPtr(LPString);
+      end;
+    end
+  else
+    begin
+    if Assigned(ABaseNode) then
+      begin
+      String(AData) := AReader.ParamAnsiString[ABaseNode, AParamName];
+      end
+    else
+      begin
+      LPString := AServerContext.GetTempAnsiString;
+      LPString^ := AReader.ParamAnsiString[nil, AParamName];
+      if Assigned(AAsm) then
+        begin
+        AAsm.AsmPushPtr(pointer(LPString^));
+        end;
+      end;
+    end;
+end;
+
+
 function TIdSoapListener.ProcessParamWideString(AParamName : string; AServerContext: TIdSoapServerRequestContext; AParam: TIdSoapITIParameter; AParamIndex: Integer; AReader: TIdSoapReader; AAsm: TIdSoapDynamicAsm; ABaseNode: TIdSoapNode; Var AData): Integer;
 const ASSERT_LOCATION = ASSERT_UNIT+'.TIdSoapListener.ProcessParamWideString';
 var

diff --git a/tests/IdSoapInterfaceTests.IdSoapCfg b/tests/IdSoapInterfaceTests.IdSoapCfg
@@ -1,5 +1,5 @@
 [Project]
-Directory=c:\IndyMasters\Soap\DUnit
+Directory=C:\HL7Connect\indysoap\tests
 
 [Source]
 IdSoapInterfaceTestsIntfDefn.pas

diff --git a/tests/IdSoapInterfaceTests.iti.xml b/tests/IdSoapInterfaceTests.iti.xml