optosoapdomconv.pas

Delphi开发webservice的一套例子

    WriteRectDynArrayElem(RootNode, Node, Info, GetDynArrayLength(P), Dims, P);
end;

function TSOAPDomConv.WriteNonRectDynArrayElem(RootNode, Node: IXMLNode;  Info: PTypeInfo; URI, TypeName: InvString; P: Pointer; Dim: Integer): Integer;
var
  I, Len: Integer;
  IsNull: Boolean;
  ElemNode, DataNode: IXMLNode;
  ArrayDims: TIntegerDynArray;
  ID: Integer;
  S: InvString;
begin
  Len := GetDynArrayLength(P);
  if Dim > 1 then
  begin
    SetLength(ArrayDims, Dim);
    for I := 0 to Dim - 2 do
      ArrayDims[I] := 0;
    ArrayDims[Dim-1] := Len;
    Dec(Dim);
    ElemNode := MakeArrayNode(RootNode, RootNode,  DefArrayElemName, URI, TypeName, ArrayDims);
    Result := FIDs;
    ElemNode.Attributes[SXMLID] := SArrayIDPre + IntToStr(Result);
    Inc(FIDs);
    for I := 0 to Len - 1 do
    begin
      ID := WriteNonRectDynArrayElem(RootNode, ElemNode, Info, URI, TypeName, Pointer( PInteger(P)^), Dim);
      if ID <> 0 then
      begin
        DataNode := ElemNode.AddChild(DefArrayElemName);
        DataNode.Attributes[SXMLHREF] := SHREFPre + SArrayIDPre + IntToStr(ID);
      end;
      P := Pointer(Integer(P) + sizeof(Pointer));
    end;
  end
  else
  begin
    SetLength(ArrayDims, 1);
    ArrayDims[0] := Len;
    ElemNode := MakeArrayNode(RootNode, RootNode, DefArrayElemName, URI, TypeName, ArrayDims);

    Result := FIDs;
    Inc(FIDs);
    ElemNode.Attributes[SXMLID] :=  SArrayIDPre + IntToStr(Result);

    for I := 0 to Len - 1 do
    begin
      TypeTranslator.CastNativeToSoap(Info, S, P, IsNull);
      DataNode := ElemNode.AddChild(DefArrayElemName);
      DataNode.Text := S;
      P := Pointer( Integer(P) + GetTypeSize(Info));
    end;
  end;
end;

procedure TSOAPDomConv.ReadVariant(Node: IXMLNode; P: Pointer);
var
  SoapTypeInfo: PTypeInfo;
  DT: TXSDateTime;
  URI, TypeName: InvString;
begin
  Variant(PVarData(P)^) := NULL;
  if  Node.ChildNodes.Count > 1 then
    Variant(PVarData(P)^) := ReadVarArrayDim(Node)
  else
  begin
    GetElementType(Node, URI, TypeName);
    SoapTypeInfo := RemTypeRegistry.XSDToTypeInfo(URI, TypeName);
    if SoapTypeInfo = nil then
      SoapTypeInfo := TypeInfo(System.WideString);
   if (SoapTypeInfo.Kind = tkClass) and (GetTypeData(SoapTypeInfo).ClassType = TXSDateTime) then
   begin
     DT := TXSDateTime.Create;
     DT.XSToNative(Node.Text);
     Variant(PVarData(P)^) := DT.AsDateTime;
     DT.Free;
   end else
     Variant(PVarData(P)^) :=  TypeTranslator.CastSoapToVariant(SoapTypeInfo, GetNodeAsText(Node));
 end;
end;

procedure TSOAPDomConv.ReadRow(RootNode, Node: IXMLNode; var CurElem: Integer; Size: Integer; P: Pointer; Info: PTypeInfo);
var
  I: Integer;
  URI, TypeName: InvString;
  IsNull, IsScalar: Boolean;
