🚀 go-pugleaf

I am trying to use the technology, but seems the only code around is
not fit
for me. Is it there a better one?

I also now trying to write from scratch. I fail on getting XML from
TXmlRpxStruct. Please, show me my mistake.

Thank you,

Broto Suseno

// -- the code

unit UBSXmlRpcTypes;

interface

uses SysUtils, Classes;

type
  TXmlRpcDataType = (xrdtInteger, xrdtBoolean, xrdtString,
                     xrdtDouble, xrdtDateTime, xrdtBase64,
                     xrdtArray, xrdtStruct);

const
  XmlRpcTags: array[TXmlRpcDataType] of String =
      ('int', 'boolean', 'string',
      'double', 'dateTime.iso8601', 'base64',
      'array', 'struct');

type
  TXmlRpcArray = class;
  TXmlRpcStruct = class;

  TXmlRpcElement = class (TObject)
  private
    FDataType: TXmlRpcDataType;
    function GetXML: string;
  public
    ValueBase64: string;
    ValueBoolean: Boolean;
    ValueDateTime: TDateTime;
    ValueDouble: Double;
    ValueInteger: Integer;
    ValueString: string;
    constructor Create(NewDataType: TXmlRpcDataType);
    destructor Destroy; override;
  published
    property DataType: TXmlRpcDataType read FDataType;
    property XML: string read GetXML;
  end;

  TXmlRpcArray = class (TXmlRpcElement)
  private
    FItems: TList;
    function GetXML: string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddElement(Value: TXmlRpcElement);
    property Items: TList read FItems write FItems;
    property XML: string read GetXML;
  end;

  TXmlRpcMember = class (TObject)
  private
    function GetXML: string;
  public
    MemberName: string;
    MemberValue: TXmlRpcElement;
    constructor Create;
    destructor Destroy; override;
    property XML: string read GetXML;
  end;

  TXmlRpcStruct = class (TXmlRpcElement)
  private
    FMembers: TList;
    function GetXML: string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(MemberName: String; MemberValue: TXmlRpcElement);
overload;
    procedure Add(Value: TXmlRpcMember); overload;
    property Members: TList read FMembers write FMembers;
    property XML: string read GetXML;
  end;

  TXmlRpcPayload = class (TObject)
  private
    FParams: TList;
    FRPCMethodName: string;
    function GetXML: string;
  public
    constructor Create(NewRPCMethodName: String);
    destructor Destroy; override;
    procedure Add(Element: TXmlRpcElement);
    property Params: TList read FParams;
    property RPCMethodName: string read FRPCMethodName;
    property XML: string read GetXML;
  end;

  TXmlRpcRequest = class (TObject)
  end;

  TXmlRpcResponse = class (TObject)
  end;

implementation

{
********************************* TXmlRpcArray
*********************************
}
constructor TXmlRpcArray.Create;
begin
  // TODO -cProcedure:    procedure Add -- by BSAutoTODO

  inherited Create(xrdtArray);

  FItems := TList.Create;
end;

destructor TXmlRpcArray.Destroy;
var
  i: Integer;
begin
  // TODO -cDestructor: TXmlRpcArray.Destroy -- by BSAutoTODO

  for i := 0 to FItems.Count - 1 do
    TXmlRpcElement(FItems[i]).Free;

  FItems.Free;

  inherited;
end;

procedure TXmlRpcArray.AddElement(Value: TXmlRpcElement);
begin
  FItems.Add(Value);
end;

function TXmlRpcArray.GetXML: string;
var
  SL: TStringList;
  i: Integer;
  AElement: TXmlRpcElement;
begin
  // TODO -cFunction: TXmlRpcArray.GetXML -- by BSAutoTODO

  SL := TStringList.Create;

  try
    SL.Add(Format('<%s>', [XmlRpcTags[xrdtArray]]));

    if (FItems.Count > 0) then begin
      SL.Add('<data>');
      for i := 0 to FItems.Count - 1 do begin
        AElement := TXmlRpcElement(FItems[i]);
        SL.Add(AElement.XML);
      end;
      SL.Add('</data>');
    end;

    SL.Add(Format('</%s>', [XmlRpcTags[xrdtArray]]));

    Result := SL.Text;

  finally
    SL.Free;
  end;
end;

{
******************************** TXmlRpcStruct
*********************************
}
constructor TXmlRpcStruct.Create;
begin
  // TODO -cConstructor: TXmlRpcStruct.Create -- by BSAutoTODO

  inherited Create(xrdtStruct);

  FMembers := TList.Create;
end;

destructor TXmlRpcStruct.Destroy;
var
  i: Integer;
begin
  // TODO -cDestructor: TXmlRpcStruct.Destroy -- by BSAutoTODO

  for i := 0 to FMembers.Count - 1 do
    TXmlRpcMember(FMembers[i]).Free;

  FMembers.Free;

  inherited;
end;

procedure TXmlRpcStruct.Add(MemberName: String; MemberValue:
TXmlRpcElement);
var
  AnMember: TXmlRpcMember;
begin
  // TODO -cProcedure: TXmlRpcStruct.Add -- by BSAutoTODO

  AnMember := TXmlRpcMember.Create;
  AnMember.MemberName := MemberName;
  AnMember.MemberValue := MemberValue;

  Add(AnMember);
