Залить файл на файлообменник - Работа с сетью в Delphi

UnD)eaD)Snake · 06.01.2010, 00:08

Есть код заливки картинки на imageshack.us :

Цитата:

function sendimgs(path:string):string;
var
HTTP: TIdHTTP;
MPS: TIdMultiPartFormDataStream;
s,s2,format:string;
begin
HTTP := TIdHTTP.Create(nil);
MPS := TIdMultiPartFormDataStream.Create;
HTTP.HandleRedirects := True;
s:='';
if fileexists(path) then
begin
try
mps.AddFile('fileupload', path, 'multipart/form-data');
s:= HTTP.Post('http://imageshack.us/index.php', MPS);
s2:=copy(s,pos('5px; font-size: 14pt; background-color: #feb;" size="70" value="',s)+length('5px; font-size: 14pt; background-color: #feb;" size="70" value="'),100);
format:=copy(path,length(path)-3,length(path));
if format='.bmp' then
format:='.png';
result:=copy(s2,1,(pos(format,s2)+3 ));
if (result='')or (result=' ') then
result:='Ошибка отправления';
finally
MPS.Free;
HTTP.Free;
deletefile(path);
end;
end else result:='Файл не найден';
end;

аналогично пытаюсь сделать заливку файла на zalil.ru. не выходит. помогите)
у кого-нибудь есть рабочий код для заливки на какой-нибудь обменник?

Usov · 06.01.2010, 10:12

я очень сомневаюсь что для этих двух фотохостингов используются одинаковые поля формы, необходимо для каждого использовать свой подход, предварительно изучив HTML форму заливки и отследив на основе броузера что и куда передается.
у меня есть код для 3 фотохостингов, но для каждого свой код.

=LeonZone= · 11.04.2010, 18:46

Вот код моей заливалки на slil.ru

Код:

program Sender;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows,
  winsock;

function SendFile(host, script, filename:string):string;
var ws:TWSAData; //uses winsock!!!
    sock,fs,hFile:dword; ca:sockaddr_in;
    s,HTTPHeader,boundary,SubHeader1,SubHeader2: string;
    buf:array [0..4095] of char;
    p:PHostEnt; rb:cardinal; len:integer;
