tricks/DelphiKylix/Drupal.pas

unit Drupal;
{
This is a delphi/kylix unit to utilize the xml-rpc features of
Drupal. You will need to have Indy 9.0+ installed (www.nevrona.com/Indy/)
and the xml-rpc units for delphi/kylix (www.codepunk.com).

Note: currently untested with Kylix. Only the login function is available for now.

Questions? Comments? breyten@dataloss.nl

Changelog:
6 Nov 2002 - Initial version
8 Nov 2002 - Added Blogger API functions (untested)
}
interface

uses SysUtils, Classes, ContNrs, xmlrpctypes, xmlrpcclient;

type TDrupalBlogInfo = class(TObject)
                       private
                         FBlogName: String;
                         FUrl: String;
                         FBlogID: String;
                       public
                         constructor Create(AURL, ABlogID, ABlogName: String);
                         property URL: String read FUrl write FUrl;
                         property BlogID: String read FBlogID write FBlogID;
                         property BlogName: String read FBlogName write FBlogName;
                       end;

     TDrupalUserInfo = class(TObject)
                       private
                        FNick: String;
                        FFirstName: String;
                        FUrl: String;
                        FLastName: String;
                        FEmail: String;
                        FUserID: String;
                       public
                         constructor Create(ANick, AUserID, AURL, AEmail, AFirstName, ALastName: String);
                         property Nick: String read FNick write FNick;
                         property UserID: String read FUserID write FUserID;
                         property URL: String read FUrl write FUrl;
                         property EMail: String read FEmail write FEmail;
                         property FirstName: String read FFirstName write FFirstName;
                         property LastName: String read FLastName write FLastName;
                       end;

     TDrupalPost = class(TObject)
                   private
                     FContent: String;
                     FUserID: String;
                     FPostID: String;
                     FDateCreated: TDateTime;
                   public
                     constructor Create(const AUserID: String; const ADateCreated: TDateTime; const AContent, APostID: String);
                     property UserID: String read FUserID write FUserID;
                     property DateCreated: TDateTime read FDateCreated write FDateCreated;
                     property Content: String read FContent write FContent;
                     property PostID: String read FPostID write FPostID;
                   end;

     TDrupal = class(TObject)
               private
                 FPort: Integer;
                 FHostName: String;
                 FEndPoint: String;
                 FModified: Boolean;
                 FAppKey: String;
                 FUserName: String;
                 FPassword: String;
                 procedure SetEndPoint(const Value: String);
                 procedure SetHostName(const Value: String);
                 procedure SetPort(const Value: Integer);
                 procedure SetAppKey(const Value: String);
                 procedure SetPassword(const Value: String);
                 procedure SetUserName(const Value: String);
               public
                 constructor Create;
                 { -- generic functions --- }
                 function GetCaller: TCaller; virtual;
                 function GetFunction(const AFuncName: String): TFunction; virtual;
                 { -- login to remote drupal site --- }
                 function Login(AUserName: String = ''; APassword: String = ''): Integer; virtual;
                 { -- blogger api functions --- }
                 function blNewPost(const ABlogID, AContent: String; const APublish: Boolean): String; virtual;
                 function blEditPost(const APostID, AContent: String; const APublish: Boolean): Boolean; virtual;
                 function blDeletePost(const APostID: String; const APublish: Boolean): Boolean; virtual;
                 // remember to free the returned struct
                 function blGetPost(const APostID: String): TDrupalPost; virtual;
                 // remember to free the returned struct
                 function blGetRecentPosts(const ABlogID: String; const ANumPosts: Integer): TObjectList;
                 // remember to free the TObjectList
                 function blGetUsersBlogs: TObjectList; virtual;
                 // remember to free the TDrupalUserInfo
                 function blGetUserInfo: TDrupalUserInfo; virtual;
                 // template functions
                 function blGetTemplate(const ABlogID, ATemplateType: String): String; virtual;
                 function blSetTemplate(const ABlogID, ATemplateType, ATemplate: String): Boolean; virtual;
                 { -- properties -- }
                 property HostName: String read FHostName write SetHostName;
                 property EndPoint: String read FEndPoint write SetEndPoint;
                 property Port: Integer read FPort write SetPort;
                 property AppKey: String read FAppKey write SetAppKey;
                 property UserName: String read FUserName write SetUserName;
                 property Password: String read FPassword write SetPassword;
               end;

     EDrupalException = class(Exception);

     EDrupalNoHostName = class(EDrupalException);
     EDrupalNoEndPoint = class(EDrupalException);
     EDrupalNoPort = class(EDrupalException);
     EDrupalLoginError = class(EDrupalException);
     EDrupalGenericXMLRPCError = class(EDrupalException);
     EDrupalNoAppkey = class(EDrupalException);
     EDrupalNoUserNameOrPassword = class(EDrupalException);
     EDrupalNoContent = class(EDrupalException);
     EDrupalNoBlogID = class(EDrupalException);
     EDrupalNoPostID = class(EDrupalException);
     EDrupalNoTemplateType = class(EDrupalException);
     EDrupalNoTemplate = class(EDrupalException);
     EDrupalNoNumRecentPosts = class(EDrupalException);
     
