xmlvariants.pas

delphi的XMPRPC通讯例子

  
      case (varType(FArray) - varArray) of
        varEmpty: ;
        varNull: ;
        varSmallint:
            tags := tags + IntToStr(SmallInt(pElement^));
        varInteger:
            tags := tags + IntToStr(Integer(pElement^));
        varSingle:
            tags := tags + FloatToStr(Single(pElement^));
        varDouble:
            tags := tags + FloatToStr(Double(pElement^));
        varCurrency:
            tags := tags + CurrToStr(Currency(pElement^));
        varDate:
            tags := tags + DateTimeToStr(TDateTime(pElement^));
        varBoolean:
            tags := tags + IntToStr(Word(pElement^));
        varByte:
            tags := tags + IntToStr(Byte(pElement^));
        varOleStr:
            tags := tags + pwidechar(pElement^);
  {$IFDEF Delphi6OrHigher}
        varWord:
            tags := tags + IntToStr(Word(pElement^));
        varLongWord:
            tags := tags + IntToStr(LongWord(pElement^));
        varShortInt:
            tags := tags + IntToStr(ShortInt(pElement^));
        varInt64:
            tags := tags + IntToStr(Int64(pElement^));
  {$ENDIF}
  
        varVariant:
            tags := tags + VariantToXML(PVariant(pElement)^);
        varUnknown, varDispatch:
            tags := tags + InterfaceToXML(PVariant(pElement)^);
        else
        // Untested:
        //varError:
        //varStrArg:
        //varInt64:
        //varString:
          // Raise Unknown type Exception
      end;
  
  
      tags := tags + '</' + ARRAY_ELEMENT_NAME + IntToStr(i) + '>';
  
    end;
  finally
    VarArrayUnlock(FArray);
  end;
  result := tags;
end;

function TVarArrayEncoder.getHighBound(Dimension: integer): Integer;
begin
  Result := VarArrayHighBound(FArray, Dimension);
end;

function TVarArrayEncoder.getLowBound(Dimension: Integer): Integer;
begin
  Result := VarArrayLowBound(FArray, Dimension);
end;

function TVarArrayEncoder.getOverallElementsCount: Integer;
var
  i, hb, lb: Integer;
begin
  Result := 1;
  for i := 1 to self.getDimensionCount do
  begin
    hb := self.getHighBound(i);
    lb := self.getLowBound(i);
    if (hb - lb + 1) <= 0 then
    begin
      Result := 0;
      exit;
    end;
    Result := Result * (hb - lb + 1)
  end;
end;

function TVarArrayEncoder.getVarTypeTag: string;
begin
  result := OPEN_TYPE_TAG + IntToStr(varType(FArray)) + CLOSE_TYPE_TAG;
end;

function TVarArrayEncoder.GetXML: string;
var
  i: Integer;
begin
  result := self.getVarTypeTag + self.getDimensionCountTag;
  for i := 1 to Self.getDimensionCount do
  begin
    result := Result + self.getDimensionBoundTag(i);
  end;
  result := result + getDataTag;
end;

{
******************************* TVarArrayDecoder *******************************
}
constructor TVarArrayDecoder.Create(XML: string; CurrentVariant: Variant);
begin
  inherited create;
  FXML := XML;
  FCurrentVariant := CurrentVariant;
end;

function TVarArrayDecoder.CreateProperArray: Variant;
var
  bounds: array of integer;
  i: Integer;
begin
  SetLength(bounds, getDimensionCount * 2);
  for i := 1 to getDimensionCount do
  begin
    Bounds[i * 2 - 2] := getLowBound(i);
    Bounds[i * 2 - 1] := getHighBound(i);
  end;
  result := varArrayCreate(bounds, getVarType - varArray);
end;

procedure TVarArrayDecoder.FillVarArray(var Arr: variant);
var
  pArray: PVariant;
  pElement: Pointer;
  ElementSize, i: Integer;
  elementXML: string;