begin
  if CurElem > Node.ChildNodes.Count -1 then
     raise ESOAPDomConvertError.Create(SArrayTooManyElem);
   if Info.Kind = tkClass then
   begin
     for I := 0 to Size - 1 do
     begin
       RemClassRegistry.ClassToURI(GetTypeData(Info).ClassType, URI, TypeName, IsScalar);
       PTObject(P)^ := ConvertSOAPToObject(RootNode, Node.ChildNodes[CurElem],
                          GetTypeData(Info).ClassType, URI, TypeName, P, 1);
       P := Pointer(Integer(P) + sizeof(Pointer));
       Inc(CurElem);
     end;
   end else if Info.Kind = tkVariant then
   begin
     for I := 0 to Size - 1 do
     begin
       ReadVariant(Node.ChildNodes[CurElem], P);
       P := Pointer(Integer(P) + GetTypeSize(Info));
       Inc(CurElem);
     end;
   end else
   begin
     IsNull := False;
     for I := 0 to Size - 1 do
     begin
      TypeTranslator.CastSoapToNative(Info,  Node.ChildNodes[CurElem].Text, P, IsNull);
      P := Pointer(Integer(P) + GetTypeSize(Info));
      Inc(CurElem);
     end;
  end;
end;


procedure TSOAPDomConv.ReadRectDynArrayElem(RootNode, Node: IXMLNode; Info: PTypeInfo; Size, Dim: Integer; P: Pointer;
  var CurElem: Integer);
var
  I: Integer;
  ElemSize: Integer;
  ID: InvString;
begin
  Node := GetDataNode(RootNode, Node, ID);
  if Dim > 1 then
  begin
    Dec(Dim);
    for I := 0 to Size - 1 do
    begin
      ElemSize := GetDynArrayLength(Pointer(PInteger(P)^));
      ReadRectDynArrayElem(RootNode, Node, Info, ElemSize, Dim, Pointer(PInteger(P)^), CurElem);
      P := Pointer(Integer(P) + sizeof(Pointer));
    end;
  end
  else
  begin
     if CurElem > Node.ChildNodes.Count -1 then
       raise ESOAPDomConvertError.Create(SArrayTooManyElem);

     ReadRow(RootNode, Node, CurElem, Size, P, Info);
  end;
end;

procedure TSOAPDomConv.ReadRectDynArray(RootNode, Node: IXMLNode; Info: PTypeInfo; Dims: Integer; P: Pointer; CurElem: Integer);
begin
  ReadRectDynArrayElem(RootNode, Node, Info, GetDynArrayLength(P), Dims, P, CurElem);
end;

function TSOAPDomConv.ConvertSoapToNativeArrayElem(ArrayInfo, ElemInfo: PTypeInfo;
  RootNode, Node: IXMLNode; ArrayDesc: TSOAPArrayDesc; Dims, CurDim: Integer; DataP: Pointer): Pointer;
var
  PElem, ChildP, DynP: Pointer;
  Size, I: Integer;
  ID: InvString;
  ChildNode: IXMLNode;
  NodeOffset: Integer;
  CurElem: Integer;
  IntVec: TIntegerDynArray;
  DimCnt: Integer;
begin
  Result := nil;
  Node := GetDataNode(RootNode, Node, ID);
  if Dims > 1 then
  begin
    if (Length(ArrayDesc) > 0 ) and ArrayDesc[CurDim].MultiDim then
    begin
      DynP := Pointer(PInteger(DataP)^);
      DynArraySetLength(DynP, ArrayInfo, Length(ArrayDesc[CurDim].Dims), PLongInt(ArrayDesc[CurDim].Dims));
      Result := DynP;
      Size :=  Length(ArrayDesc[CurDim].Dims);
      NodeOffset := 0;
      ReadRectDynArray(RootNode,  Node, ElemInfo, Size, DynP, NodeOffset);
    end else
    begin
      Size := Node.ChildNodes.Count;
      DynP := Pointer(PInteger(DataP)^);
      if Length(ArrayDesc) = 0 then
      begin
        SetLength(IntVec, 1);
        DimCnt := 1;
      end else
      begin
        SetLength(IntVec, Length(ArrayDesc[CurDim].Dims));
        DimCnt := Length(ArrayDesc[CurDim].Dims);
      end;
      for I := 0 to Length(IntVec) -1 do
        IntVec[I] := Size;
      DynArraySetLength(DynP, ArrayInfo, DimCnt, PLongInt(IntVec));
      PElem := DynP;
      Result := DynP;
      Dec(Dims);
      Inc(CurDim);
      for I := 0 to Size - 1 do
      begin
        ChildNode := GetDataNode(RootNode, Node.ChildNodes[I], ID);
        ChildP :=  ConvertSoapToNativeArrayElem(GetDynArrayNextInfo(ArrayInfo), ElemInfo, RootNode,
                     ChildNode, ArrayDesc, Dims, CurDim, PElem);
        PInteger(PElem)^ := Integer(ChildP);
        PElem := Pointer(Integer(PElem) + sizeof(Pointer));
      end;
    end;
  end else if Dims = 1 then
  begin
    begin
      Size := Node.ChildNodes.Count;
      if DataP <> nil then
      begin
        DynP := Pointer(PInteger(DataP)^);
        if Length(ArrayDesc) = 0 then
        begin
          SetLength(IntVec, 1);
          DimCnt := 1;
        end else
        begin
          SetLength(IntVec, Length(ArrayDesc[CurDim].Dims));
          DimCnt := Length(ArrayDesc[CurDim].Dims);
        end;
        for I := 0 to Length(IntVec) -1 do
          IntVec[I] := Size;
        DynArraySetLength(DynP, ArrayInfo, DimCnt,  PLongInt(IntVec) );
        PElem := DynP;
        Result := DynP;
        CurElem := 0;
        if Size > 0 then
          ReadRow(RootNode, Node, CurElem,  Size, PElem, ElemInfo);
      end;
    end;
  end;