begin
s:='';
WSAStartup($101, ws);
hFile:=CreateFile(PChar(filename), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hFile<>INVALID_HANDLE_VALUE then
   begin
   fs:=GetFileSize(hFile, nil);
   sock:=socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
   if sock<>INVALID_SOCKET then
      begin
      ca.sin_family:=AF_INET;
      ca.sin_port:=htons(80);
      p:=GetHostByName(PChar(host));
      if p=nil then ca.sin_addr.s_addr:=inet_addr(pchar(host)) else ca.sin_addr:=PInAddr(p.h_addr_list^)^;
      if connect(sock, ca, sizeof(ca))<>-1 then
         begin
         boundary := inttohex(random(65535), 4)+inttohex(random(65535), 4)+inttohex(random(65535), 4);
         SubHeader1:='--'+boundary+#13#10+
                     'Content-Disposition: form-data; name="file"; filename="'+filename+'"'#13#10+
                     'Content-Type: application/octet-stream'#13#10#13#10;
         SubHeader2:=#13#10+'--'+boundary+'--'#13#10;
         HTTPHeader:='POST '+script+' HTTP/1.1'#13#10+
                     'Host: '+host+#13#10+
                     'Connection: close'#13#10+
                     'Content-Type: multipart/form-data; boundary='+boundary+#13#10+
                     'Content-Length: '+inttostr(fs + length(SubHeader1) + length(SubHeader2))+#13#10#13#10+SubHeader1;
         send(sock, HTTPHeader[1], length(HTTPHeader), 0);
         while true do
               begin
               rb:=0;
               ReadFile(hFile, buf, 4096, rb, nil);
               if rb=0 then break;
               send(sock, buf, rb, 0);
               end;
         send(sock, SubHeader2[1], length(SubHeader2), 0);
         while true do
               begin
               len:=recv(sock, buf, 4096, 0);
               if len>0 then s:=s+copy(buf, 0, len) else break;
               end;
         end;
         closesocket(sock);
      end;
   CloseHandle(hFile);
   end else begin
   Result:='Error open file!';
   exit;
   end;
if POS('Location: /upload/',s)<>0 then
   begin
   Result:='Link to file: http://slil.ru/'+copy(s,POS('/upload/',s)+8,8);
   end else Result:='Error sending!';
end;

var s:string;
begin
Writeln('Sending file to slil.ru by =LeonZone=');
Writeln('Enter the path to the file:');
repeat
Readln(s)
until length(s)<>0;
Writeln('Wait...');
Writeln(SendFile('zalil.ru', '/upload/',s));
Readln;
end.

W0LF · 11.04.2010, 22:22

UPWAP.RU

Код:

uses
  IdMultipartFormData, IdHTTP;

function UploadFile_UNWAP(_filename, _info: string; const _password: string = ''): string;
var
  _F: TIdMultiPartFormDataStream;
  _Http: TIdHTTP;
  _Buff: string;
begin
  _Http := TIdHTTP.Create(nil);
  _Http.HandleRedirects := True;
  _Http.Get('http://upwap.ru/upload/');
  _F := TIdMultiPartFormDataStream.Create;
  if FileExists(_filename) then
    _F.AddFile('file', _filename, 'multipart/form-data')
    else begin
      Result :=  'Файл для загрузки ненайден!';
      Exit;
    end;
  _F.AddFormField('desc', UTF8Encode(_info));
  if _password <> '' then
    _F.AddFormField('password', UTF8Encode(_password));
  _F.AddFormField('send', UTF8Encode('Отправить!'));
  _Buff:=UTF8Decode(_Http.Post('http://upwap.ru/upload/', _F));
  if Pos('Файл размещен', _Buff) = 0 then
    Result := 'Ошибка...'
    else begin
      Delete(_Buff, 1, Pos('Файл размещен', _Buff) + Length('Файл размещен') + 18);
      Delete(_Buff, Pos('">', _Buff), Length(_Buff) - Pos('">', _Buff) + 1);
      Result := 'http://upwap.ru' + _Buff;
    end;
  _F.Free;
  _Http.Free;
end;

DepositFiles (код не мой - получен от Usov и немного мной переделан)

Код:

uses
  idMultiPartFormData;

{+ IdHTTP1 с HandleRedirects:=True}

function DFupload(FileName: string): string;
var
  mp: TidMultiPartFormDataStream;
  s,b: String;
begin
  s := IdHTTP1.Get('http://depositfiles.com/ru/');
  b := s;
  mp := TidMultiPartFormDataStream.Create;
  mp.AddFile('files', FileName, 'multipart/form-data');
  mp.AddFormField('MAX_FILE_SIZE', '2097152000');
  mp.AddFormField('UPLOAD_IDENTIFIER', GetSubStr(s, 'name="UPLOAD_IDENTIFIER" value="', '"'));
  mp.AddFormField('go', '1');
  mp.AddFormField('agree', '1');
  b := IdHTTP1.Post(GetSubStr(s, 'multipart/form-data" action="', '"'), mp);
  if pos('ud_download_url', Utf8ToAnsi(b)) > 0 then
    Result := GetSubStr(b, 'ud_download_url = ''', '''');
  mp.Free;
end;

Tinki · 22.04.2010, 20:48

Цитата:

Сообщение от W0LF

UPWAP.RU
[CODE]

DepositFiles (код не мой - получен от Usov и немного мной переделан)

Код:

uses
  idMultiPartFormData;

{+ IdHTTP1 с HandleRedirects:=True}

function DFupload(FileName: string): string;
var
  mp: TidMultiPartFormDataStream;
  s,b: String;
begin
  s := IdHTTP1.Get('http://depositfiles.com/ru/');
  b := s;
  mp := TidMultiPartFormDataStream.Create;
  mp.AddFile('files', FileName, 'multipart/form-data');
  mp.AddFormField('MAX_FILE_SIZE', '2097152000');
  mp.AddFormField('UPLOAD_IDENTIFIER', GetSubStr(s, 'name="UPLOAD_IDENTIFIER" value="', '"'));
  mp.AddFormField('go', '1');
  mp.AddFormField('agree', '1');
  b := IdHTTP1.Post(GetSubStr(s, 'multipart/form-data" action="', '"'), mp);
  if pos('ud_download_url', Utf8ToAnsi(b)) > 0 then
    Result := GetSubStr(b, 'ud_download_url = ''', '''');
  mp.Free;
end;

опишите пожалуйста функцию GetSubStr()

W0LF · 22.04.2010, 21:00

Извиняюсь, забыл... {Получен от: Usov}

Код:

function GetSubStr(InputStr, BeginStr, EndStr: String): String;
var
  s: String;
  sp, ep: Integer;
begin
  Result := '';
  if pos(BeginStr, InputStr) <> 0 then begin
    sp := pos(BeginStr, InputStr)+length(BeginStr);
    s := copy(InputStr,sp,length(InputStr));
    ep := pos(EndStr,s)-1;
    Result := copy(s,1,ep);
  end;
end;

Tinki · 22.04.2010, 21:29

Цитата:

Сообщение от W0LF

Извиняюсь, забыл... {Получен от: Usov}

Код:

function GetSubStr(InputStr, BeginStr, EndStr: String): String;
var
  s: String;
  sp, ep: Integer;
begin
  Result := '';
  if pos(BeginStr, InputStr) <> 0 then begin
    sp := pos(BeginStr, InputStr)+length(BeginStr);
    s := copy(InputStr,sp,length(InputStr));
    ep := pos(EndStr,s)-1;
    Result := copy(s,1,ep);
  end;
end;

спасибо !!
а я уж начал свою клепать )

EinKRieGeR · 08.06.2010, 10:41

Помогите пожалуйста написать программу для заливки картинок на конкретный фотохостинг. Во вложенном файле перехваченные с браузера запросы. Заранее благодарю!

W0LF · 08.06.2010, 13:57

Если "помогите написать" для вас тоже самое, что "напишите полностью"... То я написал ПРОГРАММУ... Выкладываю в аттаче, про исходники не кто не чего не говорил, так что топайте во фриланс, или покупайте у меня, ведь каждая работа должна оплачиваться!

EinKRieGeR · 08.06.2010, 15:35

Спасибо огромное за ваш труд! Но мне хотелось бы самому написать, и под фразой "помогите написать" я предполагал увидеть какие нибудь советы в данном вопросе, так как работать с сетями в делфях только начинаю

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Залить сайт	Дініс	Свободное общение	12	20.12.2009 14:28
файлообменник!	Inferno777	Свободное общение	16	02.08.2009 13:18
ЗАлить файл на ФТП	russian-stalker	Работа с сетью в Delphi	8	25.09.2008 11:46
файлообменник!	execom	Свободное общение	5	28.11.2006 13:46

06.01.2010, 10:12	#2
Usov Форумчанин Регистрация: 29.09.2009 Сообщений: 228	я очень сомневаюсь что для этих двух фотохостингов используются одинаковые поля формы, необходимо для каждого использовать свой подход, предварительно изучив HTML форму заливки и отследив на основе броузера что и куда передается. у меня есть код для 3 фотохостингов, но для каждого свой код.

08.06.2010, 15:35	#10
EinKRieGeR Регистрация: 30.04.2010 Сообщений: 4	Спасибо огромное за ваш труд! Но мне хотелось бы самому написать, и под фразой "помогите написать" я предполагал увидеть какие нибудь советы в данном вопросе, так как работать с сетями в делфях только начинаю