Wordpress Delphi Unit using XML-RPC

Hello, I tried to create a wordpress unit for Delphi.
This because I did not find any others libraries wich work with wordpress xml-rpc.

unit WPUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls,
XMLIntf, XMLDom, XMLDoc;

type
TSimpleType = (tsInt, tsI4, tsString, tsDouble, tsDateTime, tsBase64, tsBoolean, tsArray);

type
PXMLDocument = ^IXMLDocument;

type
TStructElement = packed record
Name : string; // element name
SType: TSimpleType; // element type
Value: string; // will contain value of element
ValueList: TStrings; // Used only in case of tsArray type
end;

type TStructArray = Array of TStructElement;

type
TWP = class(TForm)
IdHTTP: TIdHTTP;
IdAntiFreeze: TIdAntiFreeze;
lbStatus: TLabel;
Label1: TLabel;
procedure IdHTTPStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
private
{ Private declarations }
function GetDocument(methodName: string): IXMLDocument;
procedure SetXMLParam(SimpleType: TSimpleType; Value: string; Document: PXMLDocument);
procedure SetXMLStructure(Struct: TStructArray; Document: PXMLDocument);
function SendQuery(Document: IXMLDocument; BlogURL: string): IXMLDocument;
function ParseErrors(Document: PXMLDocument): TStringList;
function GetTypeResult(ElementType: String; Document: PXMLDocument): String;

public
{ Public declarations }

function sayHello(BlogURL: string): string;
function listMethods(BlogURL: string): string;

function newPost(BlogURL: string;
username: string;
password: string;
PostStruct: TStructArray;
Publish: string): string;
function editPost(BlogURL: string;
post_id: string;
username: string;
password: string;
PostStruct: TStructArray;
Publish: string): string;
function getPost(BlogURL: string;
username: string;
password: string;
post_id: string): IXMLDocument;
function getRecentPosts(BlogURL: string;
username: string;
password: string;
count: string): IXMLDocument;
function getPostsArrayField(Field: string; ResponseDoc: IXMLDocument): TStrings;
function getStringPostField(Field: string; ResponseDoc: IXMLDocument): String;
function getTStringSPostField(Field: string; ResponseDoc: IXMLDocument): TStrings;

function newComment(BlogURL: string;
username: string;
password: string;
post_id: string;
CommentStruct: TStructArray): string;

function newCategory(BlogURL: string;
username: string;
password: string;
CategoryStruct: TStructArray): string;

function getCategories(BlogURL: string;
username: string;
password: string): string;

function getTags(BlogURL: string;
username: string;
password: string): string;
end;

var
WP: TWP;
LastSend, LastReceived: String;

implementation

{$R *.dfm}

{ Private declarations }

function TWP.GetDocument(methodName: string): IXMLDocument;
var Root: IXMLNode;
begin
Result := NewXMLDocument();
Root := Result.CreateElement('methodCall','');
Result.DocumentElement := Root;
Root.AddChild('methodName').NodeValue := methodName;
Root.AddChild('params').NodeValue := '';
end;

procedure TWP.SetXMLParam(SimpleType: TSimpleType; Value: string; Document: PXMLDocument);
var Root: IXMLNode;
begin
if Document^.IsEmptyDoc then Exit; // Must provide a not empty xml
Root:=Document^.DocumentElement.ChildNodes.FindNode('params');
if Root=nil then Exit; //XML must have 'params' root

case SimpleType of
tsInt: Root.AddChild('param').AddChild('value').AddChild('int').NodeValue := Value;
tsI4: Root.AddChild('param').AddChild('value').AddChild('i4').NodeValue := Value;
tsString: Root.AddChild('param').AddChild('value').AddChild('string').NodeValue := Value;
tsDouble: Root.AddChild('param').AddChild('value').AddChild('double').NodeValue := Value;
tsDateTime:Root.AddChild('param').AddChild('value').AddChild('dateTime.iso8601').NodeValue := Value;
tsBase64: Root.AddChild('param').AddChild('value').AddChild('base64').NodeValue := Value;
tsBoolean: Root.AddChild('param').AddChild('value').AddChild('boolean').NodeValue := Value;
tsArray: Root.AddChild('param').AddChild('value').AddChild('array').NodeValue := Value;
end;
end;

