unit ljxmlrpc;
interface
uses Classes, Windows, Dialogs, SysUtils, idHttp;
type
TLJXmlRpc=class
private
FUsername: string;
FPassword: string;
FLogged: boolean;
function PostXML(XML: string
string;
procedure AddLoginInfo(XML: TStringList);
procedure AddVersionInfo(XML: TStringList);
procedure AddDateInfo(XML: TStringList; Date: TDateTime);
public
function Login(AUserName,APassword: string
boolean;
function Post(ASubj,AText: string; ACreated: TDateTime=0
integer;
end;
implementation
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.AddVersionInfo(XML: TStringList);
begin
XML.Add('<member><name>ver</name>');
XML.Add('<value><int>1</int></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;
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('
Для просмотра ссылки Войди или Зарегистрируйся
finally
XMLRequest.Free;
http.Free;
end;
end;
function TLJXmlRpc.Login(AUserName,APassword: string
boolean;
var XML: TStringList;
Ret: string;
begin
FUsername:=AUsername;
FPassword:=APassword;
XML:=TStringList.Create;
try
XML.Add('<methodCall>');
XML.Add('<methodName>LJ.XMLRPC.login</methodName>');
XML.Add('<params>');
XML.Add('<param>');
XML.Add('<value><struct>');
AddLoginInfo(XML);
AddVersionInfo(XML);
XML.Add('</struct></value>');
XML.Add('</param>');
XML.Add('</params>');
XML.Add('</methodCall>');
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(ASubj,AText: string; ACreated: TDateTime=0
integer;
var XML: TStringList;
Ret: string;
begin
if not FLogged then
raise Exception.Create('Not logged on');
XML:=TStringList.Create;
try
XML.Add('<methodCall>');
XML.Add('<methodName>LJ.XMLRPC.postevent</methodName>');
XML.Add('<params>');
XML.Add('<param>');
XML.Add('<value><struct>');
AddLoginInfo(XML);
AddVersionInfo(XML);
XML.Add('<member><name>event</name>');
XML.Add('<value><string>'+AText+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>subject</name>');
XML.Add('<value><string>'+ASubj+'</string></value>');
XML.Add('</member>');
XML.Add('<member><name>lineendings</name>');
XML.Add('<value><string>pc</string></value>');
XML.Add('</member>');
if ACreated=0 then AddDateInfo(XML,Now) else AddDateInfo(XML,ACreated);
XML.Add('</struct></value>');
XML.Add('</param>');
XML.Add('</params>');
XML.Add('</methodCall>');
Ret:=PostXML(XML.Text);
finally
XML.Free;
end;
end;
end.