Automatizar la subida de imagenes a internet

[gulder]

Hola foro como andan espero que bien bueno les vengo a preguntar si esto se puede:

hay servidores en internet que nos permiten subir imagenes caso especifico ver siguiente enlace,

http://img.tomatone.net/index.php

hasta hay todo bien lo que yo quiero hacer es por medio de un programa delphi automatizar las subidas de varias imagenes a este servidor y guardar la direccion de la misma, osea la direccion donde se guardo la imegen en el servidor espero que me hallan entiendido saludos gulder

[roman]

Para ese caso específico:


uses IdHTTP, IdMultipartFormData;

{
Sube una imagen al sitio http://img.tomatone.net/
Devuelve la URL de la imagen o una cadena vacía en caso de error

El sitio sólo acepta imágenes png, jpeg y gif
}
function UploadImage(FileName: String): String;
var
IdHTTP: TIdHTTP;
Stream: TIdMultipartFormDataStream;
Ext: String;
Response: String;
I: Integer;

begin
Result := '';

Ext := Copy(ExtractFileExt(FileName), 2, MaxInt);
if (Ext = 'jpg') then
Ext := 'jpeg';

IdHTTP := TIdHTTP.Create;
Stream := TIdMultipartFormDataStream.Create;

try
Stream.AddFile('userfile', FileName, 'image/' + Ext);
Stream.AddFormField('comp', 'ok');
Response := IdHTTP.Post('http://img.tomatone.net/index.php', Stream);

I := Pos('href=''big/', Response);
if I > 0 then
begin
Delete(Response, 1, I + 9);
I := Pos('''', Response);
if I > 0 then
begin
Result := 'http://img.tomatone.net/big/' + Copy(Response, 1, I - 1);
end;
end;
finally
IdHTTP.Free;
Stream.Free;
end;
end;


// Saludos

[seoane]

Rapido y eficaz, todo un alarde roman :)

[gulder]

señores foristas disculpen por haberme perdido, me quede dormido y gracias roman eres grande no lo he probado pero enseguida lo voy hacer saludos

[gulder]

bueno roman probe tu ejemplo lo que me dices y no me funcionoo aqui abjunto le que ice con tu ejemplo pero al final no pude ver la url de la imagen y no se si la imagen subio bueno espero que me ayudes a aclarar por que no funciona saludos gulder

[roman]

Pues realmente no sé qué pueda pasar. Tal como lo puse, lo probé varias veces y con los tres formatos posibles, y en todos los casos me funcionó. Tendrías que fijarte con detalle en el texto que te devuelve IdHTTP.Post para ver qué error te marca.

El sitio en cuestión es sumamente simple y no renombra los archivos, de manera que te marca un error (ya también lo probé) si intentas subir un archivo con el mismo nombre que otro que ya exista.

// Saludos

[roman]

Rapido y eficaz, todo un alarde roman :)

Hey, pensé que ibas a poner la solución usando wininet :)

// Saludos

[gulder]

bueno roman gracias seguire viendo para ver cual es el problema saludos

[seoane]

Hey, pensé que ibas a poner la solución usando wininet :)


Si es que entro al trapo enseguida :D

Aquí tienes el código roman, pero aviso que esta bastante sucio y tiene algo de copy&paste de otros proyectos, pero aquí es la una de la madrugada (mas bien una y media) y no voy a dedicarle mas tiempo :D


uses
WinInet;

const
strSeparador = 'Separador528C65E88C1F4DB5BDB11BF1558AF1C3';

function UploadImage(Filename: String): String;
var
hNet: HINTERNET;
hCon: HINTERNET;
hReq: HINTERNET;
Context: DWORD;
BytesRead: DWORD;
Data: TMemoryStream;
Response: TStringStream;
Buffer: PChar;
Str: String;
FileStream: TFileStream;
i: Integer;
begin
Result:= EmptyStr;
Context:= 0;
hNet := InternetOpen('Agente', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if (hNet <> nil) then
begin
hCon:= InternetConnect(hNet,'img.tomatone.net',80,nil,nil,
INTERNET_SERVICE_HTTP,0,Context);
if (hCon <> nil) then
begin
hReq:= HttpOpenRequest(hCon,'POST','/index.php',nil,nil,nil,
INTERNET_FLAG_RELOAD,Context);
if (hReq <> nil) then
begin
Data:= TMemoryStream.Create;
try
// Agregamos el campo
Str:= '--' + strSeparador + #13#10;
Data.WriteBuffer(PChar(Str)^,Length(Str));
Str:= 'Content-Disposition: form-data; name="comp"'
+ #13#10#13#10 + 'ok' + #13#10;
Data.WriteBuffer(PChar(Str)^,Length(Str));
// Agregamos el archivo
Str:= '--' + strSeparador + #13#10;
Data.WriteBuffer(PChar(Str)^,Length(Str));
Str:= 'Content-Disposition: file; name="userfile"; filename="' + ExtractFilename(Filename) + '"' + #13#10;
Data.WriteBuffer(PChar(Str)^,Length(Str));
Str:= 'Content-Type: image/jpeg' + #13#10;
Data.WriteBuffer(PChar(Str)^,Length(Str));
Str:= 'Content-Transfer-Encoding: binary' + #13#10#13#10;
Data.WriteBuffer(PChar(Str)^,Length(Str));
FileStream:= TFileStream.Create(Filename,fmOpenRead);
try
Data.CopyFrom(FileStream,0)
finally
FileStream.Free;
end;
Str:= #13#10 + '--' + strSeparador + '--' + #13#10;
Data.WriteBuffer(PChar(Str)^,Length(Str));
if HttpSendRequest(hReq,
PChar('Content-Type: multipart/form-data; boundary='
+ strSeparador), Cardinal(-1), Data.Memory,Data.Size) then
begin
Response:= TStringStream.Create(EmptyStr);
try
GetMem(Buffer,32*1024);
try
while (InternetReadFile(hReq,Buffer,32*1024,BytesRead)) do
begin
if (BytesRead = 0) then
break;
Response.Write(Buffer^,BytesRead)
end;
Str:= Response.DataString;
// Esto se lo copio a roman
I := Pos('href=''big/', Str);
if I > 0 then
begin
Delete(Str, 1, I + 9);
I := Pos('''', Str);
if I > 0 then
begin
Result := 'http://img.tomatone.net/big/' + Copy(Str, 1, I - 1);
end;
end;
// Fin del plagio
finally
FreeMem(Buffer);
end;
finally
Response.Free;
end;
end;
finally
Data.Free;
end;
InternetCloseHandle(hReq);
end;
InternetCloseHandle(hCon);
end;
InternetCloseHandle(hNet);
end;
end;

[roman]

gulder, retomando esto, ojalá te sirva la solución de seoane. Debo comentar que la mia la probé y funciona bien con Indy 10, pero al probarla en casa con Indy 9 no funciona y el sitio en cuestión no manda ningún mensaje aclaratorio. Tengo la impresión de que no está mandando correctamente el archivo, pero no he tenido oportunidad de profundizar.

¿Cuál versión estás usando tú?

// Saludos

[gulder]

hola a todos como andan disculpen enormemente por abandonar este pots siendo yo el que mas le interesaba pero fue por causa de fuerza mayor, siguiendo por donde iba Román no me funciona por que yo uso las indy 9 entonces por eso no me funcionaba lo que tu expones.
Y seocene en estos momentos estoy probando lo que me dices saludos y gracias a los dos por no desmotivarse

[gulder]

hola foro seoane funciona a la perfeccion gracias