¿Que hacer con flickr?

[[seoane]]

Lo que hace el aburrimiento ...

El caso es que estuve haciendo algunas pruebas, utilizando la API de flickr. En concreto, el formato XML-RPC, aprovechando un poco de código que tenia desde que dec experimento con xml-rpc en su sitio web.

Parece que la cosa funciona, al menos el método "flickr.photos.search" con el que he hecho las pruebas. Puedo hacer búsquedas y me devuelve una lista de imágenes.

La pregunta ahora es: ¿que hacer con esto?. Pensé en hacer un programa que cambie el fondo de pantalla, pero no termina de convencerme, prefiero escoger yo mismo los fondos . ¿Que otras aplicaciones se podrían hacer con la API de flickr?

Lo dicho, es por aburrimiento. Si no le encuentro alguna utilidad, lo tendré que pasar al hilo de "Código inútil"

Por si a alguien le interesa, esta es la unidad que cree:

Código Delphi [-]
unit uflickr;

interface

uses
  Windows, SysUtils, Classes, Contnrs, WinInet, xmldom, XMLIntf, msxmldom,
  XMLDoc, Variants;

type
  TFlickrPhoto = class
  private
    FId: String;
    FFarm: String;
    FOwner: String;
    FSecret: String;
    FServer: String;
    FTitle: String;
    function GetLarge: String;
    function GetSmall: String;
    function GetSquare: String;
    function GetThumbnail: String;
  published
  public
    property Id: String read FId;
    property Farm: String read FFarm;
    property Owner: String read FOwner;
    property Secret: String read FSecret;
    property Server: String read FServer;
    property Title: String read FTitle;
    property Square: String read GetSquare;
    property Thumbnail: String read GetThumbnail;
    property Small: String read GetSmall;
    property Large: String read GetLarge;
    constructor Create(AId,AFarm,AOwner,ASecret,AServer,ATitle: String);
  end;

  TFlickrMethod = class
  private
    FError: String;
    FPhotos: TObjectList;
    FResponse: WideString;
    function GetCount: Integer;
    function GetPhoto(Index: Integer): TFlickrPhoto;
    procedure MakeList; 
  published
  public
    constructor Create;
    destructor Destroy; override;
    function Execute(Method: String; Params: TStringList): Boolean;
    procedure SendRequest(Stream: TStream; Request: String);
    property Count: Integer read GetCount;
    property Photos[Index: Integer]: TFlickrPhoto read GetPhoto;
  end;

implementation

{ TFlickrMethod }

constructor TFlickrMethod.Create;
begin
  FPhotos:= TObjectList.Create;
end;

destructor TFlickrMethod.Destroy;
begin
  FPhotos.Free;
  inherited;
end;

function TFlickrMethod.Execute(Method: String; Params: TStringList): Boolean;
var
  i: Integer;
  Nodo: IXMLNode;
  Stream: TMemoryStream;
  XMLDoc: IXMLDocument;
  Str: String;
