Vuestra opinión sobre el API XML-RPC de una aplicación

[[seoane]]

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 [-]
// Primero necesitamos poder hacer post
// y por supuesto lo haremos con WinInet, Indy es para nenas
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;  

// Ahora necesitamos convertir los datos en una petición XML-RPC
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;

// Ahora la mandamos y si falla, obtenemos la descripcion del error 
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;

// Y ahora ponemos todo en marcha y que no reviente
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.