implementation

{ TDrupal }

function TDrupal.blDeletePost(const APostID: String;
  const APublish: Boolean): Boolean;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  if APostID = '' then
    Raise EDrupalNoPostID.Create('No post id specified !');

  Result := False;
  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.deletePost');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(APostID);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      Afunction.AddParam(APublish);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
          Result := AResult.GetBoolean
        else
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blEditPost(const APostID, AContent: String;
  const APublish: Boolean): Boolean;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  if APostID = '' then
    Raise EDrupalNoPostID.Create('No post id specified !');

  if AContent = '' then
    Raise EDrupalNoContent.Create('No content !');

  Result := False;
  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.editPost');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(APostID);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AFunction.AddParam(AContent);
      Afunction.AddParam(APublish);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
          Result := AResult.GetBoolean
        else
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blGetPost(const APostID: String): TDrupalPost;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
    P: TStruct;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  if APostID = '' then
    Raise EDrupalNoPostID.Create('No post id specified !');

  Result := nil;
  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.getPost');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(APostID);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
        begin
          P := AResult.GetStruct;
          Result := TDrupalPost.Create(P.GetString('userid'), P.GetDate('dateCreated'), P.GetString('content'), P.GetString('postid'));
        end
        else
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blGetRecentPosts(const ABlogID: String;
  const ANumPosts: Integer): TObjectList;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
    P: TStruct;
    I: Integer;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  if ABlogID = '' then
    Raise EDrupalNoBlogID.Create('No blog id specified !');

  if ANumPosts = 0 then
    Raise EDrupalNoNumRecentPosts.Create('No number of recent posts specified !');

  Result := TObjecTList.Create(True);
  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.getPost');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(ABlogID);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AFunction.AddParam(ANumPosts);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
        begin
          for I := 0 to ANumPosts-1 do
          begin
            P := AResult.GetArray.GetStruct(I);
            Result.Add(TDrupalPost.Create(P.GetString('userid'), P.GetDate('dateCreated'), P.GetString('content'), P.GetString('postid')));
          end;
        end
        else
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blGetTemplate(const ABlogID,
  ATemplateType: String): String;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  if ABlogID = '' then
    Raise EDrupalNoBlogID.Create('No blog id specified !');

  if ATemplateType = '' then
    Raise EDrupalNoTemplateType.Create('No template specified !');

  if (ATemplateType <> 'main') and (ATemplateType <> 'archiveIndex') then
    Raise EDrupalNoTemplateType.Create('Wrong template type specified !');

  Result := '';
  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.getTemplate');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(ABlogID);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AFunction.AddParam(ATemplateType);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
          Result := AResult.GetString
        else
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blGetUserInfo: TDrupalUserInfo;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
    P: TStruct;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  Result := Nil;
  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.getUserInfo');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
        begin
          P := AResult.GetStruct;
          Result := TDrupalUserInfo.Create(P.GetString('nickname'), P.GetString('userid'), P.GetString('url'), P.GetString('email'), P.GetString('lastname'), P.GetString('firstname'));
        end
        else
        begin
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
        end;
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blGetUsersBlogs: TObjectList;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
    I: Integer;
    P: TStruct;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  Result := TObjectList.Create(True);

  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.getUsersBlogs');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
        begin
          if AResult.IsArray then
          begin
            for I := 0 to AResult.GetArray.Count-1 do
            begin
              P := AResult.GetArray.GetStruct(I);
              Result.Add(TDrupalBlogInfo.Create(P.GetString('url'), P.GetString('blogid'), P.GetString('blogName')));
            end;
          end;
        end
        else
        begin
          FreeAndNil(Result);
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
        end;
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blNewPost(const ABlogID, AContent: String;
  const APublish: Boolean): String;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  if ABlogID = '' then
    Raise EDrupalNoBlogID.Create('No blog id specified !');

  if AContent = '' then
    Raise EDrupalNoContent.Create('No content !');

  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.newPost');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(ABlogID);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AFunction.AddParam(AContent);
      Afunction.AddParam(APublish);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
          Result := AResult.GetString
        else
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