procedure TWP.SetXMLStructure(Struct: TStructArray; Document: PXMLDocument);
var i, j:integer;
Root,Member, ArrayList: IXMLNode;
begin
if (Length(Struct)=0) or(Document^.IsEmptyDoc) then Exit;
Root:=Document^.DocumentElement.ChildNodes.FindNode('params').AddChild('param').AddChild('struct');
for i:= 0 to Length(Struct) - 1 do
if (Trim(Struct[i].Value) <> '')or(Struct[i].ValueList <> nil) then
begin
member:=Root.AddChild('member');
member.AddChild('name').NodeValue:=Struct[i].Name;
case Struct[i].SType of
tsInt,tsI4 : member.AddChild('value').AddChild('int').NodeValue:=Struct[i].Value;
tsString : member.AddChild('value').AddChild('string').NodeValue:=Struct[i].Value;
tsDouble : member.AddChild('value').AddChild('double').NodeValue:=Struct[i].Value;
tsDateTime : member.AddChild('value').AddChild('dateTime.iso8601').NodeValue:=Struct[i].Value;
tsBase64 : member.AddChild('value').AddChild('base64').NodeValue:=Struct[i].Value;
tsBoolean : member.AddChild('value').AddChild('boolean').NodeValue:=Struct[i].Value;
tsArray :
begin
if Struct[i].ValueList.Count > 0 then
begin
ArrayList := member.AddChild('value').AddChild('array').AddChild('data');
for j:=0 to Struct[i].ValueList.Count -1 do
ArrayList.AddChild('value').AddChild('string').NodeValue:=Struct[i].ValueList[j];
end
else member.AddChild('value').AddChild('string').NodeValue:='';
end;
end;
end;
end;

function TWP.SendQuery(Document: IXMLDocument; BlogURL: string): IXMLDocument;
var SQuery: TMemoryStream;
RQuery: TMemoryStream;
begin
SQuery := TMemoryStream.Create;
RQuery := TMemoryStream.Create;
Result := NewXMLDocument();
with IdHTTP do
begin
Document.SaveToStream(SQuery);
try
Post(BlogURL,SQuery, RQuery);
Result.LoadFromStream(RQuery,xetUTF_8);
except
Result := nil;
end;
end;
SQuery.Free;
RQuery.Free;
end;

function TWP.ParseErrors(Document: PXMLDocument): TStringList;
var i:integer;
List: IDOMNodeList;
code: string;
begin
List:=Document^.DOMDocument.getElementsByTagName('member');
Result:=TStringList.Create;
for i:=0 to List.length-1 do
begin
case i mod 2 of
0:code:=(List.item[i].lastChild.firstChild as IDOMNodeEx).text;
1:Result.Add('Code ' + code + ' : ' + (List.item[i].lastChild.firstChild as IDOMNodeEx).text);
end;
end;
end;

function TWP.GetTypeResult(ElementType: String; Document: PXMLDocument): String;
var List: IDOMNodeList;
begin
try
List:=Document^.DOMDocument.getElementsByTagName(ElementType);
Result := (List.item[0] as IDOMNodeEx).text;
except
Result := 'Could not read ' + ElementType + ' element';
end;
end;


{ Public declarations }