begin
  Result:= FALSE;
  FPhotos.Clear;
  FResponse:= EmptyStr;
  XMLDoc:= TXMLDocument.Create(nil);
  with XMLDoc do
  try
    try
      Active:= TRUE;
      Version:= '1.0';
      Options:= [doNodeAutoIndent];
      Nodo:= AddChild('methodCall');
      Nodo.AddChild('methodName').Text:= Method;
      Nodo:= Nodo.AddChild('params');
      Nodo:= Nodo.AddChild('param');
      Nodo:= Nodo.AddChild('value');
      Nodo:= Nodo.AddChild('struct');
      for i:= 0 to Params.Count - 1 do
      with Nodo.AddChild('member') do
      begin
        AddChild('name').Text:= Params.Names[i];
        AddChild('value').AddChild('string').Text:= Params.ValueFromIndex[i];
      end;
      Stream:= TMemoryStream.Create;
      try
        SendRequest(Stream, XML.Text);
        Stream.Position:= 0;
        LoadFromStream(Stream,xetUTF_8);
      finally
        Stream.Free;
      end;
      Active:= TRUE;
      // Comprobamos si ocurrio un error
      Nodo:= ChildNodes.FindNode('methodResponse');
      if Nodo <> nil then
      begin
        Nodo:= Nodo.ChildNodes.FindNode('fault');
        if Nodo <> nil then
        begin
          Nodo:= Nodo.ChildNodes.FindNode('value');
          if Nodo <> nil then
          begin
            Nodo:= Nodo.ChildNodes.FindNode('struct');
            if Nodo <> nil then
            begin
              Str:= EmptyStr;
              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
                          Str:= Nodo.ChildNodes.FindNode('string').Text
                        else
                          raise Exception.Create('Nodo "string" no encontrado.');
                        break;
                      end;
                end;
              end;
              if Str <> EmptyStr then
                raise Exception.Create(Str)
              else
                raise Exception.Create('Nodo "faultString" no encontrado.')
            end else raise Exception.Create('Nodo "estruct" no encontrado.');
          end else raise Exception.Create('Nodo "value" no encontrado.');
        end;
      end else raise Exception.Create('Nodo "methodResponse" no encontrado.');
      // Extraemos la respuesta
      Nodo:= ChildNodes.FindNode('methodResponse');
      if Nodo <> nil then
      begin
        Nodo:= Nodo.ChildNodes.FindNode('params');
        if Nodo <> nil then
        begin
          Nodo:= Nodo.ChildNodes.FindNode('param');
          if Nodo <> nil then
          begin
            Nodo:= Nodo.ChildNodes.FindNode('value');
            if Nodo <> nil then
            begin
              Nodo:= Nodo.ChildNodes.FindNode('string');
              if Nodo <> nil then
              begin
                FResponse:= Nodo.Text;
              end else raise Exception.Create('Nodo "string" no encontrado.');
            end else raise Exception.Create('Nodo "value" no encontrado.');
          end else raise Exception.Create('Nodo "param" no encontrado.');
        end else raise Exception.Create('Nodo "params" no encontrado.');
      end else raise Exception.Create('Nodo "methodResponse" no encontrado.');
    finally
      Active:= FALSE;
      XMLDoc:= nil;
    end;
    MakeList;
  except
    On E: Exception do
    begin
      FError:= E.Message;
      FPhotos.Clear;
      FResponse:= EmptyStr;
    end;
  end;
end;

function TFlickrMethod.GetCount: Integer;
begin
  Result:= FPhotos.Count;
end;

function TFlickrMethod.GetPhoto(Index: Integer): TFlickrPhoto;
begin
  Result:= TFlickrPhoto(FPhotos[Index]);
end;

procedure TFlickrMethod.MakeList;
var
  i: integer;
  Nodo: IXMLNode;
  XMLDoc: IXMLDocument;
begin
  FPhotos.Clear;
  XMLDoc:= TXMLDocument.Create(nil);
  with XMLDoc do
  try
    ParseOptions:= [];
    XML.Text:= Utf8Encode(FResponse);
    Active:= TRUE;
    Nodo:= ChildNodes.FindNode('photos');
    if Nodo <> nil then
    begin
      for i:= 0 to Nodo.ChildNodes.Count - 1 do
      begin
        if WideSameText(Nodo.ChildNodes[i].NodeName,'photo') then
        begin
          with Nodo.ChildNodes[i] do
            if VarIsStr(Attributes['id']) and VarIsStr(Attributes['farm']) and
               VarIsStr(Attributes['owner']) and VarIsStr(Attributes['secret']) and
               VarIsStr(Attributes['server']) and VarIsStr(Attributes['title']) then
                FPhotos.Add(TFlickrPhoto.Create( Attributes['id'],
                  Attributes['farm'], Attributes['owner'], Attributes['secret'],
                  Attributes['server'], Attributes['title']));
        end;
      end;
    end; // Puede que el metodo no responda con fotos
  finally
    Active:= FALSE;
    XMLDoc:= nil;
  end;
end;

procedure TFlickrMethod.SendRequest(Stream: TStream; Request: String);
var
  hNet: HINTERNET;
  hCon: HINTERNET;
  hReq: HINTERNET;
  Context: DWORD;
  BytesRead: DWORD;
  Success: Boolean;
  Buffer: PChar;