function TDrupal.blSetTemplate(const ABlogID, ATemplateType,
  ATemplate: String): Boolean;
var ACaller: TCaller;
    Afunction: TFunction;
    AResult : TResult;
begin
  if FAppKey = '' then
    Raise EDrupalNoAppKey.Create('No Appkey specified !');

  if (FPassword = '') or (FUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  if ABlogID = '' then
    Raise EDrupalNoBlogID.Create('No blog id specified !');

  if ATemplateType = '' then
    Raise EDrupalNoTemplateType.Create('No template specified !');

  if (ATemplateType <> 'main') and (ATemplateType <> 'archiveIndex') then
    Raise EDrupalNoTemplateType.Create('Wrong template type specified !');

  if ATemplate = '' then
    Raise EDrupalNoTemplate.Create('No contents in template !');

  Result := False;
  ACaller := GetCaller;
  try
    AFunction := GetFunction('blogger.setTemplate');
    try
      AFunction.AddParam(FAppKey);
      AFunction.AddParam(ABlogID);
      AFunction.AddParam(FUserName);
      AFunction.AddParam(FPassword);
      AFunction.AddParam(ATemplate);
      AFunction.AddParam(ATemplateType);
      AResult := ACaller.Execute(AFunction);
      try
        if not AResult.IsError then
          Result := AResult.GetBoolean
        else
          Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

constructor TDrupal.Create;
begin
  FHostName := '';
  FEndPoint := '';
  FPort := 80;
  FModified := False;
end;

function TDrupal.GetCaller: TCaller;
begin
  if FHostName = '' then
    Raise EDrupalNoHostName.Create('No hostname specified !');
  if FEndPoint = '' then
    Raise EDrupalNoEndPoint.Create('No endpoint defined !');
  if FPort = 0 then
    Raise EDrupalNoPort.Create('No port defined !');
  Result := TCaller.Create;
  Result.HostName := FHostName;
  Result.HostPort := FPort;
  Result.EndPoint := FEndPoint;
end;

function TDrupal.GetFunction(const AFuncName: String): TFunction;
begin
  Result := TFunction.Create;
  Result.ObjectMethod := AFuncName;
end;

function TDrupal.Login(AUserName: String = ''; APassword: String = ''): Integer;
var ACaller: TCaller;
    AFunction: TFunction;
    AResult: TResult;
begin
  Result := 0;

  if AUserName = '' then
    AUserName := FUserName;
  if APassword = '' then
    APassword := FPassword;
  if (APassword = '') or (AUserName = '') then
    Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');

  ACaller := GetCaller;
  try
    AFunction := GetFunction('drupal.login');
    try
      AFunction.AddParam(AUserName);
      AFunction.AddParam(APassword);
      AResult := ACaller.Execute(AFunction);
      try
        if AResult.IsError then
          Raise EDrupalGenericXMLRPCError.Create('XML-RPC error : '+AResult.GetErrorString)
        else
        begin
          if AResult.GetInteger = 0 then
            Raise EDrupalLoginError.Create('Wrong username and/or password !')
          else
            Result := AResult.GetInteger;
        end;
      finally
        AResult.Free;
      end;
    finally
      AFunction.Free;
    end;
  finally
    ACaller.Free;
  end;
end;

procedure TDrupal.SetAppKey(const Value: String);
begin
  if FAppKey <> Value then
  begin
    FAppKey := Value;
    FModified := True;
  end;
end;

procedure TDrupal.SetEndPoint(const Value: String);
begin
  if (Value <> FEndPoint) then
  begin
    FEndPoint := Value;
    FModified := True;
  end;
end;

procedure TDrupal.SetHostName(const Value: String);
begin
  if (Value <> FHostName) then
  begin
    FHostName := Value;
    FModified := True;
  end;
end;

procedure TDrupal.SetPassword(const Value: String);
begin
  if FPassword <> Value then
  begin
    FPassword := Value;
    FModified := True;
  end;
end;

procedure TDrupal.SetPort(const Value: Integer);
begin
  if (FPort <> Value) then
  begin
    FPort := Value;
    FModified := True;
  end;
end;

procedure TDrupal.SetUserName(const Value: String);
begin
  if FUserName <> Value then
  begin
    FUserName := Value;
    FModified := True;
  end;
end;

{ TDrupalBlogInfo }

constructor TDrupalBlogInfo.Create(AURL, ABlogID, ABlogName: String);
begin
  FUrl := AURL;
  FBlogID := ABlogID;
  FBlogName := ABlogName;
end;

{ TDrupalUserInfo }

constructor TDrupalUserInfo.Create(ANick, AUserID, AURL, AEmail,
  AFirstName, ALastName: String);
begin
  Nick := ANick;
  UserID := AUserID;
  URL := AURL;
  EMail := AEmail;
  FirstName := AFirstName;
  LastName := ALastName;
end;

{ TDrupalPost }

constructor TDrupalPost.Create(const AUserID: String;
  const ADateCreated: TDateTime; const AContent, APostID: String);
begin
  FUserID := AUserID;
  FDateCreated := ADateCreated;
  FContent := AContent;
  FPostID := APostID;
end;

end.
1	unit Drupal;
2	{
3	This is a delphi/kylix unit to utilize the xml-rpc features of
4	Drupal. You will need to have Indy 9.0+ installed (www.nevrona.com/Indy/)
5	and the xml-rpc units for delphi/kylix (www.codepunk.com).
6
7	Note: currently untested with Kylix. Only the login function is available for now.
8
9	Questions? Comments? breyten@dataloss.nl
10
11	Changelog:
12	6 Nov 2002 - Initial version
13	8 Nov 2002 - Added Blogger API functions (untested)
14	}
15	interface
16
17	uses SysUtils, Classes, ContNrs, xmlrpctypes, xmlrpcclient;
18
19	type TDrupalBlogInfo = class(TObject)
20	private
21	FBlogName: String;
22	FUrl: String;
23	FBlogID: String;
24	public
25	constructor Create(AURL, ABlogID, ABlogName: String);
26	property URL: String read FUrl write FUrl;
27	property BlogID: String read FBlogID write FBlogID;
28	property BlogName: String read FBlogName write FBlogName;
29	end;
30
31	TDrupalUserInfo = class(TObject)
32	private
33	FNick: String;
34	FFirstName: String;
35	FUrl: String;
36	FLastName: String;
37	FEmail: String;
38	FUserID: String;
39	public
40	constructor Create(ANick, AUserID, AURL, AEmail, AFirstName, ALastName: String);
41	property Nick: String read FNick write FNick;
42	property UserID: String read FUserID write FUserID;
43	property URL: String read FUrl write FUrl;
44	property EMail: String read FEmail write FEmail;
45	property FirstName: String read FFirstName write FFirstName;
46	property LastName: String read FLastName write FLastName;
47	end;
48
49	TDrupalPost = class(TObject)
50	private
51	FContent: String;
52	FUserID: String;
53	FPostID: String;
54	FDateCreated: TDateTime;
55	public
56	constructor Create(const AUserID: String; const ADateCreated: TDateTime; const AContent, APostID: String);
57	property UserID: String read FUserID write FUserID;
58	property DateCreated: TDateTime read FDateCreated write FDateCreated;
59	property Content: String read FContent write FContent;
60	property PostID: String read FPostID write FPostID;
61	end;
62
63	TDrupal = class(TObject)
64	private
65	FPort: Integer;
66	FHostName: String;
67	FEndPoint: String;
68	FModified: Boolean;
69	FAppKey: String;
70	FUserName: String;
71	FPassword: String;
72	procedure SetEndPoint(const Value: String);
73	procedure SetHostName(const Value: String);
74	procedure SetPort(const Value: Integer);
75	procedure SetAppKey(const Value: String);
76	procedure SetPassword(const Value: String);
77	procedure SetUserName(const Value: String);
78	public
79	constructor Create;
80	{ -- generic functions --- }
81	function GetCaller: TCaller; virtual;
82	function GetFunction(const AFuncName: String): TFunction; virtual;
83	{ -- login to remote drupal site --- }
84	function Login(AUserName: String = ''; APassword: String = ''): Integer; virtual;
85	{ -- blogger api functions --- }
86	function blNewPost(const ABlogID, AContent: String; const APublish: Boolean): String; virtual;
87	function blEditPost(const APostID, AContent: String; const APublish: Boolean): Boolean; virtual;
88	function blDeletePost(const APostID: String; const APublish: Boolean): Boolean; virtual;
89	// remember to free the returned struct
90	function blGetPost(const APostID: String): TDrupalPost; virtual;
91	// remember to free the returned struct
92	function blGetRecentPosts(const ABlogID: String; const ANumPosts: Integer): TObjectList;
93	// remember to free the TObjectList
94	function blGetUsersBlogs: TObjectList; virtual;
95	// remember to free the TDrupalUserInfo
96	function blGetUserInfo: TDrupalUserInfo; virtual;
97	// template functions
98	function blGetTemplate(const ABlogID, ATemplateType: String): String; virtual;
99	function blSetTemplate(const ABlogID, ATemplateType, ATemplate: String): Boolean; virtual;
100	{ -- properties -- }
101	property HostName: String read FHostName write SetHostName;
102	property EndPoint: String read FEndPoint write SetEndPoint;
103	property Port: Integer read FPort write SetPort;
104	property AppKey: String read FAppKey write SetAppKey;
105	property UserName: String read FUserName write SetUserName;
106	property Password: String read FPassword write SetPassword;
107	end;
108
109	EDrupalException = class(Exception);
110
111	EDrupalNoHostName = class(EDrupalException);
112	EDrupalNoEndPoint = class(EDrupalException);
113	EDrupalNoPort = class(EDrupalException);
114	EDrupalLoginError = class(EDrupalException);
115	EDrupalGenericXMLRPCError = class(EDrupalException);
116	EDrupalNoAppkey = class(EDrupalException);
117	EDrupalNoUserNameOrPassword = class(EDrupalException);
118	EDrupalNoContent = class(EDrupalException);
119	EDrupalNoBlogID = class(EDrupalException);
120	EDrupalNoPostID = class(EDrupalException);
121	EDrupalNoTemplateType = class(EDrupalException);
122	EDrupalNoTemplate = class(EDrupalException);
123	EDrupalNoNumRecentPosts = class(EDrupalException);
124
125	implementation
126
127	{ TDrupal }
128
129	function TDrupal.blDeletePost(const APostID: String;
130	const APublish: Boolean): Boolean;
131	var ACaller: TCaller;
132	Afunction: TFunction;
133	AResult : TResult;
134	begin
135	if FAppKey = '' then
136	Raise EDrupalNoAppKey.Create('No Appkey specified !');
137
138	if (FPassword = '') or (FUserName = '') then
139	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
140
141	if APostID = '' then
142	Raise EDrupalNoPostID.Create('No post id specified !');
143
144	Result := False;
145	ACaller := GetCaller;
146	try
147	AFunction := GetFunction('blogger.deletePost');
148	try
149	AFunction.AddParam(FAppKey);
150	AFunction.AddParam(APostID);
151	AFunction.AddParam(FUserName);
152	AFunction.AddParam(FPassword);
153	Afunction.AddParam(APublish);
154	AResult := ACaller.Execute(AFunction);
155	try
156	if not AResult.IsError then
157	Result := AResult.GetBoolean
158	else
159	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
160	finally
161	AResult.Free;
162	end;
163	finally
164	AFunction.Free;
165	end;
166	finally
167	ACaller.Free;
168	end;
169	end;
170
171	function TDrupal.blEditPost(const APostID, AContent: String;
172	const APublish: Boolean): Boolean;
173	var ACaller: TCaller;
174	Afunction: TFunction;
175	AResult : TResult;
176	begin
177	if FAppKey = '' then
178	Raise EDrupalNoAppKey.Create('No Appkey specified !');
179
180	if (FPassword = '') or (FUserName = '') then
181	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
182
183	if APostID = '' then
184	Raise EDrupalNoPostID.Create('No post id specified !');
185
186	if AContent = '' then
187	Raise EDrupalNoContent.Create('No content !');
188
189	Result := False;
190	ACaller := GetCaller;
191	try
192	AFunction := GetFunction('blogger.editPost');
193	try
194	AFunction.AddParam(FAppKey);
195	AFunction.AddParam(APostID);
196	AFunction.AddParam(FUserName);
197	AFunction.AddParam(FPassword);
198	AFunction.AddParam(AContent);
199	Afunction.AddParam(APublish);
200	AResult := ACaller.Execute(AFunction);
201	try
202	if not AResult.IsError then
203	Result := AResult.GetBoolean
204	else
205	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
206	finally
207	AResult.Free;
208	end;
209	finally
210	AFunction.Free;
211	end;
212	finally
213	ACaller.Free;
214	end;
215	end;
216
217	function TDrupal.blGetPost(const APostID: String): TDrupalPost;
218	var ACaller: TCaller;
219	Afunction: TFunction;
220	AResult : TResult;
221	P: TStruct;
222	begin
223	if FAppKey = '' then
224	Raise EDrupalNoAppKey.Create('No Appkey specified !');
225
226	if (FPassword = '') or (FUserName = '') then
227	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
228
229	if APostID = '' then
230	Raise EDrupalNoPostID.Create('No post id specified !');
231
232	Result := nil;
233	ACaller := GetCaller;
234	try
235	AFunction := GetFunction('blogger.getPost');
236	try
237	AFunction.AddParam(FAppKey);
238	AFunction.AddParam(APostID);
239	AFunction.AddParam(FUserName);
240	AFunction.AddParam(FPassword);
241	AResult := ACaller.Execute(AFunction);
242	try
243	if not AResult.IsError then
244	begin
245	P := AResult.GetStruct;
246	Result := TDrupalPost.Create(P.GetString('userid'), P.GetDate('dateCreated'), P.GetString('content'), P.GetString('postid'));
247	end
248	else
249	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
250	finally
251	AResult.Free;
252	end;
253	finally
254	AFunction.Free;
255	end;
256	finally
257	ACaller.Free;
258	end;
259	end;
260
261	function TDrupal.blGetRecentPosts(const ABlogID: String;
262	const ANumPosts: Integer): TObjectList;
263	var ACaller: TCaller;
264	Afunction: TFunction;
265	AResult : TResult;
266	P: TStruct;
267	I: Integer;
268	begin
269	if FAppKey = '' then
270	Raise EDrupalNoAppKey.Create('No Appkey specified !');
271
272	if (FPassword = '') or (FUserName = '') then
273	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
274
275	if ABlogID = '' then
276	Raise EDrupalNoBlogID.Create('No blog id specified !');
277
278	if ANumPosts = 0 then
279	Raise EDrupalNoNumRecentPosts.Create('No number of recent posts specified !');
280
281	Result := TObjecTList.Create(True);
282	ACaller := GetCaller;
283	try
284	AFunction := GetFunction('blogger.getPost');
285	try
286	AFunction.AddParam(FAppKey);
287	AFunction.AddParam(ABlogID);
288	AFunction.AddParam(FUserName);
289	AFunction.AddParam(FPassword);
290	AFunction.AddParam(ANumPosts);
291	AResult := ACaller.Execute(AFunction);
292	try
293	if not AResult.IsError then
294	begin
295	for I := 0 to ANumPosts-1 do
296	begin
297	P := AResult.GetArray.GetStruct(I);
298	Result.Add(TDrupalPost.Create(P.GetString('userid'), P.GetDate('dateCreated'), P.GetString('content'), P.GetString('postid')));
299	end;
300	end
301	else
302	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
303	finally
304	AResult.Free;
305	end;
306	finally
307	AFunction.Free;
308	end;
309	finally
310	ACaller.Free;
311	end;
312	end;
313
314	function TDrupal.blGetTemplate(const ABlogID,
315	ATemplateType: String): String;
316	var ACaller: TCaller;
317	Afunction: TFunction;
318	AResult : TResult;
319	begin
320	if FAppKey = '' then
321	Raise EDrupalNoAppKey.Create('No Appkey specified !');
322
323	if (FPassword = '') or (FUserName = '') then
324	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
325
326	if ABlogID = '' then
327	Raise EDrupalNoBlogID.Create('No blog id specified !');
328
329	if ATemplateType = '' then
330	Raise EDrupalNoTemplateType.Create('No template specified !');
331
332	if (ATemplateType <> 'main') and (ATemplateType <> 'archiveIndex') then
333	Raise EDrupalNoTemplateType.Create('Wrong template type specified !');
334
335	Result := '';
336	ACaller := GetCaller;
337	try
338	AFunction := GetFunction('blogger.getTemplate');
339	try
340	AFunction.AddParam(FAppKey);
341	AFunction.AddParam(ABlogID);
342	AFunction.AddParam(FUserName);
343	AFunction.AddParam(FPassword);
344	AFunction.AddParam(ATemplateType);
345	AResult := ACaller.Execute(AFunction);
346	try
347	if not AResult.IsError then
348	Result := AResult.GetString
349	else
350	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
351	finally
352	AResult.Free;
353	end;
354	finally
355	AFunction.Free;
356	end;
357	finally
358	ACaller.Free;
359	end;
360	end;
361
362	function TDrupal.blGetUserInfo: TDrupalUserInfo;
363	var ACaller: TCaller;
364	Afunction: TFunction;
365	AResult : TResult;
366	P: TStruct;
367	begin
368	if FAppKey = '' then
369	Raise EDrupalNoAppKey.Create('No Appkey specified !');
370
371	if (FPassword = '') or (FUserName = '') then
372	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
373
374	Result := Nil;
375	ACaller := GetCaller;
376	try
377	AFunction := GetFunction('blogger.getUserInfo');
378	try
379	AFunction.AddParam(FAppKey);
380	AFunction.AddParam(FUserName);
381	AFunction.AddParam(FPassword);
382	AResult := ACaller.Execute(AFunction);
383	try
384	if not AResult.IsError then
385	begin
386	P := AResult.GetStruct;
387	Result := TDrupalUserInfo.Create(P.GetString('nickname'), P.GetString('userid'), P.GetString('url'), P.GetString('email'), P.GetString('lastname'), P.GetString('firstname'));
388	end
389	else
390	begin
391	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
392	end;
393	finally
394	AResult.Free;
395	end;
396	finally
397	AFunction.Free;
398	end;
399	finally
400	ACaller.Free;
401	end;
402	end;
403
404	function TDrupal.blGetUsersBlogs: TObjectList;
405	var ACaller: TCaller;
406	Afunction: TFunction;
407	AResult : TResult;
408	I: Integer;
409	P: TStruct;
410	begin
411	if FAppKey = '' then
412	Raise EDrupalNoAppKey.Create('No Appkey specified !');
413
414	if (FPassword = '') or (FUserName = '') then
415	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
416
417	Result := TObjectList.Create(True);
418
419	ACaller := GetCaller;
420	try
421	AFunction := GetFunction('blogger.getUsersBlogs');
422	try
423	AFunction.AddParam(FAppKey);
424	AFunction.AddParam(FUserName);
425	AFunction.AddParam(FPassword);
426	AResult := ACaller.Execute(AFunction);
427	try
428	if not AResult.IsError then
429	begin
430	if AResult.IsArray then
431	begin
432	for I := 0 to AResult.GetArray.Count-1 do
433	begin
434	P := AResult.GetArray.GetStruct(I);
435	Result.Add(TDrupalBlogInfo.Create(P.GetString('url'), P.GetString('blogid'), P.GetString('blogName')));
436	end;
437	end;
438	end
439	else
440	begin
441	FreeAndNil(Result);
442	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
443	end;
444	finally
445	AResult.Free;
446	end;
447	finally
448	AFunction.Free;
449	end;
450	finally
451	ACaller.Free;
452	end;
453	end;
454
455	function TDrupal.blNewPost(const ABlogID, AContent: String;
456	const APublish: Boolean): String;
457	var ACaller: TCaller;
458	Afunction: TFunction;
459	AResult : TResult;
460	begin
461	if FAppKey = '' then
462	Raise EDrupalNoAppKey.Create('No Appkey specified !');
463
464	if (FPassword = '') or (FUserName = '') then
465	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
466
467	if ABlogID = '' then
468	Raise EDrupalNoBlogID.Create('No blog id specified !');
469
470	if AContent = '' then
471	Raise EDrupalNoContent.Create('No content !');
472
473	ACaller := GetCaller;
474	try
475	AFunction := GetFunction('blogger.newPost');
476	try
477	AFunction.AddParam(FAppKey);
478	AFunction.AddParam(ABlogID);
479	AFunction.AddParam(FUserName);
480	AFunction.AddParam(FPassword);
481	AFunction.AddParam(AContent);
482	Afunction.AddParam(APublish);
483	AResult := ACaller.Execute(AFunction);
484	try
485	if not AResult.IsError then
486	Result := AResult.GetString
487	else
488	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
489	finally
490	AResult.Free;
491	end;
492	finally
493	AFunction.Free;
494	end;
495	finally
496	ACaller.Free;
497	end;
498	end;
499
500	function TDrupal.blSetTemplate(const ABlogID, ATemplateType,
501	ATemplate: String): Boolean;
502	var ACaller: TCaller;
503	Afunction: TFunction;
504	AResult : TResult;
505	begin
506	if FAppKey = '' then
507	Raise EDrupalNoAppKey.Create('No Appkey specified !');
508
509	if (FPassword = '') or (FUserName = '') then
510	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
511
512	if ABlogID = '' then
513	Raise EDrupalNoBlogID.Create('No blog id specified !');
514
515	if ATemplateType = '' then
516	Raise EDrupalNoTemplateType.Create('No template specified !');
517
518	if (ATemplateType <> 'main') and (ATemplateType <> 'archiveIndex') then
519	Raise EDrupalNoTemplateType.Create('Wrong template type specified !');
520
521	if ATemplate = '' then
522	Raise EDrupalNoTemplate.Create('No contents in template !');
523
524	Result := False;
525	ACaller := GetCaller;
526	try
527	AFunction := GetFunction('blogger.setTemplate');
528	try
529	AFunction.AddParam(FAppKey);
530	AFunction.AddParam(ABlogID);
531	AFunction.AddParam(FUserName);
532	AFunction.AddParam(FPassword);
533	AFunction.AddParam(ATemplate);
534	AFunction.AddParam(ATemplateType);
535	AResult := ACaller.Execute(AFunction);
536	try
537	if not AResult.IsError then
538	Result := AResult.GetBoolean
539	else
540	Raise EDrupalGenericXMLRPCError.Create(IntToStr(AResult.GetErrorCode) + ' / ' +AResult.GetErrorString);
541	finally
542	AResult.Free;
543	end;
544	finally
545	AFunction.Free;
546	end;
547	finally
548	ACaller.Free;
549	end;
550	end;
551
552	constructor TDrupal.Create;
553	begin
554	FHostName := '';
555	FEndPoint := '';
556	FPort := 80;
557	FModified := False;
558	end;
559
560	function TDrupal.GetCaller: TCaller;
561	begin
562	if FHostName = '' then
563	Raise EDrupalNoHostName.Create('No hostname specified !');
564	if FEndPoint = '' then
565	Raise EDrupalNoEndPoint.Create('No endpoint defined !');
566	if FPort = 0 then
567	Raise EDrupalNoPort.Create('No port defined !');
568	Result := TCaller.Create;
569	Result.HostName := FHostName;
570	Result.HostPort := FPort;
571	Result.EndPoint := FEndPoint;
572	end;
573
574	function TDrupal.GetFunction(const AFuncName: String): TFunction;
575	begin
576	Result := TFunction.Create;
577	Result.ObjectMethod := AFuncName;
578	end;
579
580	function TDrupal.Login(AUserName: String = ''; APassword: String = ''): Integer;
581	var ACaller: TCaller;
582	AFunction: TFunction;
583	AResult: TResult;
584	begin
585	Result := 0;
586
587	if AUserName = '' then
588	AUserName := FUserName;
589	if APassword = '' then
590	APassword := FPassword;
591	if (APassword = '') or (AUserName = '') then
592	Raise EDrupalNoUserNameOrPassword.Create('No username and/or password specified !');
593
594	ACaller := GetCaller;
595	try
596	AFunction := GetFunction('drupal.login');
597	try
598	AFunction.AddParam(AUserName);
599	AFunction.AddParam(APassword);
600	AResult := ACaller.Execute(AFunction);
601	try
602	if AResult.IsError then
603	Raise EDrupalGenericXMLRPCError.Create('XML-RPC error : '+AResult.GetErrorString)
604	else
605	begin
606	if AResult.GetInteger = 0 then
607	Raise EDrupalLoginError.Create('Wrong username and/or password !')
608	else
609	Result := AResult.GetInteger;
610	end;
611	finally
612	AResult.Free;
613	end;
614	finally
615	AFunction.Free;
616	end;
617	finally
618	ACaller.Free;
619	end;
620	end;
621
622	procedure TDrupal.SetAppKey(const Value: String);
623	begin
624	if FAppKey <> Value then
625	begin
626	FAppKey := Value;
627	FModified := True;
628	end;
629	end;
630
631	procedure TDrupal.SetEndPoint(const Value: String);
632	begin
633	if (Value <> FEndPoint) then
634	begin
635	FEndPoint := Value;
636	FModified := True;
637	end;
638	end;
639
640	procedure TDrupal.SetHostName(const Value: String);
641	begin
642	if (Value <> FHostName) then
643	begin
644	FHostName := Value;
645	FModified := True;
646	end;
647	end;
648
649	procedure TDrupal.SetPassword(const Value: String);
650	begin
651	if FPassword <> Value then
652	begin
653	FPassword := Value;
654	FModified := True;
655	end;
656	end;
657
658	procedure TDrupal.SetPort(const Value: Integer);
659	begin
660	if (FPort <> Value) then
661	begin
662	FPort := Value;
663	FModified := True;
664	end;
665	end;
666
667	procedure TDrupal.SetUserName(const Value: String);
668	begin
669	if FUserName <> Value then
670	begin
671	FUserName := Value;
672	FModified := True;
673	end;
674	end;
675
676	{ TDrupalBlogInfo }
677
678	constructor TDrupalBlogInfo.Create(AURL, ABlogID, ABlogName: String);
679	begin
680	FUrl := AURL;
681	FBlogID := ABlogID;
682	FBlogName := ABlogName;
683	end;
684
685	{ TDrupalUserInfo }
686
687	constructor TDrupalUserInfo.Create(ANick, AUserID, AURL, AEmail,
688	AFirstName, ALastName: String);
689	begin
690	Nick := ANick;
691	UserID := AUserID;
692	URL := AURL;
693	EMail := AEmail;
694	FirstName := AFirstName;
695	LastName := ALastName;
696	end;
697
698	{ TDrupalPost }
699
700	constructor TDrupalPost.Create(const AUserID: String;
701	const ADateCreated: TDateTime; const AContent, APostID: String);
702	begin
703	FUserID := AUserID;
704	FDateCreated := ADateCreated;
705	FContent := AContent;
706	FPostID := APostID;
707	end;
708
709	end.