begin
  pArray := VarArrayLock(Arr);
  try
    ElementSize := TVarData(Arr).Varray.ElementSize;
    for i := 0 to self.getOverallElementsCount - 1 do
    begin
      pElement := Pointer(Integer(PArray) + i * ElementSize);
  
      elementXML := GetVariantByElement(i);
  
  
      case (varType(Arr) - varArray) of
        varEmpty: ;
        varNull: ;
        varSmallint:
            SmallInt(pElement^) := StrToInt(elementXML);
        varInteger:
            Integer(pElement^) := StrToInt(elementXML);
        varSingle:
            Single(pElement^) := StrToFloat(elementXML);
        varDouble:
            Double(pElement^) := StrToFloat(elementXML);
        varCurrency:
            Currency(pElement^) := StrToCurr(elementXML);
        varDate:
            TDateTime(pElement^) := StrToDate(elementXML);
        varBoolean:
            Word(pElement^) := StrToInt(elementXML);
        varByte:
            Byte(pElement^) := StrToInt(elementXML);
  
  {$IFDEF Delphi6OrHigher}
        varLongWord:
            LongWord(pElement^) := StrToInt(elementXML);
        varWord:
            Word(pElement^) := StrToInt(elementXML);
        varShortInt:
            ShortInt(pElement^) := StrToInt(elementXML);
        varInt64:
            Int64(pElement^) := StrToInt(elementXML);
  {$ENDIF}
  
        varVariant:
            XMLToVariant(elementXML, PVariant(pElement)^);
        varUnknown, varDispatch:
            XMLToInterface(ElementXML, PVariant(pElement)^);
        else
        // Untested:
        //varError:
        //varStrArg:
        //varInt64:
        //varString:
        //varOleStr:
        //    pwidechar(pElement^) := StringToWideChar(elementXML, );
          // Raise Unknown type Exception
      end;
    end;
  finally
    VarArrayUnlock(Arr);
  end;
end;

function TVarArrayDecoder.GetArray: Variant;
begin
  if IsProperArray(FCurrentVariant) then
    result := FCurrentVariant
  else
    result := self.createProperArray;
  self.fillVarArray(result);
end;

function TVarArrayDecoder.GetBoundData(Dimension: Integer): string;
var
  idx: Integer;
begin
  idx := 1;
  Result := FastParseTagXML(FXML, self.getBoundTagName(Dimension), idx);
end;

function TVarArrayDecoder.GetBoundTagName(Dimension: Integer): string;
begin
  result := copy(OPEN_DIM_BOUND_TAG + IntToStr(Dimension), 2, length(OPEN_DIM_BOUND_TAG + IntToStr(Dimension)) - 1);
end;

function TVarArrayDecoder.GetDimensionCount: Integer;
var
  idx: Integer;
begin
  idx := 1;
  Result := StrToInt(FastParseTag(FXML, OPEN_DIMENSION_TAG, CLOSE_DIMENSION_TAG, idx));
end;

function TVarArrayDecoder.GetElementTagName(Index: integer): string;
begin
  result := ARRAY_ELEMENT_NAME + IntToStr(Index);
end;

function TVarArrayDecoder.GetHighBound(Dimension: integer): Integer;
var
  boundData: AnsiString;
begin
  boundData := self.getBoundData(Dimension);
  Result := StrToInt(FastToken(boundData, ':', length(boundData)));
end;

function TVarArrayDecoder.GetLowBound(Dimension: Integer): Integer;
begin
  Result := StrToInt(FastToken(getBoundData(Dimension), ':', 1));
end;

function TVarArrayDecoder.GetOverallElementsCount: Integer;
var
  i, hb, lb: Integer;
begin
  Result := 1;
  for i := 1 to self.getDimensionCount do
  begin
    hb := self.getHighBound(i);
    lb := self.getLowBound(i);
    if (hb - lb + 1) <= 0 then
    begin
      Result := 0;
      exit;
    end;
    Result := Result * (hb - lb + 1)
  end;
end;

function TVarArrayDecoder.GetVariantByElement(const Index: integer): string;
var
  idx: Integer;
begin
  idx := 1;
  result := FastParseTagXML(FXML, self.getElementTagName(Index), idx);
end;

function TVarArrayDecoder.GetVarType: Integer;
var
  idx: Integer;
begin
  idx := 1;
  result := StrToInt(FastParseTag(FXML, OPEN_TYPE_TAG, CLOSE_TYPE_TAG, idx));
end;

function TVarArrayDecoder.IsProperArray(arr: variant): Boolean;
var
  i: Integer;
begin
  { TODO : Weird Format }
  result := VarIsArray(arr);
  
  if result then
  begin
    result := VarArrayDimCount(arr) = self.getDimensionCount;
  end;
  
  if result then
  begin
    result := (VarType(arr) = self.getVarType);
  end;
  
  if result then
  begin
    for i := 1 to self.getDimensionCount do
    begin
      result := VarArrayLowBound(arr, i) = self.getLowBound(i);
      if not Result then
        break;
      result := VarArrayHighBound(arr, i) = self.getHighBound(i);
      if not Result then
        break;
    end;
  end;
end;



(*
Sancho : Comment
The following problems must be solved:
7. the VariantTypes varVariant and varAny(CORBA) might be problematic for the issue
   in 6
9. how could Classes be recreated genericly????? The support of interfaces right now seems
   to be not very practically.....
10.An exception should be raised on invalid/Unknown VariantTypes therefore it might
   be nessesary to put the exceptions into a own Unit.

How to solve?
*)
end.