function TWP.sayHello(BlogURL: string): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('demo.sayHello');
SetXMLParam(tsString,'test',@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Strings[0]
else
result := GetTypeResult('string',@RecDoc);
end
else
result :='';
LastSend := SendDoc.XML.Text;
LastReceived := RecDoc.XML.Text;
end;

function TWP.listMethods(BlogURL: string): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('system.listMethods');
SetXMLParam(tsString,'',@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Strings[0]
else
result := RecDoc.XML.Text;
end
else
result :=''
end;

function TWP.newPost(BlogURL: string;
username: string;
password: string;
PostStruct: TStructArray;
Publish: string): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('metaWeblog.newPost');
SetXMLParam(tsInt,'',@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
SetXMLStructure(PostStruct,@SendDoc);
SetXMLParam(tsBoolean,Publish,@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Strings[0]
else
result := GetTypeResult('string',@RecDoc);
end
else
result :='Unknown error';
LastSend := SendDoc.XML.Text;
LastReceived := RecDoc.XML.Text;
end;

function TWP.editPost(BlogURL: string;
post_id: string;
username: string;
password: string;
PostStruct: TStructArray;
Publish: string): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('metaWeblog.editPost');
SetXMLParam(tsInt,post_id,@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
SetXMLStructure(PostStruct,@SendDoc);
SetXMLParam(tsBoolean,Publish,@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Strings[0]
else
result := GetTypeResult('boolean',@RecDoc);
end
else
result :='Unknown error';
LastSend := SendDoc.XML.Text;
LastReceived := RecDoc.XML.Text;
end;

function TWP.getPost(BlogURL: string;
username: string;
password: string;
post_id: string): IXMLDocument;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('metaWeblog.getPost');
SetXMLParam(tsInt,post_id,@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
Result := SendQuery(SendDoc,BlogURL);
LastSend := SendDoc.XML.Text;
LastReceived := Result.XML.Text;
end;

function TWP.getRecentPosts(BlogURL: string;
username: string;
password: string;
count: string): IXMLDocument;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('metaWeblog.getRecentPosts');
SetXMLParam(tsInt,'',@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
SetXMLParam(tsInt,count,@SendDoc);
Result := SendQuery(SendDoc,BlogURL);
LastSend := SendDoc.XML.Text;
LastReceived := Result.XML.Text;
end;

function TWP.getPostsArrayField(Field: string; ResponseDoc: IXMLDocument): TStrings;
var
i,j:integer;
Values: IDOMNodeList;
Members: IDOMNodeList;
ResponseStream: TStream;
begin
Result := TStringList.Create;
if ResponseDoc<> nil then
begin
Values:=ResponseDoc.DOMDocument.getElementsByTagName('data').item[0].childNodes;
for i:= 0 to Values.length-1 do
begin
Members:=Values[i].firstChild.childNodes;
for j:=0 to Members.length - 1 do
if (Members[j].firstChild as IDOMNodeEx).text = Field then
Result.Append((Members[j].lastChild.firstChild as IDOMNodeEx).text);
end;
end;
end;

function TWP.getStringPostField(Field: string; ResponseDoc: IXMLDocument): String;
var
i:integer;
Members: IDOMNodeList;
ResponseStream: TStream;
begin
if ResponseDoc<> nil then
begin
Members:=ResponseDoc.DOMDocument.getElementsByTagName('struct').item[0].childNodes;
for i:=0 to Members.length - 1 do
if (Members[i].firstChild as IDOMNodeEx).text = Field then
Result := (Members[i].lastChild.firstChild as IDOMNodeEx).text;
end;
end;

function TWP.getTStringSPostField(Field: string; ResponseDoc: IXMLDocument): TStrings;
var
i, j: integer;
Members: IDOMNodeList;
ArrayList: IDOMNodeList;
ResponseStream: TStream;
begin
if ResponseDoc<> nil then
begin
Result := TStringList.Create;
Members := ResponseDoc.DOMDocument.getElementsByTagName('struct').item[0].childNodes;
for i:= 0 to Members.length - 1 do
if (Members[i].firstChild as IDOMNodeEx).text = Field then
begin
ArrayList := Members[i].lastChild.firstChild.firstChild.childNodes;
for j:=0 to ArrayList.length -1 do
Result.Append((ArrayList[j].firstChild.firstChild as IDOMNodeEx).text);
end;
end;
end;


function TWP.newComment(BlogURL: string;
username: string;
password: string;
post_id: string;
CommentStruct: TStructArray): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('wp.newComment');
SetXMLParam(tsInt,'',@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
SetXMLParam(tsInt,post_id,@SendDoc);
SetXMLStructure(CommentStruct,@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Strings[0]
else
result := GetTypeResult('int',@RecDoc);
end
else
result :='Empty respone from blog';
LastSend := SendDoc.XML.Text;
LastReceived := RecDoc.XML.Text;
end;

function TWP.newCategory(BlogURL: string;
username: string;
password: string;
CategoryStruct: TStructArray): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('wp.newCategory');
SetXMLParam(tsInt,'',@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
SetXMLStructure(CategoryStruct,@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Text
else
result := GetTypeResult('string',@RecDoc);
end
else
result :='';
LastSend := SendDoc.XML.Text;
LastReceived := RecDoc.XML.Text;
end;

function TWP.getCategories(BlogURL: string;
username: string;
password: string): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('wp.getCategories');
SetXMLParam(tsInt,'',@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Text
else
result := RecDoc.XML.Text;
end
else
result :=''
end;


function TWP.getTags(BlogURL: string;
username: string;
password: string): string;
var SendDoc: IXMLDocument;
RecDoc: IXMLDocument;
begin
SendDoc:=GetDocument('wp.getTags');
SetXMLParam(tsInt,'',@SendDoc);
SetXMLParam(tsString,username,@SendDoc);
SetXMLParam(tsString,password,@SendDoc);
RecDoc := SendQuery(SendDoc,BlogURL);
if (RecDoc <> nil) then
begin
if RecDoc.DocumentElement.ChildNodes.FindNode('fault')<>nil then
result := ParseErrors(@RecDoc).Text
else
result := RecDoc.XML.Text;
end
else
result :=''
end;

procedure TWP.IdHTTPStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
begin
lbStatus.Caption := AStatusText;
end;

end.