Hola David:
Impresionante el trabajo que estas haciendo en
loturak ( yo lo puedo decir, estoy libre de toda sospecha de spam). Ya comente por aquí alguna vez que de php no se nada, así que no podía jugar con tu proyecto, loturak (¡ajá!), pero ahora que ya nos metemos en Delphi es momento de que meta un poco el dedo y espero no romper nada.
Así que poco después de publicar tu mensaje, me puse manos a la obra. Me leí por encima la ayuda sobre IXMLDocument, y me dispuse a reinventar la rueda. No lo puedo evitar, podía usar la librería que recomiendas (Delphi XML-RPC) pero así ya no es tan divertido.
Bueno, dejen sitio que estoy reinventando la rueda
Código Delphi
[-]
function SendRequest(Server, Uri: String; Port: Word;
Request: String; var Response: String): Boolean;
var
hNet: HINTERNET;
hCon: HINTERNET;
hReq: HINTERNET;
Context: DWORD;
BytesRead: DWORD;
Success: Boolean;
Buffer: array[0..1024] of Char;
begin
Context:= 0;
Result := FALSE;
hNet := InternetOpen('Agente', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if (hNet <> nil) then
begin
hCon:= InternetConnect(hNet,PChar(Server),Port,nil,nil,
INTERNET_SERVICE_HTTP,0,Context);
if (hCon <> nil) then
begin
hReq:= HttpOpenRequest(hCon,'POST',PChar(Uri),nil,nil,nil,
INTERNET_FLAG_RELOAD,Context);
if (hReq <> nil) then
begin
Success:= HttpSendRequest(hReq,
'Content-Type: text/xml',Cardinal(-1),
PChar(Request),Length(Request));
if Success then
begin
FillChar(Buffer, Sizeof(Buffer), #0);
while (InternetReadFile(hReq,@Buffer,Sizeof(Buffer)-1,BytesRead)) do
begin
if (BytesRead = 0) then
begin
Result := TRUE;
break;
end;
Response:= Response + String(PChar(@Buffer));
FillChar(Buffer, Sizeof(Buffer), #0);
end;
end;
InternetCloseHandle(hReq);
end;
InternetCloseHandle(hCon);
end;
InternetCloseHandle(hNet);
end;
end;
function InsertarEnlace(Username, Password, Url, Titulo, Etiquetas,
Descripcion: String; Privado: Boolean): String;
var
XMLDoc: IXMLDocument;
Nodo: IXMLNode;
begin
Result:= EmptyStr;
XMLDoc:= TXMLDocument.Create(nil);
with XMLDoc do
try
Active:= TRUE;
Version:= '1.0';
Options:= [doNodeAutoIndent];
Nodo:= AddChild('methodCall');
Nodo.AddChild('methodName').Text:= 'loturak.InsertarEnlace';
Nodo:= Nodo.AddChild('params');
Nodo:= Nodo.AddChild('param');
Nodo:= Nodo.AddChild('array');
Nodo:= Nodo.AddChild('data');
Nodo.AddChild('string').Text:= Username;
Nodo.AddChild('string').Text:=
LowerCase(StrCheckSum(LowerCase(StrCheckSum(Password))));
Nodo.AddChild('string').Text:= Url;
Nodo.AddChild('string').Text:= Titulo;
Nodo.AddChild('string').Text:= Etiquetas;
Nodo.AddChild('string').Text:= Descripcion;
if Privado then
Nodo.AddChild('i4').Text:= '1'
else
Nodo.AddChild('i4').Text:= '0';
Result:= XML.Text;
finally
Active:= FALSE;
XMLDoc:= nil;
end;
end;
function SendRPCRequest(Server, Uri, Request: String; Port: Word;
var Response: String; var FaultString: String): Boolean;
var
XMLDoc: IXMLDocument;
Nodo: IXMLNode;
i: integer;
begin
Result:= FALSE;
Response:= EmptyStr;
FaultString:= EmptyStr;
XMLDoc:= TXMLDocument.Create(nil);
with XMLDoc do
try
if not SendRequest(Server,Uri,80,Request,Response) then
raise Exception.Create('No puedo enviar la peticion');
XML.Text:= Response;
Active:= TRUE;
Nodo:= ChildNodes.FindNode('methodResponse');
if Nodo <> nil then
begin
Result:= TRUE;
Nodo:= Nodo.ChildNodes.FindNode('fault');
if Nodo <> nil then
begin
Result:= FALSE;
Nodo:= Nodo.ChildNodes.FindNode('value');
if Nodo <> nil then
begin
Nodo:= Nodo.ChildNodes.FindNode('struct');
if Nodo <> nil then
begin
for i:= 0 to Nodo.ChildNodes.Count - 1 do
begin
if AnsiSameText(Nodo.ChildNodes[i].NodeName,'member') then
begin
if Nodo.ChildNodes[i].ChildNodes.FindNode('name') <> nil then
if AnsiSameText(Nodo.ChildNodes[i].ChildNodes.FindNode('name').Text,'faultString') then
if Nodo.ChildNodes[i].ChildNodes.FindNode('value') <> nil then
begin
Nodo:= Nodo.ChildNodes[i].ChildNodes.FindNode('value');
if Nodo.ChildNodes.FindNode('string') <> nil then
FaultString:= Nodo.ChildNodes.FindNode('string').Text;
break;
end;
end;
end;
end;
end;
end;
end;
finally
Active:= FALSE;
XMLDoc:= nil;
end;
end;
var
Response, Request, FaultString: string;
begin
Request:= InsertarEnlace( 'usuario','contraseña','www.google.com','Probando RPC',
'Probando,RPC','Probando 1, 2, 3 ...', TRUE);
if not SendRPCRequest('www.loturak.es','/api/xmlrpc',Request,80,Response,FaultString) then
ShowMessage(FaultString);
end;
Bueno, ahí dejo esto. No es que aporte nada, pero tenia ganas de jugar un poco. Ayer poco después de colocar tu mensaje, deje de poder acceder a la pagina del club y la de loturak (¡ajá!), no se el motivo. Así que mientras esperaba probé a mandar peticiones a flickr, lo que hace el aburrimiento
Perdona que me metiera en el hilo para no aportar nada, pero como ya dije arriba el aburrimiento es muy malo.
PD: Para calcular el md5 use la siguiente unit, hecha por mi para mi mismo, así que si alguien la necesita la puede usar sin problemas.