end;

procedure TXmlRpcStruct.Add(Value: TXmlRpcMember);
begin
  // TODO -cProcedure: TXmlRpcStruct.Add -- by BSAutoTODO

  FMembers.Add(Value);
end;

function TXmlRpcStruct.GetXML: string;
var
  SL: TStringList;
  i: Integer;
  AMember: TXmlRpcMember;
begin
  // TODO -cFunction: TXmlRpcStruct.GetXML -- by BSAutoTODO

  SL := TStringList.Create;

  try
    SL.Add(Format('<%s>', [XmlRpcTags[xrdtStruct]]));

    if (FMembers.Count > 0) then begin
      SL.Add('<member>');
      for i := 0 to FMembers.Count - 1 do begin
        AMember := TXmlRpcMember(FMembers[i]);
        SL.Add(AMember.XML);
      end;
      SL.Add('</member>');
    end;

    SL.Add(Format('</%s>', [XmlRpcTags[xrdtStruct]]));

    Result := SL.Text;

  finally
    SL.Free;
  end;
end;

{
******************************** TXmlRpcMember
*********************************
}
constructor TXmlRpcMember.Create;
begin
  // TODO -cConstructor: TXmlRpcMember.Create -- by BSAutoTODO

  inherited Create;
end;

destructor TXmlRpcMember.Destroy;
begin
  // TODO -cDestructor: TXmlRpcMember.Destroy -- by BSAutoTODO

  MemberValue.Free;

  inherited;
end;

function TXmlRpcMember.GetXML: string;
begin
  // TODO -cFunction: TXmlRpcMember.GetXML -- by BSAutoTODO

  Result := '<member>'
          + '<name>' + MemberName + '</name>'
          + MemberValue.XML
          + '</member>';
end;

{
******************************** TXmlRpcElement
********************************
}
constructor TXmlRpcElement.Create(NewDataType: TXmlRpcDataType);
begin
  // TODO -cConstructor: TXmlRpcElement.Create -- by BSAutoTODO

  FDataType := NewDataType;

  inherited Create;
end;

destructor TXmlRpcElement.Destroy;
begin
  // TODO -cDestructor: TXmlRpcElement.Destroy -- by BSAutoTODO

  inherited;
end;

function TXmlRpcElement.GetXML: string;
var
  s: string;
begin
  // TODO -cFunction: TXmlRpcElement.GetXML -- by BSAutoTODO

  Result := '<value>' + Format('<%s>', [XmlRpcTags[FDataType]]);

  case FDataType of
    xrdtInteger: Result := Result + IntToStr(ValueInteger);
    xrdtBoolean: Result := Result + IntToStr(Ord(ValueBoolean));
    xrdtString: Result := Result + ValueString;
    xrdtDouble: begin
      s := FloatToStr(ValueDouble);
      if (DecimalSeparator <> '.') then
        s := StringReplace(s, DecimalSeparator, '.', [rfReplaceAll]);
      Result := Result + s;
    end;
    xrdtDateTime: Result := Result + FormatDateTime('yyyymmdd',
ValueDateTime)
                            + 'T' + FormatDateTime('hh:nn:ss',
ValueDateTime);
    xrdtBase64: Result := Result + ValueBase64;
  end;

  Result := Result + Format('</%s>', [XmlRpcTags[FDataType]]) + '</
value>';
end;

{
******************************** TXmlRpcPayload
********************************
}
constructor TXmlRpcPayload.Create(NewRPCMethodName: String);
begin
  // TODO -cConstructor: TXmlRpcPayload.Create -- by BSAutoTODO

  inherited Create;

  FParams := TList.Create;
  FRPCMethodName := NewRPCMethodName;
end;

destructor TXmlRpcPayload.Destroy;
var
  i: Integer;
begin
  // TODO -cDestructor: TXmlRpcPayload.Destroy -- by BSAutoTODO

  for i := 0 to FParams.Count - 1 do
    TXmlRpcElement(FParams[i]).Free;

  FParams.Free;

  inherited;
end;

procedure TXmlRpcPayload.Add(Element: TXmlRpcElement);
begin
  // TODO -cProcedure: TXmlRpcPayload.Add -- by BSAutoTODO

  FParams.Add(Element);
end;

function TXmlRpcPayload.GetXML: string;
var
  SL: TStringList;
  i: Integer;
  AElement: TXmlRpcElement;
begin
  // TODO -cFunction: TXmlRpcPayload.GetXML -- by BSAutoTODO

  SL := TStringList.Create;

  try
    SL.Add('<?xml version="1.0"?>');
    SL.Add('<methodCall>');
    SL.Add(Format('<methodName>%s</methodName>', [FRPCMethodName]));

    if (FParams.Count > 0) then begin
      SL.Add('<params>');
      for i := 0 to FParams.Count - 1 do begin
        AElement := TXmlRpcElement(FParams[i]);
        SL.Add(AElement.XML);
      end;
      SL.Add('</params>');
    end;

    SL.Add('</methodCall>');

    Result := SL.Text;

  finally
    SL.Free;
  end;
end;

end.