end;

function TSOAPDomConv.ConvertSoapToNativeArray(DataP: Pointer;  TypeInfo: PTypeInfo;
  RootNode, Node: IXMLNode): Pointer;
var
  Dims: Integer;
  ElemInfo: PTypeInfo;
  ArrayDesc: TSOAPArrayDesc;
  ArrayType: InvString;
  V : Variant;
  TypeURI, TypeName: InvString;
  S: String;
  ArrayLen: Integer;
  DynP: Pointer;
begin
  GetElementType(Node, TypeURI, TypeName);
  GetDynArrayElTypeInfo(TypeInfo, ElemInfo, Dims);
  if ElemInfo = nil then
    raise  ESOAPDomConvertError.CreateFmt(SNoArrayElemRTTI, [TypeInfo.Name]);
  if (Dims = 1) and (ElemInfo.Kind = tkInteger) and (GetTypeData(ElemInfo).OrdType = otUByte) and
    {(TypeURI = SXMLSchemaURI_2001) and }(TypeName = 'base64Binary') then
  begin
    S := DecodeString(Node.Text);
    ArrayLen := Length(S);
    DynP := Pointer(PInteger(DataP)^);
    DynArraySetLength(DynP, TypeInfo, 1, @ArrayLen);
    Move(S[1], DynP^, Length(S));
    Result := DynP;
  end else
  begin
    V := Node.GetAttributeNS(SSoapEncodingArrayType, SSoap11EncodingS5);
    if not VarIsNull(V) then
    begin
      ArrayType := V;
      ArrayType := Copy(ArrayType, Pos('[',ArrayType), High(Integer));     { do not localize }
    end;

    if ElemInfo.Kind = tkVariant then
    begin
      SetLength(ArrayDesc, 1);
      SetLength(ArrayDesc[0].Dims, 1);
    end else
    begin
      ParseDims(ArrayType, ArrayDesc);
    end;
    Result := ConvertSoapToNativeArrayElem(TypeInfo, ElemInfo, RootNode, Node, ArrayDesc, Dims, 0, DataP);
  end;
end;

function TSOAPDomConv.GetNewID: string;
begin
  Result := IntToStr(FIDs);
  Inc(FIDs);
end;

function TSOAPDomConv.CreateMultiRefNode(RootNode: IXMLNode; Name, ID: InvString): IXMLNode;
var
  I, J: Integer;
begin
  Result := RootNode.OwnerDocument.CreateNode(Name);
  Result.Attributes[SXMLID] := ID;
  I := 0;
  while I < Length(MultiRefNodes) do
  begin
    if MultiRefNodes[I].Node = RootNode then
      break;
    Inc(I);
  end;
  if I = Length(MultiRefNodes) then
  begin
    SetLength(MultiRefNodes, I + 1);
    MultiRefNodes[I].Node := RootNode;
  end;
  J := Length(MultiRefNodes[I].MultiRefChildren);
  SetLength(MultiRefNodes[I].MultiRefChildren, J + 1);
  MultiRefNodes[I].MultiRefChildren[J] := Result;
