[[seoane]]

Veo que nadie tiene ideas . Pues a mi se me ocurrió hacer un programa que baje las primeras 500 fotos que encuentre de un usuario. Esto en principio tiene una utilidad evidente, bajarnos todas las fotos de las vacaciones, hacer una copia de todas nuestras fotos de flickr, bajar todas las fotos de una chica que sea muy guapa ....

El programa seria algo así. Tener en cuenta que es solo una prueba de concepto, así que el código esta bastante "sucio".

Código Delphi [-]
program Test;

{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  Classes,
  UrlMon,
  ActiveX,
  uflickr in '..\uflickr.pas';

function LoadKey: String;
var
  Str: String;
begin
  Result:= '';
  Str:= IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))
    + 'api_key.txt';
  if FileExists(Str) then
    with TStringList.Create do
    try
      LoadFromFile(Str);
      Result:= Trim(Text);
    finally
      Free;
    end;
end;

function CreatePath(Filename: String): String;
begin
  Result:= IncludeTrailingPathDelimiter(
    IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) +
    'Temp');
  ForceDirectories(Result);
  Result:= Result + Filename;
end;

procedure Bajar(Id: String);
var
  Params: TStringList;
begin
  Params:= TStringList.Create;
  try
    Params.Values['api_key']:= LoadKey;
    Params.Values['photo_id']:= Id;
    with TFlickrMethod.Create do
    try
      Execute('flickr.photos.getSizes',Params);
      if Count > 0 then
        // Este codigo intenta bajar la foto original
        if Photos[0].Original <> '' then
        begin
          Writeln(Photos[0].Original);
          UrlDownloadToFile(nil, PChar(Photos[0].Original),
          PChar(CreatePath(Format('%s.jpg',[Id]))),0,nil);
        end;
       // Si las fotos originales no estan disponibles, usa este codigo
       // para bajar el mayor tamaño posible
      {
        if Photos[0].Large <> '' then
        begin
          Writeln(Photos[0].Large);
          UrlDownloadToFile(nil, PChar(Photos[0].Large),
          PChar(CreatePath(Format('%s.jpg',[Id]))),0,nil);
        end;
      }
    finally
      Free;
    end;
  finally
    Params.Free;
  end;
end;

var
  i: Integer;
  Params: TStringList;
begin
  CoInitialize(nil);
  Params:= TStringList.Create;
  try
    Params.Values['api_key']:= LoadKey;
    Params.Values['user_id']:= ParamStr(1);
    Params.Values['per_page']:= '500';
    with TFlickrMethod.Create do
    try
      Execute('flickr.photos.search',Params);
      Writeln(IntToStr(Count) + ' Fotos');
      Writeln;
      for i:= 0 to Count - 1 do
      begin
        Bajar(Photos[i].Id);
      end;
    finally
      Free;
    end;
  finally
    Params.Free;
  end;
  CoUninitialize
end.

Bueno, es fácil de usar solo hay que pasarle como parámetro la id del usuario. Para conseguir su id seguro que hay algún método mas sofisticado, pero yo lo que hago es ver la dirección del icono del usuario (buddyicon) que tiene este aspecto:

http://www.flickr.com/images/buddyicon.jpg?35439404@N00

La id del usuario es el número que aparece al final, es decir: 35439404@N00

Así por ejemplo para bajar todas las fotos de ese usuario, utilizaríamos:

Test 35439404@N00

Para poder compilar el codigo anterior hay que modificar un poco la unit "uflickr.pas" que habia puesto antes. La nueva unit seria asi:

Código Delphi [-]
unit uflickr;

interface

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

type
  TFlickrPhoto = class
  private
    FId: String;
    FFarm: String;
    FOwner: String;
    FSecret: String;
    FServer: String;
    FTitle: String;
    FLarge: String;
    FSmall: String;
    FSquare: String;
    FThumbnail: String;
    FOriginal: 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;
    property Original: String read FOriginal;
    constructor Create(AId,AFarm,AOwner,ASecret,AServer,ATitle: String); overload;
    constructor Create(ASquare,A_Small,ALarge,AThumbnail,AOriginal: String); overload;
  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 ErrorStr: String read FError;
    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;
  ASquare,A_Small,ALarge,AThumb,AOriginal: String;
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;
    Nodo:= ChildNodes.FindNode('sizes');
    if Nodo <> nil then
    begin
      ASquare:= '';
      A_Small:= '';
      ALarge:= '';
      AThumb:= '';
      AOriginal:= '';
      for i:= 0 to Nodo.ChildNodes.Count - 1 do
      begin
        if WideSameText(Nodo.ChildNodes[i].NodeName,'size') then
        begin
          with Nodo.ChildNodes[i] do
          begin
            if VarIsStr(Attributes['label']) then
            begin
              if WideSameText(Attributes['label'],'Square') then
                ASquare:= Attributes['source'];
              if WideSameText(Attributes['label'],'Small') then
                A_Small:= Attributes['source'];
              if WideSameText(Attributes['label'],'Large') then
                ALarge:= Attributes['source'];
              if WideSameText(Attributes['label'],'Thumbnail') then
                AThumb:= Attributes['source'];
              if WideSameText(Attributes['label'],'Original') then
                AOriginal:= Attributes['source'];
            end;
          end;
        end;
      end;
      FPhotos.Add(TFlickrPhoto.Create(ASquare,A_Small,ALarge,AThumb,AOriginal));
    end;
  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;
  FLarge:= '';
  FSmall:= '';
  FSquare:= '';
  FThumbnail:= '';
end;

constructor TFlickrPhoto.Create(ASquare, A_Small, ALarge, AThumbnail, AOriginal: String);
begin
  FId:= '';
  FFarm:= '';
  FOwner:= '';
  FSecret:= '';
  FServer:= '';
  FTitle:= '';
  FLarge:= ALarge;
  FSmall:= A_Small;
  FSquare:= ASquare;
  FThumbnail:= AThumbnail;
  FOriginal:= AOriginal;
end;

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

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

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

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

end.

Venga, a bajar las fotos de las vacaciones y recordar que necesitáis un apikey, así que si sois usuarios de flickr rellenar el formulario para que os den una, y si no lo sois pedírmela por privado e intentare pasaros la mía.