begin
  Context:= 0;
  hNet := InternetOpen('Agente', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if (hNet <> nil) then
  begin
    hCon:= InternetConnect(hNet,'api.flickr.com',80,nil,nil,
      INTERNET_SERVICE_HTTP,0,Context);
    if (hCon <> nil) then
    begin
      hReq:= HttpOpenRequest(hCon,'POST','/services/xmlrpc/',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
          GetMem(Buffer,32*1024);
          try
            while (InternetReadFile(hReq,Buffer,32*1024,BytesRead)) do
            begin
              if (BytesRead = 0) then
                break;
              Stream.Write(Buffer^,BytesRead)
            end;
          finally
            FreeMem(Buffer);
          end;
        end;
        InternetCloseHandle(hReq);
      end;
      InternetCloseHandle(hCon);
    end;
    InternetCloseHandle(hNet);
  end;
end;

{ TFlickrPhoto }

constructor TFlickrPhoto.Create(AId,AFarm,AOwner,ASecret,AServer,ATitle: String);
begin
  FId:= AId;
  FFarm:= AFarm;
  FOwner:= AOwner;
  FSecret:= ASecret;
  FServer:= AServer;
  FTitle:= ATitle;
end;

function TFlickrPhoto.GetLarge: String;
begin
  Result:= Format(
    'http://farm%s.static.flickr.com/%s/%s_%s_b.jpg',
    [FFarm,FServer,FId,FSecret]);
end;

function TFlickrPhoto.GetSmall: String;
begin
  Result:= Format(
    'http://farm%s.static.flickr.com/%s/%s_%s_m.jpg',
    [FFarm,FServer,FId,FSecret]);
end;

function TFlickrPhoto.GetSquare: String;
begin
  Result:= Format(
    'http://farm%s.static.flickr.com/%s/%s_%s_s.jpg',
    [FFarm,FServer,FId,FSecret]);
end;

function TFlickrPhoto.GetThumbnail: String;
begin
  Result:= Format(
    'http://farm%s.static.flickr.com/%s/%s_%s_t.jpg',
    [FFarm,FServer,FId,FSecret]);
end;

end.

Y por si alguien se pregunta como usarla, ahí va un ejemplo:

Código Delphi [-]
uses uflickr, WinInet, Jpeg;

// Esta funcion baja un archivo y lo coloca en un stream
function DownloadToStream(Url: string; Stream: TStream): Boolean;
var
  hNet: HINTERNET;
  hUrl: HINTERNET;
  Buffer: array[0..10240] of Char;
  BytesRead: DWORD;
begin
  Result := FALSE;
  hNet := InternetOpen('agent', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if (hNet <> nil) then
  begin
    hUrl := InternetOpenUrl(hNet, PChar(Url), nil, 0,
      INTERNET_FLAG_RELOAD, 0);
    if (hUrl <> nil) then
    begin
      while (InternetReadFile(hUrl, @Buffer, sizeof(Buffer), BytesRead)) do
      begin
        if (BytesRead = 0) then
        begin
          Result := TRUE;
          break;
        end;
        Stream.WriteBuffer(Buffer,BytesRead);
      end;
      InternetCloseHandle(hUrl);
    end;
    InternetCloseHandle(hNet);
  end;
end;

// Esta funcion baja un archivo y lo guarda en un bitmap
function DownloadToBmp(Url: string; Bitmap: TBitmap): Boolean;
var
  Stream: TMemoryStream;
  Jpg: TJPEGImage;
begin
  Result:= FALSE;
  Stream:= TMemoryStream.Create;
  try
    try
      if DownloadToStream(Url, Stream) then
      begin
        Jpg:= TJPEGImage.Create;
        try
          Stream.Seek(0,soFromBeginning);
          Jpg.LoadFromStream(Stream);
          Bitmap.Assign(Jpg);
          Result:= TRUE;
        finally
          Jpg.Free;
        end;
      end;
    finally
      Stream.Free;
    end;
  except end;
end;

// Este es el ejemplo 
var
  Params: TStringList;
  Bitmap: TBitmap;
begin
  // Creamos una lista con los parametros
  Params:= TStringList.Create;
  try
    // El parametro api_key (mas abajo explico lo que es)
    Params.Values['api_key']:= api_key;
    // Una lista de etiquetas separadas por comas, para definir la busqueda
    Params.Values['tags']:= 'wallpaper';
    // Creamos el objeto TFlickrMEthod
    with TFlickrMethod.Create do
    try
      // Lo ejecutamos
      Execute('flickr.photos.search',Params);
      // Comprobamos si obtuvimos una lista de fotos
      if Count > 0 then
      begin
        Bitmap:= TBitmap.Create;
        try
          // Bajamos una de las imagenes de la lista (Large = Grande, Small = Pequeña, ...)
          if DownloadtoBmp(Photos[Random(Count)].Large,Bitmap) then
            // Y la mostramos en un TImage
            imgPreview.Picture.Assign(Bitmap);
        finally
          Bitmap.Free;
        end;
      end;
    finally
      Free;
    end;
  finally
    Params.Free;
  end;
end;

La "api_key" es una clave que flickr utiliza para controlar quien esta haciendo uso de su API. Es necesario obtener una "api_key" para poder usar la API. Para obtener una, solo tenéis que tener una cuenta en flickr y rellenar un formulario.

Mas información aquí:
http://www.flickr.com/services/api/misc.api_keys.html

Aunque si alguien solo quiere hacer un par de pruebas, que me mande un mensaje privado y le paso mi clave.