end;

procedure TSOAPDomConv.FinalizeMultiRefNodes;
var
  I, J: Integer;
begin
  for I := 0 to Length(MultiRefNodes) - 1 do
  begin
    for J := 0 to Length(MultiRefNodes[I].MultiRefChildren) - 1 do
      MultiRefNodes[I].Node.ChildNodes.Add(MultiRefNodes[I].MultiRefChildren[J]);
  end;
  for I := 0 to Length(MultiRefNodes) - 1 do
  begin
    SetLength(MultiRefNodes[I].MultiRefChildren, 0);
  end;
  SetLength(MultiRefNodes, 0);
end;

function TSOAPDomConv.CreateObjectNode(Instance: TObject; RootNode, Node: IXMLNode; Name,  URI: InvString): InvString;
var
  ID, Pre: InvString;
  I, Count: Integer;
  PropList: PPropList;
  Kind: TTypeKind;
  V: Variant;
  Obj: TObject;
  NodeURI, ElemURI, TypeName: InvString;
  IsScalar: Boolean;
  InstNode, ElemNode: IXMLNode;
  P: Pointer;
  MultiRefOpt: TObjMultiOptions;
  ExtPropName: InvString;
begin
  Result := GetNewID;
  Pre := FindPrefixForURI(RootNode, Node,  URI, True);
  MultiRefOpt :=  RemTypeRegistry.ClassOptions(Instance.ClassType);

  if not (soSendMultiRefObj in FOptions) or (ocNoMultiRef = MultiRefOpt) then
    InstNode :=  Node.AddChild(Pre + ':' + Name)         { do not localize }
  else
    InstNode := CreateMultiRefNode(RootNode, Pre + ':' + Name, Result);   { do not localize }

  RemClassRegistry.ClassToURI(Instance.ClassType, NodeURI, TypeName, IsScalar);

  SetNodeType(RootNode, InstNode, NodeURI, TypeName);
  if (soSendMultiRefObj in FOptions) or not (ocNoMultiRef = MultiRefOpt)  then
    AddMultiRefNode(Result, Instance);
  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for I := 0 to Count - 1 do
      begin
        ExtPropName := RemTypeRegistry.GetExternalPropName(Instance.ClassInfo, PropList[I].Name);
        Kind := (PropList[I].PropType)^.Kind;
        if Kind = tkClass then
        begin
          Obj := GetObjectProp(Instance, PropList[I]);
          if Obj = nil then
            CreateNULLNode(RootNode, InstNode, ExtPropName)
          else
          begin
            RemClassRegistry.ClassToURI(GetTypeData((PropList[I].PropType)^).ClassType, ElemURI, TypeName, IsScalar);

            if IsScalar then 
            begin
              ElemNode := InstNode.AddChild(ExtPropName);
              if not RemTypeRegistry.TypeInfoToXSD((PropList[I].PropType)^, ElemURI, TypeName) then
                raise ESOAPDomConvertError.CreateFmt(SRemTypeNotRegistered,[GetTypeData((PropList[I].PropType)^).ClassType.ClassName]);
              if not GetTypeData((PropList[I].PropType)^).ClassType.InheritsFrom(TRemotable) then
                raise ESOAPDomConvertError.CreateFmt(SScalarFromTRemotableS, [GetTypeData((PropList[I].PropType)^).ClassType.ClassName]);
              ElemNode.Attributes[FindPrefixForURI(RootNode, Node, XMLSchemaInstNameSpace)  + ':' + SSoapType] := TypeName;   { do not localize }
              ElemNode.Text := TRemotableXS(Obj).NativeToXS;
            end
            else
            begin
              if not (soSendMultiRefObj in FOptions) or (ocNoMultiRef = MultiRefOpt) then
              begin
                if IsObjectWriting(Obj) then
                  raise ESOAPDomConvertError.Create(SNoSerializeGraphs);
                AddObjectAsWriting(Instance);
                CreateObjectNode(Obj, RootNode, InstNode, ExtPropName, ElemURI);
                RemoveObjectAsWriting(Obj);
              end else
              begin
                ElemNode := InstNode.AddChild(ExtPropName);