22.12.2010 Livejournal XML-RPC. Часть 2
Продолжаем разговор про протокол XML-RPC применительно к блогам на livejournal.com или ЖЖ по нашему. В предыдущей публикации был создан класс TLJXmlRpc, который умел выполнять логин к ЖЖ блогу и постить текст в блог. Уже неплохо. В этой статье предлагается новая версия этого класса, которая умеет получать список постов ЖЖ блога, а также имеет методы для редактирования существующего поста или его удаления.
Код новой версии класса TLJXmlRpc:
unit ljxmlrpc;
interface
uses Classes, Windows, Dialogs, SysUtils, idHttp, JVSimpleXML;
const
type
TPostItem=class(TCollectionItem)
public
ItemId: integer;
URL: string;
Subject: string;
Date: TDateTime;
ANum: integer;
ReplyCount: integer;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
end;
TPosts=class(TCollection)
private
function ReadItem(pnIndex: Integer): TPostItem;
procedure WriteItem(pnIndex: Integer; Value: TPostItem);
public
constructor Create;
destructor Destroy; override;
property Items[pnIndex: Integer]: TPostItem read ReadItem write WriteItem;
end;
TLJXmlRpc=class
private
FUsername: string;
FPassword: string;
FLogged: boolean;
function PostXML(XML: string): string;
procedure AddBegin(XML: TStringList; Method: string);
procedure AddEnd(XML: TStringList);
procedure AddLoginInfo(XML: TStringList);
procedure AddDateInfo(XML: TStringList; Date: TDateTime);
procedure AddData(XML: TStringList; Subj,Text: string);
procedure AddTruncate(XML: TStringList; Val: integer);
procedure AddLastN(XML: TStringList);
procedure AddHowMany(XML: TStringList; Val: integer);
procedure AddNoprops(XML: TStringList);
procedure AddLineEndings(XML: TStringList);
procedure AddItemId(XML: TStringList; Val: integer);
function GetResponseStructNode: TJvSimpleXMLElem;
procedure GetStructValue(Root: TJvSimpleXMLElem; Name: string; var Val,ValType: string);
public
Posts: TPosts;
FXML: TJvSimpleXML;
constructor Create;
destructor Destroy; override;
function Login(UserName,Password: string): boolean;
function Post(Subj,Text: string; Created: TDateTime=0): integer;
function EditPost(ItemId: integer; Subj,Text: string; Created: TDateTime=0): boolean;
function DeletePost(ItemId: integer): boolean;
procedure ReadPostList(Count: integer=-1);
end;
function ToStr(Val,ValType: string): string;
implementation
function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
var
x, y, lv: Integer;
d: integer;
dl: integer;
c: byte;
p: integer;
begin
lv := Length(Value);
SetLength(Result, lv);
x := 1;
dl := 4;
d := 0;
p := 1;
while x <= lv do
begin
y := Ord(Value[x]);
if y in [33..127] then
c := Ord(Table[y - 32])
else
c := 64;
Inc(x);
if c > 63 then
continue;
d := (d shl 6) or c;
dec(dl);
if dl <> 0 then
continue;
Result[p] := AnsiChar((d shr 16) and $ff);
inc(p);
Result[p] := AnsiChar((d shr 8) and $ff);
inc(p);
Result[p] := AnsiChar(d and $ff);
inc(p);
d := 0;
dl := 4;
end;
case dl of
1:
begin
d := d shr 2;
Result[p] := AnsiChar((d shr 8) and $ff);
inc(p);
Result[p] := AnsiChar(d and $ff);
inc(p);
end;
2:
begin
d := d shr 4;
Result[p] := AnsiChar(d and $ff);
inc(p);
end;
end;
SetLength(Result, p - 1);
end;
function ToDateTime(const StrDate: string): TDateTime;
var y,m,d,h,mi: word;
begin
y:=StrToInt(Copy(StrDate,1,4));
m:=StrToInt(Copy(StrDate,6,2));
d:=StrToInt(Copy(StrDate,9,2));
h:=StrToInt(Copy(StrDate,12,2));
mi:=StrToInt(Copy(StrDate,15,2));
Result:=EncodeDate(y,m,d)+EncodeTime(h,mi,0,0);
end;
function ToStr(Val,ValType: string): string;
var XMLRequest: TStringStream; s: ansistring;
begin
if ValType='string' then Result:=Val else
if ValType='base64' then Result:=UTF8ToString(Decode4to3Ex(Val,ReTablebase64)) else
Result:='';
end;
constructor TPostItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
end;
destructor TPostItem.Destroy;
begin
inherited Destroy;
end;
constructor TPosts.Create;
begin
inherited Create(TPostItem);
end;
destructor TPosts.Destroy;
begin
inherited Destroy;
end;
function TPosts.ReadItem(pnIndex: Integer): TPostItem;
begin
Result:=TPostItem(inherited Items[pnIndex]);
end;
procedure TPosts.WriteItem(pnIndex: Integer; Value: TPostItem);
begin
Items[pnIndex].Assign(Value);
end;
constructor TLJXmlRpc.Create;
begin
inherited Create;
Posts:=TPosts.Create;
FXML:=TJvSimpleXML.Create(nil);
end;
destructor TLJXmlRpc.Destroy;
begin
Posts.Free;
FXML.Free;
inherited Destroy;
end;
function TLJXmlRpc.GetResponseStructNode: TJvSimpleXMLElem;
var Node: TJvSimpleXMLElem;
begin
Result:=nil;
Node:=FXML.Root;
if (Node.Name<>'methodResponse') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'params') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'param') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'value') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'struct') or (Node.Items.Count<2) then Exit;
Result:=Node;
end;
procedure TLJXmlRpc.GetStructValue(Root: TJvSimpleXMLElem; Name: string; var Val,ValType: string);
var Node: TJvSimpleXMLElem;
i: integer;
begin
Val:='';
ValType:='';
if (Root.Name='struct') and (Root.Items.Count>0) then
begin
for i := 0 to Root.Items.Count - 1 do
begin
Node:=Root.Items[i];
if (Node.Name='member') and (Node.Items.Count>1) then
begin
if LowerCase(Node.Items[0].Value)=LowerCase(Name) then
begin
ValType:=Node.Items[1].Items[0].Name;
Val:=Node.Items[1].Items[0].Value;
Exit;
end;
end;
end;
end;
end;
procedure TLJXmlRpc.AddBegin(XML: TStringList; Method: string);
begin
XML.Add('<methodCall>');
XML.Add('<methodName>LJ.XMLRPC.'+Method+'</methodName>');
XML.Add('<params>');
XML.Add('<param>');
XML.Add('<value><struct>');
XML.Add('<member><name>ver</name>');
XML.Add('<value><int>1</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddEnd(XML: TStringList);
begin
XML.Add('</struct></value>');
XML.Add('</param>');
XML.Add('</params>');
XML.Add('</methodCall>');
end;
procedure TLJXmlRpc.AddLoginInfo(XML: TStringList);
begin
XML.Add('<member><name>username</name>');
XML.Add('<value><string>'+FUsername+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>password</name>');
XML.Add('<value><string>'+FPassword+'</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddDateInfo(XML: TStringList; Date: TDateTime);
var y,m,d,h,mi,s,ms: word;
begin
DecodeDate(Date,y,m,d);
DecodeTime(Date,h,mi,s,ms);
XML.Add('<member><name>year</name>');
XML.Add('<value><int>'+IntToStr(y)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>mon</name>');
XML.Add('<value><int>'+IntToStr(m)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>day</name>');
XML.Add('<value><int>'+IntToStr(d)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>hour</name>');
XML.Add('<value><int>'+IntToStr(h)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>min</name>');
XML.Add('<value><int>'+IntToStr(s)+'</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddData(XML: TStringList; Subj,Text: string);
begin
XML.Add('<member><name>event</name>');
XML.Add('<value><string>'+Text+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>subject</name>');
XML.Add('<value><string>'+Subj+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>lineendings</name>');
XML.Add('<value><string>pc</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddTruncate(XML: TStringList; Val: integer);
begin
XML.Add('<member><name>truncate</name>');
XML.Add('<value><int>'+IntToStr(Val)+'</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddLastN(XML: TStringList);
begin
XML.Add('<member><name>selecttype</name>');
XML.Add('<value><string>lastn</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddHowMany(XML: TStringList; Val: integer);
begin
XML.Add('<member><name>howmany</name>');
XML.Add('<value><int>'+IntToStr(Val)+'</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddNoprops(XML: TStringList);
begin
XML.Add('<member><name>noprops</name>');
XML.Add('<value><boolean>1</boolean></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddLineEndings(XML: TStringList);
begin
XML.Add('<member><name>lineendings</name>');
XML.Add('<value><string>unix</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddItemId(XML: TStringList; Val: integer);
begin
XML.Add('<member><name>itemid</name>');
XML.Add('<value><int>'+IntToStr(Val)+'</int></value>');
XML.Add('</member>');
end;
function TLJXmlRpc.PostXML(XML: string): string;
var http: TIdHTTP;
XMLRequest: TStringStream;
begin
http:=TIdHTTP.Create(nil);
XMLRequest:=TStringStream.Create('<?xml version="1.0"?>'+XML,CP_UTF8);
try
XMLRequest.Position:=0;
Result:=http.Post('http://www.livejournal.com/interface/xmlrpc',XMLRequest);
finally
XMLRequest.Free;
http.Free;
end;
end;
function TLJXmlRpc.Login(UserName,Password: string): boolean;
var XML: TStringList;
Ret: string;
begin
FUsername:=Username;
FPassword:=Password;
XML:=TStringList.Create;
try
AddBegin(XML,'login');
AddLoginInfo(XML);
AddEnd(XML);
Ret:=PostXML(XML.Text);
if Pos('<methodResponse><fault>',Ret)=0 then FLogged:=true else
begin
FUsername:='';
FPassword:='';
FLogged:=false;
end;
Result:=FLogged;
finally
XML.Free;
end;
end;
function TLJXmlRpc.Post(Subj,Text: string; Created: TDateTime=0): integer;
var XML: TStringList;
Ret,Value,ValueType: string;
Root: TJvSimpleXMLElem;
begin
Result:=0;
if not FLogged then
raise Exception.Create('Not logged on');
XML:=TStringList.Create;
try
AddBegin(XML,'postevent');
AddLoginInfo(XML);
AddData(XML,Subj,Text);
if Created=0 then AddDateInfo(XML,Now) else AddDateInfo(XML,Created);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
if Root<>nil then
begin
GetStructValue(Root,'itemid',Value,ValueType);
if Value<>'' then
Result:=StrToInt(Value);
end;
finally
XML.Free;
end;
end;
function TLJXmlRpc.EditPost(ItemId: integer; Subj,Text: string; Created: TDateTime=0): boolean;
var XML: TStringList;
Ret,Value,ValueType: string;
Root,PostRoot: TJvSimpleXMLElem;
i,j: integer;
PostDate: TDateTime;
begin
Result:=false;
if not FLogged then
raise Exception.Create('Not logged on');
Posts.Clear;
XML:=TStringList.Create;
try
// Read post date
if Created=0 then
begin
AddBegin(XML,'getevents');
AddLoginInfo(XML);
AddTruncate(XML,20);
XML.Add('<member><name>selecttype</name>');
XML.Add('<value><string>one</string></value>');
XML.Add('</member>');
AddHowMany(XML,1);
AddItemId(XML,ItemId);
AddNoprops(XML);
AddLineEndings(XML);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
Root:=Root.Items[1];
if (Root.Name<>'member') or (Root.Items.Count<2) then Exit;
Root:=Root.Items[1];
if (Root.Name<>'value') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'array') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'data') or (Root.Items.Count=0) then Exit;
for i := 0 to Root.Items.Count - 1 do
begin
PostRoot:=Root.Items[i];
if (PostRoot.Name='value') and (PostRoot.Items.Count>0) then
begin
PostRoot:=PostRoot.Items[0];
if (PostRoot.Name='struct') and (PostRoot.Items.Count>0) then
begin
GetStructValue(PostRoot,'itemid',Value,ValueType);
j:=StrToInt(Value);
GetStructValue(PostRoot,'eventtime',Value,ValueType);
PostDate:=ToDateTime(Value);
end;
end;
end;
if j<>ItemId then
raise Exception.Create('Error reading post date');
end;
// Edit post
XML.Clear;
AddBegin(XML,'editevent');
AddLoginInfo(XML);
AddItemId(XML,ItemId);
AddData(XML,Subj,Text);
if Created=0 then AddDateInfo(XML,PostDate) else AddDateInfo(XML,Created);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
if Root<>nil then
begin
GetStructValue(Root,'itemid',Value,ValueType);
if Value<>'' then
Result:=true;
end;
finally
XML.Free;
end;
end;
function TLJXmlRpc.DeletePost(ItemId: integer): boolean;
begin
Result:=EditPost(ItemId,'','');
end;
procedure TLJXmlRpc.ReadPostList(Count: integer=-1);
var XML: TStringList;
Ret,Name,ValueType,Value: string;
i,j: integer;
Root,PostRoot,Node: TJvSimpleXMLElem;
Item: TPostItem;
begin
if not FLogged then
raise Exception.Create('Not logged on');
Posts.Clear;
XML:=TStringList.Create;
try
AddBegin(XML,'getevents');
AddLoginInfo(XML);
AddTruncate(XML,20);
AddLastN(XML);
if Count=-1 then AddHowMany(XML,99999) else AddHowMany(XML,Count);
AddNoprops(XML);
AddLineEndings(XML);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
Root:=Root.Items[1];
if (Root.Name<>'member') or (Root.Items.Count<2) then Exit;
Root:=Root.Items[1];
if (Root.Name<>'value') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'array') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'data') or (Root.Items.Count=0) then Exit;
for i := 0 to Root.Items.Count - 1 do
begin
PostRoot:=Root.Items[i];
if (PostRoot.Name='value') and (PostRoot.Items.Count>0) then
begin
PostRoot:=PostRoot.Items[0];
if (PostRoot.Name='struct') and (PostRoot.Items.Count>0) then
begin
Item:=TPostItem(Posts.Add);
GetStructValue(PostRoot,'itemid',Value,ValueType);
Item.ItemId:=StrToInt(Value);
GetStructValue(PostRoot,'anum',Value,ValueType);
Item.ANum:=StrToInt(Value);
GetStructValue(PostRoot,'reply_count',Value,ValueType);
Item.ReplyCount:=StrToInt(Value);
GetStructValue(PostRoot,'eventtime',Value,ValueType);
Item.Date:=ToDateTime(Value);
GetStructValue(PostRoot,'url',Value,ValueType);
Item.URL:=ToStr(Value,ValueType);
GetStructValue(PostRoot,'subject',Value,ValueType);
Item.Subject:=ToStr(Value,ValueType);
end;
end;
end;
finally
XML.Free;
end;
end;
end.
interface
uses Classes, Windows, Dialogs, SysUtils, idHttp, JVSimpleXML;
const
type
TPostItem=class(TCollectionItem)
public
ItemId: integer;
URL: string;
Subject: string;
Date: TDateTime;
ANum: integer;
ReplyCount: integer;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
end;
TPosts=class(TCollection)
private
function ReadItem(pnIndex: Integer): TPostItem;
procedure WriteItem(pnIndex: Integer; Value: TPostItem);
public
constructor Create;
destructor Destroy; override;
property Items[pnIndex: Integer]: TPostItem read ReadItem write WriteItem;
end;
TLJXmlRpc=class
private
FUsername: string;
FPassword: string;
FLogged: boolean;
function PostXML(XML: string): string;
procedure AddBegin(XML: TStringList; Method: string);
procedure AddEnd(XML: TStringList);
procedure AddLoginInfo(XML: TStringList);
procedure AddDateInfo(XML: TStringList; Date: TDateTime);
procedure AddData(XML: TStringList; Subj,Text: string);
procedure AddTruncate(XML: TStringList; Val: integer);
procedure AddLastN(XML: TStringList);
procedure AddHowMany(XML: TStringList; Val: integer);
procedure AddNoprops(XML: TStringList);
procedure AddLineEndings(XML: TStringList);
procedure AddItemId(XML: TStringList; Val: integer);
function GetResponseStructNode: TJvSimpleXMLElem;
procedure GetStructValue(Root: TJvSimpleXMLElem; Name: string; var Val,ValType: string);
public
Posts: TPosts;
FXML: TJvSimpleXML;
constructor Create;
destructor Destroy; override;
function Login(UserName,Password: string): boolean;
function Post(Subj,Text: string; Created: TDateTime=0): integer;
function EditPost(ItemId: integer; Subj,Text: string; Created: TDateTime=0): boolean;
function DeletePost(ItemId: integer): boolean;
procedure ReadPostList(Count: integer=-1);
end;
function ToStr(Val,ValType: string): string;
implementation
function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;
var
x, y, lv: Integer;
d: integer;
dl: integer;
c: byte;
p: integer;
begin
lv := Length(Value);
SetLength(Result, lv);
x := 1;
dl := 4;
d := 0;
p := 1;
while x <= lv do
begin
y := Ord(Value[x]);
if y in [33..127] then
c := Ord(Table[y - 32])
else
c := 64;
Inc(x);
if c > 63 then
continue;
d := (d shl 6) or c;
dec(dl);
if dl <> 0 then
continue;
Result[p] := AnsiChar((d shr 16) and $ff);
inc(p);
Result[p] := AnsiChar((d shr 8) and $ff);
inc(p);
Result[p] := AnsiChar(d and $ff);
inc(p);
d := 0;
dl := 4;
end;
case dl of
1:
begin
d := d shr 2;
Result[p] := AnsiChar((d shr 8) and $ff);
inc(p);
Result[p] := AnsiChar(d and $ff);
inc(p);
end;
2:
begin
d := d shr 4;
Result[p] := AnsiChar(d and $ff);
inc(p);
end;
end;
SetLength(Result, p - 1);
end;
function ToDateTime(const StrDate: string): TDateTime;
var y,m,d,h,mi: word;
begin
y:=StrToInt(Copy(StrDate,1,4));
m:=StrToInt(Copy(StrDate,6,2));
d:=StrToInt(Copy(StrDate,9,2));
h:=StrToInt(Copy(StrDate,12,2));
mi:=StrToInt(Copy(StrDate,15,2));
Result:=EncodeDate(y,m,d)+EncodeTime(h,mi,0,0);
end;
function ToStr(Val,ValType: string): string;
var XMLRequest: TStringStream; s: ansistring;
begin
if ValType='string' then Result:=Val else
if ValType='base64' then Result:=UTF8ToString(Decode4to3Ex(Val,ReTablebase64)) else
Result:='';
end;
constructor TPostItem.Create(Collection: TCollection);
begin
inherited Create(Collection);
end;
destructor TPostItem.Destroy;
begin
inherited Destroy;
end;
constructor TPosts.Create;
begin
inherited Create(TPostItem);
end;
destructor TPosts.Destroy;
begin
inherited Destroy;
end;
function TPosts.ReadItem(pnIndex: Integer): TPostItem;
begin
Result:=TPostItem(inherited Items[pnIndex]);
end;
procedure TPosts.WriteItem(pnIndex: Integer; Value: TPostItem);
begin
Items[pnIndex].Assign(Value);
end;
constructor TLJXmlRpc.Create;
begin
inherited Create;
Posts:=TPosts.Create;
FXML:=TJvSimpleXML.Create(nil);
end;
destructor TLJXmlRpc.Destroy;
begin
Posts.Free;
FXML.Free;
inherited Destroy;
end;
function TLJXmlRpc.GetResponseStructNode: TJvSimpleXMLElem;
var Node: TJvSimpleXMLElem;
begin
Result:=nil;
Node:=FXML.Root;
if (Node.Name<>'methodResponse') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'params') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'param') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'value') or (Node.Items.Count=0) then Exit;
Node:=Node.Items[0];
if (Node.Name<>'struct') or (Node.Items.Count<2) then Exit;
Result:=Node;
end;
procedure TLJXmlRpc.GetStructValue(Root: TJvSimpleXMLElem; Name: string; var Val,ValType: string);
var Node: TJvSimpleXMLElem;
i: integer;
begin
Val:='';
ValType:='';
if (Root.Name='struct') and (Root.Items.Count>0) then
begin
for i := 0 to Root.Items.Count - 1 do
begin
Node:=Root.Items[i];
if (Node.Name='member') and (Node.Items.Count>1) then
begin
if LowerCase(Node.Items[0].Value)=LowerCase(Name) then
begin
ValType:=Node.Items[1].Items[0].Name;
Val:=Node.Items[1].Items[0].Value;
Exit;
end;
end;
end;
end;
end;
procedure TLJXmlRpc.AddBegin(XML: TStringList; Method: string);
begin
XML.Add('<methodCall>');
XML.Add('<methodName>LJ.XMLRPC.'+Method+'</methodName>');
XML.Add('<params>');
XML.Add('<param>');
XML.Add('<value><struct>');
XML.Add('<member><name>ver</name>');
XML.Add('<value><int>1</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddEnd(XML: TStringList);
begin
XML.Add('</struct></value>');
XML.Add('</param>');
XML.Add('</params>');
XML.Add('</methodCall>');
end;
procedure TLJXmlRpc.AddLoginInfo(XML: TStringList);
begin
XML.Add('<member><name>username</name>');
XML.Add('<value><string>'+FUsername+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>password</name>');
XML.Add('<value><string>'+FPassword+'</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddDateInfo(XML: TStringList; Date: TDateTime);
var y,m,d,h,mi,s,ms: word;
begin
DecodeDate(Date,y,m,d);
DecodeTime(Date,h,mi,s,ms);
XML.Add('<member><name>year</name>');
XML.Add('<value><int>'+IntToStr(y)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>mon</name>');
XML.Add('<value><int>'+IntToStr(m)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>day</name>');
XML.Add('<value><int>'+IntToStr(d)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>hour</name>');
XML.Add('<value><int>'+IntToStr(h)+'</int></value>');
XML.Add('</member>');
XML.Add('<member><name>min</name>');
XML.Add('<value><int>'+IntToStr(s)+'</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddData(XML: TStringList; Subj,Text: string);
begin
XML.Add('<member><name>event</name>');
XML.Add('<value><string>'+Text+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>subject</name>');
XML.Add('<value><string>'+Subj+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>lineendings</name>');
XML.Add('<value><string>pc</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddTruncate(XML: TStringList; Val: integer);
begin
XML.Add('<member><name>truncate</name>');
XML.Add('<value><int>'+IntToStr(Val)+'</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddLastN(XML: TStringList);
begin
XML.Add('<member><name>selecttype</name>');
XML.Add('<value><string>lastn</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddHowMany(XML: TStringList; Val: integer);
begin
XML.Add('<member><name>howmany</name>');
XML.Add('<value><int>'+IntToStr(Val)+'</int></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddNoprops(XML: TStringList);
begin
XML.Add('<member><name>noprops</name>');
XML.Add('<value><boolean>1</boolean></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddLineEndings(XML: TStringList);
begin
XML.Add('<member><name>lineendings</name>');
XML.Add('<value><string>unix</string></value>');
XML.Add('</member>');
end;
procedure TLJXmlRpc.AddItemId(XML: TStringList; Val: integer);
begin
XML.Add('<member><name>itemid</name>');
XML.Add('<value><int>'+IntToStr(Val)+'</int></value>');
XML.Add('</member>');
end;
function TLJXmlRpc.PostXML(XML: string): string;
var http: TIdHTTP;
XMLRequest: TStringStream;
begin
http:=TIdHTTP.Create(nil);
XMLRequest:=TStringStream.Create('<?xml version="1.0"?>'+XML,CP_UTF8);
try
XMLRequest.Position:=0;
Result:=http.Post('http://www.livejournal.com/interface/xmlrpc',XMLRequest);
finally
XMLRequest.Free;
http.Free;
end;
end;
function TLJXmlRpc.Login(UserName,Password: string): boolean;
var XML: TStringList;
Ret: string;
begin
FUsername:=Username;
FPassword:=Password;
XML:=TStringList.Create;
try
AddBegin(XML,'login');
AddLoginInfo(XML);
AddEnd(XML);
Ret:=PostXML(XML.Text);
if Pos('<methodResponse><fault>',Ret)=0 then FLogged:=true else
begin
FUsername:='';
FPassword:='';
FLogged:=false;
end;
Result:=FLogged;
finally
XML.Free;
end;
end;
function TLJXmlRpc.Post(Subj,Text: string; Created: TDateTime=0): integer;
var XML: TStringList;
Ret,Value,ValueType: string;
Root: TJvSimpleXMLElem;
begin
Result:=0;
if not FLogged then
raise Exception.Create('Not logged on');
XML:=TStringList.Create;
try
AddBegin(XML,'postevent');
AddLoginInfo(XML);
AddData(XML,Subj,Text);
if Created=0 then AddDateInfo(XML,Now) else AddDateInfo(XML,Created);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
if Root<>nil then
begin
GetStructValue(Root,'itemid',Value,ValueType);
if Value<>'' then
Result:=StrToInt(Value);
end;
finally
XML.Free;
end;
end;
function TLJXmlRpc.EditPost(ItemId: integer; Subj,Text: string; Created: TDateTime=0): boolean;
var XML: TStringList;
Ret,Value,ValueType: string;
Root,PostRoot: TJvSimpleXMLElem;
i,j: integer;
PostDate: TDateTime;
begin
Result:=false;
if not FLogged then
raise Exception.Create('Not logged on');
Posts.Clear;
XML:=TStringList.Create;
try
// Read post date
if Created=0 then
begin
AddBegin(XML,'getevents');
AddLoginInfo(XML);
AddTruncate(XML,20);
XML.Add('<member><name>selecttype</name>');
XML.Add('<value><string>one</string></value>');
XML.Add('</member>');
AddHowMany(XML,1);
AddItemId(XML,ItemId);
AddNoprops(XML);
AddLineEndings(XML);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
Root:=Root.Items[1];
if (Root.Name<>'member') or (Root.Items.Count<2) then Exit;
Root:=Root.Items[1];
if (Root.Name<>'value') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'array') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'data') or (Root.Items.Count=0) then Exit;
for i := 0 to Root.Items.Count - 1 do
begin
PostRoot:=Root.Items[i];
if (PostRoot.Name='value') and (PostRoot.Items.Count>0) then
begin
PostRoot:=PostRoot.Items[0];
if (PostRoot.Name='struct') and (PostRoot.Items.Count>0) then
begin
GetStructValue(PostRoot,'itemid',Value,ValueType);
j:=StrToInt(Value);
GetStructValue(PostRoot,'eventtime',Value,ValueType);
PostDate:=ToDateTime(Value);
end;
end;
end;
if j<>ItemId then
raise Exception.Create('Error reading post date');
end;
// Edit post
XML.Clear;
AddBegin(XML,'editevent');
AddLoginInfo(XML);
AddItemId(XML,ItemId);
AddData(XML,Subj,Text);
if Created=0 then AddDateInfo(XML,PostDate) else AddDateInfo(XML,Created);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
if Root<>nil then
begin
GetStructValue(Root,'itemid',Value,ValueType);
if Value<>'' then
Result:=true;
end;
finally
XML.Free;
end;
end;
function TLJXmlRpc.DeletePost(ItemId: integer): boolean;
begin
Result:=EditPost(ItemId,'','');
end;
procedure TLJXmlRpc.ReadPostList(Count: integer=-1);
var XML: TStringList;
Ret,Name,ValueType,Value: string;
i,j: integer;
Root,PostRoot,Node: TJvSimpleXMLElem;
Item: TPostItem;
begin
if not FLogged then
raise Exception.Create('Not logged on');
Posts.Clear;
XML:=TStringList.Create;
try
AddBegin(XML,'getevents');
AddLoginInfo(XML);
AddTruncate(XML,20);
AddLastN(XML);
if Count=-1 then AddHowMany(XML,99999) else AddHowMany(XML,Count);
AddNoprops(XML);
AddLineEndings(XML);
AddEnd(XML);
Ret:=PostXML(XML.Text);
FXML.LoadFromString(Ret);
Root:=GetResponseStructNode;
Root:=Root.Items[1];
if (Root.Name<>'member') or (Root.Items.Count<2) then Exit;
Root:=Root.Items[1];
if (Root.Name<>'value') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'array') or (Root.Items.Count=0) then Exit;
Root:=Root.Items[0];
if (Root.Name<>'data') or (Root.Items.Count=0) then Exit;
for i := 0 to Root.Items.Count - 1 do
begin
PostRoot:=Root.Items[i];
if (PostRoot.Name='value') and (PostRoot.Items.Count>0) then
begin
PostRoot:=PostRoot.Items[0];
if (PostRoot.Name='struct') and (PostRoot.Items.Count>0) then
begin
Item:=TPostItem(Posts.Add);
GetStructValue(PostRoot,'itemid',Value,ValueType);
Item.ItemId:=StrToInt(Value);
GetStructValue(PostRoot,'anum',Value,ValueType);
Item.ANum:=StrToInt(Value);
GetStructValue(PostRoot,'reply_count',Value,ValueType);
Item.ReplyCount:=StrToInt(Value);
GetStructValue(PostRoot,'eventtime',Value,ValueType);
Item.Date:=ToDateTime(Value);
GetStructValue(PostRoot,'url',Value,ValueType);
Item.URL:=ToStr(Value,ValueType);
GetStructValue(PostRoot,'subject',Value,ValueType);
Item.Subject:=ToStr(Value,ValueType);
end;
end;
end;
finally
XML.Free;
end;
end;
end.
Теперь класс TLJXmlRpc имеет коллекцию Posts для хранения списка постов ЖЖ блога. Сам текст постов не считывается и не хранится, в противном случае получение такого списка может быть очень долгим. В коллекции хранится только такая информация о постах как идентификатор поста (ItemId), его URL, заголовок (Subject), дата опубликования поста (Date), порядковый номер поста (ANum), количество комментариев (ReplyCount). Этих данных вполне достаточно для работы со списком постов в ваших блог-клиентах на Delphi.
Класс TLJXmlRpc пополнился функцией Decode4to3Ex, взятой из Synapse и предназначенной для декодирования base64 строк, в которых приходят некоторые данные постов при чтении списка. Появились функции для кодирования и декодирования строкового представления даты в XML-RPC ЖЖ. И теперь используется модуль JVSimpleXML для работы с XML форматом возвращаемых ЖЖ данных.
Формирование частей XML формата XML-RPC вынесены в несколько простых функций,комментарии не требуются, если что непонятно, обратитесь к официальному описанию XML-RPC ЖЖ или задавайте вопросы в комментариях.
Метод ReadPostList считывает информацию заданного количества последних постов (по умолчанию считывается информация обо всех постах). Делается это формированием соответствующего XML запроса и разбором ответа в XML формате при помощи JVSimpleXML. Корректно обрабатываются типы данных XML-RPC и кодировка UTF-8. В дальнейшем используйте заполненную коллекцию Posts с информацией о постах ЖЖ.
Метод EditPost производит редактирование поста с заданным ItemId. Можно изменить заголовок и текст существующего поста. Перед выполнением непосредственно операции редактирования считывается информация о дате и времени публикации поста, если в параметрах метода не задана явным образом новая дата редактируемого поста. Т.е. если не задавать новую дату публикации редактируемого поста, то существующая дата не изменится в процессе редактирования.
Метод DeletePost удаляет пост с заданным ItemId. Фактически это делается вызовом метода EditPost с пустыми значениями Subject и Text. В этом случае XML-RPC API ЖЖ просто удаляет пост с заданным ItemId.
В заключение этой статьи я попытаюсь ответить на вопрос, а где можно применить класс TLJXmlRpc с его умением работать с ЖЖ по протоколу XML-RPC? Это зависит от вашей фантазии. Например, постинг в ЖЖ через XML-RPC на Delphi можно использовать для создания сетки сателлитов на ЖЖ. Что такое сателлит? Как правило это небольшой сайт, созданный для продвижения ссылочной массой основного сайта или для заработка в сети путем продажи ссылок, например в известной бирже Sape. Грамотно воспользуйтесь информацией, приведенной на этом сайте, и, возможно, вам будет обеспечен успех в заработке немалых средств в интернете. Следите за дальнейшими публикациями, я буду расширять возможности класса TLJXmlRpc новыми методами. На очереди стоит комментирование постов ЖЖ и френдинг.
Смотрите также:
Оставьте свой комментарий
Вы должны быть авторизированны, чтобы оставить комментарий.
