Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Actualizar esta página ¿Que hacer con flickr?
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 15-05-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
  
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
¿Que hacer con flickr?
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.
Responder Con Cita
  #2  
Antiguo 29-05-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
  
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
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:
Código:
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.
Responder Con Cita
  #3  
Antiguo 19-06-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
  
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
Hola,

Código:
test 66746781@N00
Responder Con Cita
  #4  
Antiguo 19-06-2007
Avatar de dec
dec dec is offline
Moderador
  
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Hola,

¡Fiesta de caritas!

__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
  #5  
Antiguo 19-06-2007
Avatar de Caral
[Caral] Caral is offline
Miembro Premium
  
Registrado: ago 2006
Posts: 7.659
Poder: 25
Caral Va por buen camino
Hola
Me da mucha pena no poder responder a hilos como este, bueno la verdad es que me da vergüenza, no tener nada que decir.
Solamente puedo decir, eres Genial Seoane, aunque no entiendo nada de lo que haces, es demasiado para mi.
Saludos
Responder Con Cita
  #6  
Antiguo 20-06-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
  
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 24
seoane Va por buen camino
Cita:
Empezado por dec
¡Fiesta de caritas!
A veces una imagen vale mas que mil palabras

¿Probaste el programa dec?
Responder Con Cita
  #7  
Antiguo 20-06-2007
Avatar de dec
dec dec is offline
Moderador
  
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Hola,

Pues para qué nos vamos a engañar Domingo... no lo he hecho. Lo que por otro lado no significa nada: he probado otros que has hecho y espero probar otros en el futuro. Pero tú sigue, sigue... no te prives.
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
  #8  
Antiguo 20-06-2007
Avatar de dec
dec dec is offline
Moderador
  
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.107
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Hola,

Bueno... pues ya he probado el programa... este que baja cientos de fotos... está muy bien, porque además baja fotos de chicas guapísimas. Felicitaciones seoane.
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
Respuesta

« Tema Anterior | Próximo Tema »


Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes
El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Proyecto: Imágenes de Flickr angelillo182 Internet 8 14-06-2006 18:17:01
Hacer un reloj jorodgar Varios 2 18-05-2005 09:56:06
Hacer un planning Aprendiendo OOP 2 30-09-2004 10:05:14
Razones para hacer (o no hacer) ejercicio Nuria Humor 1 02-09-2004 13:05:43


La franja horaria es GMT +2. Ahora son las 19:31:25.

Club Delphi - Archivo - Top

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi