PDA

Ver la Versión Completa : ¿Que hacer con flickr?

seoane
15-05-2007, 19:39:38
Lo que hace el aburrimiento ... :p

El caso es que estuve haciendo algunas pruebas, utilizando la API de flickr (http://www.flickr.com/services/api/). En concreto, el formato XML-RPC, aprovechando un poco de código que tenia desde que dec (http://www.clubdelphi.com/foros/member.php?u=4681) experimento con xml-rpc (http://www.xmlrpc.com/) 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 :rolleyes: . ¿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 (http://www.clubdelphi.com/foros/showthread.php?t=41240)" :p

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

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:

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.
seoane
29-05-2007, 13:39:31
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 .... :p :D

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

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:


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.
seoane
19-06-2007, 20:06:40
Hola,


test 66746781@N00


:eek: :D :p
dec
19-06-2007, 20:28:36
Hola,

¡Fiesta de caritas!

:D :D :D :) :eek: :p ;) :rolleyes: :cool:
Caral
19-06-2007, 20:54:57
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.:o
Saludos
seoane
20-06-2007, 00:16:33
¡Fiesta de caritas!


:D A veces una imagen vale mas que mil palabras

¿Probaste el programa dec? ;)
dec
20-06-2007, 00:25:09
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. :)
dec
20-06-2007, 00:45:50
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. :)