Модераторы: Snowy, Poseidon, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Загрузить файл програмно на сервер, вроде рапиды и их подобным 
:(
    Опции темы
Zlo
  Дата 15.12.2009, 01:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Собственно что нам требуется:
Необходимо взять файл и загрузить его на файловый хостинг например на webfile.ru

Собственно даже не подозреваю с чего начать... Желательно не используя сторонних библиотек, а прямо средствами винды, но как?
Может быть даже у кого-то есть пример или кусок кода- буду рад всему smile

PM MAIL   Вверх
SlaUr
Дата 16.12.2009, 09:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 408
Регистрация: 18.9.2003

Репутация: нет
Всего: 5



Насколько я понимаю загрузить файл на сервер можно только на ftp-сервер

Код

uses wininet;
var FtpHandle,InetHandle: HInternet;

Function CopyFileFtp(inp,outp:string):Boolean;
begin
Result:=False;
InetHandle := InternetOpen(PChar('FTP'), 0, nil, nil, 0);
   FtpHandle := InternetConnect(InetHandle, PChar(ftp_name), 21, PChar(login),
       PChar(password), INTERNET_SERVICE_FTP, 0, 255);
    if not Assigned(FtpHandle) then
    begin
     InternetCloseHandle(InetHandle)
      Exit;
    end  else

    try
       if FtpPutFile(FtpHandle, PChar(inp), PChar(outp),
       FTP_TRANSFER_TYPE_BINARY, 255) then Result:=True ;
       except
    end;
 InternetCloseHandle(InetHandle);
end;




Это сообщение отредактировал(а) SlaUr - 16.12.2009, 10:11
PM MAIL   Вверх
profesiachuvak
Дата 16.12.2009, 11:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 283
Регистрация: 7.11.2009
Где: Беларусь, Минск

Репутация: нет
Всего: 4



Может быть Вам будет полезно. Пример кода как подключиться к ftp и скачать с него файл :
Код



  The following function shows how to connect to a ftp server 
  and download a file. 
  It uses the functions from wininet.dll. 

  You need a ProgressBar to show the progress and a Label to show progress informations. 


uses 
  WinInet, ComCtrls; 

function FtpDownloadFile(strHost, strUser, strPwd: string; 
  Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar): Boolean; 

  function FmtFileSize(Size: Integer): string; 
  begin 
    if Size >= $F4240 then 
      Result := Format('%.2f', [Size / $F4240]) + ' Mb' 
    else 
    if Size < 1000 then 
      Result := IntToStr(Size) + ' bytes' 
    else 
      Result := Format('%.2f', [Size / 1000]) + ' Kb'; 
  end; 

const 
  READ_BUFFERSIZE = 4096;  // or 256, 512, ... 
var 
  hNet, hFTP, hFile: HINTERNET; 
  buffer: array[0..READ_BUFFERSIZE - 1] of Char; 
  bufsize, dwBytesRead, fileSize: DWORD; 
  sRec: TWin32FindData; 
  strStatus: string; 
  LocalFile: file; 
  bSuccess: Boolean; 
begin 
  Result := False; 

  { Open an internet session } 
  hNet := InternetOpen('Program_Name', // Agent 
                        INTERNET_OPEN_TYPE_PRECONFIG, // AccessType 
                        nil,  // ProxyName 
                        nil, // ProxyBypass 
                        0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE 

  { 
    Agent contains the name of the application or 
    entity calling the Internet functions 
  } 


  { See if connection handle is valid } 
  if hNet = nil then 
  begin 
    ShowMessage('Unable to get access to WinInet.Dll'); 
    Exit; 
  end; 

  { Connect to the FTP Server } 
  hFTP := InternetConnect(hNet, // Handle from InternetOpen 
                          PChar(strHost), // FTP server 
                          port, // (INTERNET_DEFAULT_FTP_PORT), 
                          PChar(StrUser), // username 
                          PChar(strPwd),  // password 
                          INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher? 
                          0, // flag: 0 or INTERNET_FLAG_PASSIVE 
                          0);// User defined number for callback 

  if hFTP = nil then 
  begin 
    InternetCloseHandle(hNet); 
    ShowMessage(Format('Host "%s" is not available',[strHost])); 
    Exit; 
  end; 

  { Change directory } 
  bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir)); 

  if not bSuccess then 
  begin 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    ShowMessage(Format('Cannot set directory to %s.',[ftpDir])); 
    Exit; 
  end; 

  { Read size of file } 
  if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then 
  begin 
    fileSize := sRec.nFileSizeLow; 
    // fileLastWritetime := sRec.lastWriteTime 
  end else 
  begin 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    ShowMessage(Format('Cannot find file ',[ftpFile])); 
    Exit; 
  end; 

  { Open the file } 
  hFile := FtpOpenFile(hFTP, // Handle to the ftp session 
                       PChar(ftpFile), // filename 
                       GENERIC_READ, // dwAccess 
                       FTP_TRANSFER_TYPE_BINARY, // dwFlags 
                       0); // This is the context used for callbacks. 

  if hFile = nil then 
  begin 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    Exit; 
  end; 

  { Create a new local file } 
  AssignFile(LocalFile, TargetFile); 
  {$i-} 
  Rewrite(LocalFile, 1); 
  {$i+} 

  if IOResult <> 0 then 
  begin 
    InternetCloseHandle(hFile); 
    InternetCloseHandle(hFTP); 
    InternetCloseHandle(hNet); 
    Exit; 
  end; 

  dwBytesRead := 0; 
  bufsize := READ_BUFFERSIZE; 

  while (bufsize > 0) do 
  begin 
    Application.ProcessMessages; 

    if not InternetReadFile(hFile, 
                            @buffer, // address of a buffer that receives the data 
                            READ_BUFFERSIZE, // number of bytes to read from the file 
                            bufsize) then Break; // receives the actual number of bytes read 

    if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then 
      BlockWrite(LocalFile, buffer, bufsize); 
    dwBytesRead := dwBytesRead + bufsize; 

    { Show Progress } 
    ProgressBar.Position := Round(dwBytesRead * 100 / fileSize); 
    Form1.Label1.Caption := Format('%s of %s / %d %%',[FmtFileSize(dwBytesRead),FmtFileSize(fileSize) ,ProgressBar.Position]); 
  end; 

  CloseFile(LocalFile); 

  InternetCloseHandle(hFile); 
  InternetCloseHandle(hFTP); 
  InternetCloseHandle(hNet); 
  Result := True; 
end;




--------------------
Закон Мерфи :если есть вероятность того, что какая-нибудь неприятность может случиться, то она обязательно произойдет.
PM MAIL   Вверх
Zlo
  Дата 17.12.2009, 22:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Нет, ребята фал нужно грузить по HTTP, ну тоже самое, что вы скажем заходите на рапиду и грузите на нее файл.
PM MAIL   Вверх
SlaUr
Дата 18.12.2009, 09:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 408
Регистрация: 18.9.2003

Репутация: нет
Всего: 5



Насколько я понимаю по http можно только читать файлы а загрузить на сервер программно нельзя (на рапиде файл принимает сам сервер)

Это сообщение отредактировал(а) SlaUr - 18.12.2009, 09:38
PM MAIL   Вверх
1000000dollars
Дата 18.12.2009, 20:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 231
Регистрация: 6.10.2007

Репутация: 1
Всего: 8



По HTTP залить файл можно. Чтобы это сделать надо разобраться как работает http и если я правильно помню особое внимание уделить методу POST.

Деталей сейчас уже не помню, так что ничего более конкретного подсказать не могу.
PM MAIL   Вверх
profesiachuvak
Дата 19.12.2009, 15:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 283
Регистрация: 7.11.2009
Где: Беларусь, Минск

Репутация: нет
Всего: 4



Цитата(SlaUr @  18.12.2009,  09:37 Найти цитируемый пост)
Насколько я понимаю по http можно только читать файлы а загрузить на сервер программно нельзя (на рапиде файл принимает сам сервер)


SlaUr, Ну вообщем можно. Например загрузить картинку на страничку. Используя протокол http картинка загружается на сервер.

Цитата

Передача параметров скрипту должна осуществляться методом POST


Но как это сделать на delphi вопрос интересный. Про ftp информации уйма.


--------------------
Закон Мерфи :если есть вероятность того, что какая-нибудь неприятность может случиться, то она обязательно произойдет.
PM MAIL   Вверх
pegorov
Дата 19.12.2009, 17:27 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 49
Регистрация: 27.4.2008

Репутация: нет
Всего: нет



Поставьте какой-нибудь сниффер, загрузите файл на webfile.ru через браузер, отснифайте, что он передает и как, после чего воспроизведите эти же действия в дельфи
PM MAIL   Вверх
Zlo
  Дата 21.12.2009, 23:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Цитата(pegorov @  19.12.2009,  17:27 Найти цитируемый пост)
Поставьте какой-нибудь сниффер, загрузите файл на webfile.ru через браузер, отснифайте, что он передает и как, после чего воспроизведите эти же действия в дельфи 

Да ну это епонцу ясно smile
Вопрос в том как это сделать? 
Я тут почитал кое что и выходит, что дело это передается методом пост, на днях будет время -поэксперементирую, отпишусь smile
PM MAIL   Вверх
profesiachuvak
Дата 22.12.2009, 00:35 (ссылка)    | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 283
Регистрация: 7.11.2009
Где: Беларусь, Минск

Репутация: нет
Всего: 4



Цитата(Zlo @  21.12.2009,  23:20 Найти цитируемый пост)
Я тут почитал кое что и выходит, что дело это передается методом пост,


Я тут ссылочку нашёл насчёт вашей темы, там немного и про метод post есть: 

Загрузка файлов по http


--------------------
Закон Мерфи :если есть вероятность того, что какая-нибудь неприятность может случиться, то она обязательно произойдет.
PM MAIL   Вверх
AntonN
Дата 22.12.2009, 13:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 491
Регистрация: 8.8.2006

Репутация: нет
Всего: 18



найдите Synapse, это библиотека юнитов для работы с сетью (имхо лучше инди), в ней есть пример http_demo, в котором просто запрашивается странича по адресу, отправляются данные POSTом, пример отправки файла через POST с кодированием "multipart/form-data".
Конкретно для сабжа нужно сначала отпарсить страничку на которой будет поле выбора файла, вероятно там будет каптча (не смотрел, не знаю), каптчу можно скачать и показать в Image. Затем отправляется POST с закодированным файлом и параметрами катчи (нужные поля можно глянуть прям в html, для формы в которой находится поле отправки файла), по окончании страничка вновь запрашивается чтобы узнать закачался файл или нет.

PS Советчикам снифера большой привет, и пожелание в новом году самим попробывать отсниферить работу браузера.


--------------------
user posted image
PM MAIL WWW   Вверх
Zlo
Дата 22.12.2009, 21:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Цитата(AntonN @  22.12.2009,  13:09 Найти цитируемый пост)
найдите Synapse, это библиотека юнитов для работы с сетью (имхо лучше инди), в ней есть пример http_demo, 

Угумс, знаю пробегало тут на форуме с год или два назат, но надо на WinInet
PM MAIL   Вверх
Zlo
Дата 20.1.2010, 04:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Цитата(AntonN @  22.12.2009,  13:09 Найти цитируемый пост)
найдите Synapse, это библиотека юнитов для работы с сетью (имхо лучше инди), в ней есть пример http_demo, в котором просто запрашивается странича по адресу, отправляются данные POSTом, пример отправки файла через POST с кодированием "multipart/form-data".

Спасибо!

так, на всякий случай ссылка: 
http://www.delphi.int.ru/articles/49
PM MAIL   Вверх
M1ndAction
Дата 21.1.2010, 21:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 51
Регистрация: 19.1.2008

Репутация: нет
Всего: нет



Как я понял, вам надо на WinInet, в таком случае ничего конкретного к вышесказанному добавить не могу, но если будете делать с помощью Indy, то есть очень удобный инструмент для загрузки файлов: TIdMultiPartFormDataStream:

Код

...
var
  data: TIdMultiPartFormDataStream;
begin
  ...
  data := TIdMultiPartFormDataStream.Create;
  data.AddFormField('uploadId', uploadid);
  data.AddFormField('Empty', '');
  data.AddFile('file_0', FilePath, 'audio/mpeg');
  resultpage := idPost.Post(link, data);
  data.Free;
end;



P.S. smile
Цитата

PS Советчикам снифера большой привет, и пожелание в новом году самим попробывать отсниферить работу браузера.

А в чем проблема? Всегда все в порядке было, понятно, что весьма полезно посмотреть исходный код страницы, но тем не менее снифферы еще ни разу не подводили (пользуюсь обычно Http Analyzer и плагином Firebug для Firefox).
PM MAIL   Вверх
Zlo
Дата 22.2.2010, 16:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Ребята ктонить может подсказать как это сделать на WinApi?
PM MAIL   Вверх
JnK
  Дата 17.3.2010, 13:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 11
Регистрация: 24.3.2007

Репутация: нет
Всего: нет



Вот функция думаю поможет она может принимать и отправлять файл и данные на вэб форму.
Код

Host - сервер 
Path - пусть до скрипта
Save - сохраняем или передаем файл
ParamList - список переменных и значений (1. строка передменная, 2. данные)
AnswerServer - Ответ сервера (Заголовок)


Код

function SendFile(Host, Path, FileName:string; Save:boolean=false; ParamList:TStringList=nil; AnswerServer:boolean=false):string;
var
  sock : dword;
  ca : sockaddr_in;
  HTTPHeader : string;
  boundary : string;
  fs:dword;
  hFile : DWORD;
  buf : array [1..4096] of char;
  p : PHostEnt;
  rb : cardinal;
  SubHeader1 : string;
  SubHeader2 : string;
  SubHeader3 : string;
  i:integer;
  Step:integer;
  Data:string;
begin
  result := '';
  if (length(filename)>3) and (Save=false) then // есть адрес до файла и он не для сохранения, значит открываем
  begin
    hFile := CreateFile(PChar(filename), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);       // открываем файл на чтение
    if hFile <> INVALID_HANDLE_VALUE then // файл открылся
      fs := GetFileSize(hFile, nil);      // получаем размер?
  end;
    sock := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);   
    if sock <> INVALID_SOCKET then
    begin
      ca.sin_family := AF_INET;
      ca.sin_port := htons(80); // HTTP порт

      p := GetHostByName(PChar(host));
      if p = nil then
      begin
        ca.sin_addr.s_addr := inet_addr(pchar(host));
      end
      else
      begin
        ca.sin_addr := PInAddr(p.h_addr_list^)^;
      end;

      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="PassedFile"; filename="'+filename+'"'#13#10+
                       'Content-Type: application/octet-stream'#13#10#13#10;
        SubHeader3 := '';
        Step:=0;
        Data:='';
        if ParamList<>nil then
        begin
          for i:=1 to (ParamList.Count div 2) do
          begin
            if (length(filename)>3) and (Save=false) then
            begin
              SubHeader3 := SubHeader3 +                                 // создаем строку параметров для передачи, если есть файл для отправки
                            '--'+boundary+#13#10+
                            'Content-Disposition: form-data; name="'+
                            ParamList.Strings[Step]+'";'#13#10+
                            #13#10+ParamList.Strings[Step+1]+#13#10;
            end
            else
            begin
              Data := Data + ParamList.Strings[Step] + '=' + ParamList.Strings[Step+1] + '&'; // создаем строку параметров для передачи, если нет файла для отправки
            end;
            Step:=Step+2;
          end;
        end;
          SubHeader2 := #13#10+'--'+boundary+'--'#13#10;            // какая то фигня
          if Save=false then
          begin
            HTTPHeader:='POST';
          end
           else
          begin
            HTTPHeader:='GET';
          end;
          HTTPHeader := HTTPHeader+' '+path+' HTTP/1.1'#13#10+             // формируем заголовок
                        'Host: '+host+#13#10+
                        'Accept-Encoding: gzip, deflate'#13#10+
                        'Connection: close'#13#10;
          if (length(filename)>3) and (Save=false) then // Адрес до файла, Флаг сохранить = ложь, тоесть читаем его для отправки
          begin
            HTTPHeader := HTTPHeader+                            // формируем конечный заголовок с использованием файла
                          'Content-Type: multipart/form-data; boundary='+boundary+#13#10+
                          'Content-Length: '+inttostr(fs + length(SubHeader1) + length(SubHeader2) + length(SubHeader3))+#13#10#13#10;
          end
          else
          begin
            HTTPHeader:=  HTTPHeader+                            // формируем конечный заголовок без использования файла
                          'Content-Length: '+IntToStr(Length(Data))+#13#10+
                          'Content-Type: application/x-www-form-urlencoded'+
                          #13#10+#13#10+Data;
          end;

      send(sock, HTTPHeader[1], length(HTTPHeader), 0); // отправка заголовка

      if (length(filename)>3) and (Save=false) then
      begin
        send(sock, SubHeader3[1], length(SubHeader3), 0);  // часть заголовков с использованием файлов, отправка
        send(sock, SubHeader1[1], length(SubHeader1), 0);
        while true do
        begin
          rb := 0;
          ReadFile(hFile, buf, 4096, rb, nil);       // чтение 4 кб из файла
          if rb = 0 then break;                     // если длина =0 значит заканчиваем, если нет то
          send(sock, buf, rb, 0);                    // передача тела файла
        end;
        send(sock, SubHeader2[1], length(SubHeader2), 0);       // передача остатка заголовка
      end;
      if (length(filename)>3) and (Save) then // путь до файла существует и флаг сохранить файл
      begin
        hFile := CreateFile(Pchar(filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_FLAG_SEQUENTIAL_SCAN, 0); // создаем файл
      end;

      while true do
      begin
        rb := recv(sock, buf, 4096, 0);     // получаем ответ от сервера
        if rb > 0 then                       // если он больше 0 то
        begin
          Step:=pos(#13#10#13#10,buf);      // находим позицию конца ответа сервера
          if (Step>0) and (AnswerServer) then     // если ответ есть и флаг ответ сервера = правда, то
            result := result + copy(buf, 0, rb)    // пишем в ответ все что передал сервер ответ+тело
          else
            result := result + copy(buf, Step+4, rb-3); // иначе обрезать ответ от сервера и передать только тело.

          if (length(filename)>3) and (Save) then    // если имя файла (диск+файл) больше 3 символов и Save=true
          begin
            if Step>0 then                // если есть 2 перехода #13#10 то
            begin
              WriteFile(hFile, buf[Step+4], rb-Step-3 ,rb, nil); // обрезаем ответ сервера остальное сохраняем в файл
            end else
              WriteFile(hFile, buf, rb ,rb, nil);             // если нет, пишем все в файл
          end;
        end
        else
        begin
          break;                           // прерываем цикл, т.к. ответ сервера 0 байт
        end;
      end;
    end;

    closesocket(sock);            //закрываем сокет
    if (length(filename)>3) then  // Открывали ли мы какой нить дескриптор для файла
    begin
      CloseHandle(hFile);        // Закрываем сессию для файла
    end;
  end;
end; //~ SendFile  (работа с сетью)



P.s. Только не забываем поменять PassedFile на имя Input который на сайте

Код

                       'Content-Disposition: form-data; name="PassedFile"; filename="'+filename+'"'#13#10+
                       'Content-Type: application/octet-stream'#13#10#13#10;


Это сообщение отредактировал(а) JnK - 17.3.2010, 15:07
PM MAIL   Вверх
Zlo
  Дата 11.7.2010, 20:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Помогите допилить!!!
Нашел вот пример:
Авторизация и аутентификация на сайтах, через WinInet
Сделал так сказать по подобию, но наткнулся на грабли:
1. Не понимаю как нужно открывать файл, ибо если паскалевским методом (закоментировано), то вставляется 5 первых символов,
я так понимаю это заголовок JPG файла, а дальше никак, типа конец файла и все тут...
пока обошел это так:Открываю файл блокнотом, копирую в мемо и из мемо подставляю в запрос.
2.Запрос проходит но как-то криво... и картинка не появляется на сайте, пишет -ОШИБКА, выберете хотябы один файл.
При этом запрос почти идентичен, тому что отправляет браузер, но кароче, а почему не понятно...


Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinInet, StdCtrls,winsock;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetHostName(url : string) : string;
begin
  result := '';
  if pos('https://',url) > 0 then
    begin
      delete(url,1,length('https://'));
      SetLength(url,pos('/',url) - 1);
      result := url;
    end
  else
    if pos('http://',url) > 0 then
      begin
        delete(url,1,length('http://'));
        SetLength(url,pos('/',url) - 1);
        result := url;
      end;
end;

function GetScriptName( url,hostname : string) : string;
begin
  result := '';
  delete(url,1,pos(hostname,url) + length(hostname));
  result := url;
end;


procedure SetFlags(url : string; out Flags_connection,Flags_Request : Cardinal);
begin
  //Оприделяем на https или http
  if pos('https',url) > 0 then
    begin
      Flags_connection := INTERNET_DEFAULT_HTTPS_PORT;
      Flags_Request := INTERNET_FLAG_RELOAD or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_SECURE or INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_KEEP_CONNECTION;
    end
  else
    begin
      Flags_connection := INTERNET_DEFAULT_HTTP_PORT;
      Flags_Request := INTERNET_FLAG_RELOAD or INTERNET_FLAG_IGNORE_CERT_CN_INVALID or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_KEEP_CONNECTION;
    end;
end;

function DataAvailable(hRequest: pointer; out Size : cardinal): boolean;
begin
  result := wininet.InternetQueryDataAvailable(hRequest, Size, 0, 0);
end;

function GETURL2HTML(url : string;param : Ansistring ;method : string) : AnsiSTRING;//Получение страницы по url
var
  FHost,FScript : string;
  hInternet,hConnect,hRequest : Pointer;
  dwBytesRead,I,L : Cardinal;
  Flags_connection,Flags_Request : Cardinal;
  Type_Acess : string;
begin
  result := '';

  Type_Acess := 'Content-Type: multipart/form-data; boundary=----WebKitFormBoundaryuDo5SA2hdTeNDslg' + #13#10 +
                    'Content-Length:'+inttostr(length(param));//+#13#10+
                    //'------WebKitFormBoundaryuDo5SA2hdTeNDslg'+#13#10+
                    //'Content-Disposition: form-data; name="image1"; filename="Folder.jpg"'+#13#10+
                    //'Content-Type: image/jpeg';
  fHost := GetHostName(url);
  fScript := GetScriptName(url,fHost);

  //Устанавливаем флаги
  SetFlags(url,Flags_connection,Flags_Request);
  //Инициализируем WinInet
  hInternet := InternetOpen(PChar('Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US) AppleWebKit/533.4 (KHTML, like Gecko) Chrome/5.0.375.99 Safari/533.4'),INTERNET_OPEN_TYPE_PRECONFIG,Nil,Nil,0);
  if Assigned(hInternet) then
    begin
      //Открываем сессию
      hConnect := InternetConnect(hInternet,PChar(FHost),Flags_connection,nil,nil,INTERNET_SERVICE_HTTP,0,1);
      if Assigned(hConnect) then
        begin
          //Формируем запрос
          hRequest := HttpOpenRequest(hConnect,PChar(uppercase(method)),PChar(fScript),HTTP_VERSION,nil,Nil,Flags_Request,1);
          if Assigned(hRequest) then
            begin
              //Отправляем запрос
              I := 1;
              if HttpSendRequest(hRequest,PChar(Type_Acess),length(Type_Acess),PChar(param),length(param))  then
                begin
                  repeat
                  DataAvailable(hRequest, L);//Получаем кол-во принимаемых данных
                  if L = 0 then break;
                  SetLength(result,L + I);
                  if InternetReadFile(hRequest,@result[I],sizeof(L),dwBytesRead) then//Получаем данные с сервера
                  else break;

                  inc(I,dwBytesRead);
                  until dwBytesRead = 0;
                  result[I] := #0;
                end;
            end;
            InternetCloseHandle(hRequest);
        end;
        InternetCloseHandle(hConnect);
    end;
    InternetCloseHandle(hInternet);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
   param:ANSIstring;
   file1:TextFile;
   s:string;
begin
{param:='';
     AssignFile(file1, Edit2.Text);
     Reset(file1);
     //repeat
        ReadLn(file1, s);
        param:=param+s;
     //until not eof(file1);
     Memo1.Text:=param;
    //Memo1.Lines.LoadFromFile(Edit2.Text); }

    Memo2.Text:=GETURL2HTML(Edit1.Text,Memo1.Text,'POST');

end;

end.


Запрос от браузера:
Код

POST http://imglink.ru/process.php HTTP/1.1
Host: imglink.ru
Proxy-Connection: keep-alive
User-Agent: Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US) AppleWebKit/533.4 (KHTML, like Gecko) Chrome/5.0.375.99 Safari/533.4
Referer: http://imglink.ru/
Content-Length: 24365
Cache-Control: max-age=0
Origin: http://imglink.ru
Content-Type: multipart/form-data; boundary=----WebKitFormBoundary9Bq3lkvyB8alqWO4
Accept: application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5
Accept-Encoding: gzip,deflate,sdch
Accept-Language: ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4
Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.3
Cookie: PHPSESSID=1e4640bd9dff106bf17ddcf894d84ef0; __utmz=188829619.1278856285.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none); imglink_img[87a0c9a34770be6b686a3bca57c863ce]=thumbnails%2F11-07-10%2Fe8f76e12c03f7589b1bb2ab7ef19e1a8.jpg; imglink_img[b2e58c0fefa03a64b99ef4673105fbfd]=thumbnails%2F11-07-10%2Ff4a3cc7909958c444caf0ada81c3cdaa.jpg; __utma=188829619.908507728.1278856285.1278856285.1278861406.2; __utmc=188829619; __utmb=188829619.3.10.1278861406

------WebKitFormBoundary9Bq3lkvyB8alqWO4
Content-Disposition: form-data; name="image1"; filename="Folder.jpg"
Content-Type: image/jpeg

яШяа




Запрос от проги:
Код

POST http://imglink.ru/process.php HTTP/1.1
Content-Type: multipart/form-data; boundary=----WebKitFormBoundaryuDo5SA2hdTeNDslg
Content-Length: 5164
User-Agent: C:\Users\Zlo\Documents\RAD Studio\Projects\WinInet\Project2.exe
Host: imglink.ru
Proxy-Connection: Keep-Alive
Pragma: no-cache
Cookie: PHPSESSID=fc66602a115a110aac16c346371689e3

------WebKitFormBoundary9Bq3lkvyB8alqWO4
Content-Disposition: form-data; name="image1"; filename="Folder.jpg"
Content-Type: image/jpeg

яШяа JFIF  ` `  яЫ C         
 

 


 
 $.' ",#(7),01444'9=82<.342яЫ C             

 


2!!22222222222222222222222222222222222222222222222222яА  И И" яД               

яД µ   } !1AQa"q2Ѓ‘Ў#B±БRСр$3br‚    
%&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyzѓ„…†‡€‰Љ’“”•–—˜™љўЈ¤Ґ¦§Ё©ЄІіґµ¶·ё№єВГДЕЖЗИЙКТУФХЦЧШЩЪбвгдежзийкстуфхцчшщъяД            

яД µ  w !1AQaq"2ЃB‘Ў±Б    #3RрbrС
$4б%с&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz‚ѓ„…†‡€‰Љ’“”•–—˜™љўЈ¤Ґ¦§Ё©ЄІіґµ¶·ё№єВГДЕЖЗИЙКТУФХЦЧШЩЪвгдежзийктуфхцчшщъяЪ  
  ? n)»j]”Ў3\fд[iШ©6С¶Ђ#Е.)шЈ МRb¤ЕвђИЉТm¦ЭЭ[ШЫґч2¬Q/VcXQшЫB‘˜}©”/vЊЊэ8¦“{    иn‘LЫTґЯiљјЌќАydЎOлZzPХЂЏbџЉ1@†ЃЕ`У±Љ(…Яі~tТНэгщУ€¤ЕKxюtЬ·чЏзN=i1љ.I=Й¤ПЦњE&)ЊJ)qF(ёўќЉ(KbџЉ\RМQЉ}†AьQЉ f(#Љ~)Иф&ђП5ХnД~:‹F–F[5”GЏ Й?Ќz=Ч…|/Ћ±%¬?6U~RN~µеє|"ЯвRЗu |Ь8f'Ь§їг^ЈvцРј0эљ6іV1”Г 
@Зlg=л<CіIv6ГЖйћ/v’h>$oІ9&ЭcЁя <WЇ©К)цЧ–xАD5{„ЮЁРбb‰GрћzЧyбџґ6‘    љv•Z0FеБSРЊч­пНɘJ*3iшЈьb—"Ћ)§вђЉ a˜§‘I@ 
#ЉLSслIЉFi)дRb˜ЖвЊS±F(ёўќE iвЊS±F*JўџE 3ё§bЊPqTх;Ѓi§Н;d*.IЅкц+Нь{®4чїЩP¶!‡\јЭ‡бькў№ќ„Э‘ЕЬґІj2fy7:dо>µмu¬Гбkgkhж№љєr0иqЬW“йчУiљ„7ђc|G 0И> ЧЁЫьAС®mQ®нд\…Ф°чБљЊTdнdi‡”UоП"Ф<УЁ\    ШґЎ€lћхл~‘Ґрэ°eГ*г#Ўп^U=Ъя В@чq)u7Ec#vqЉцШl    …*ОУЫЪ¶©ІF+Y1qF)Ш¤¬Ж3NЕ!РHв“т)1@вђЊT”Т№4 МQJEЎ ГТ“ьQЉ`4
)ШўЂ51KЉZ*Jb”R *haуYЖмmRЯ•64/"§MЗс»]‚Е[»„ііћжO№?ЂНxdуЙsq$уЙ#cоkЧ|s?Ш<5z›†з"~§џРт¶ље%XTіG‘Ѕ”u5СE§dgS{ЪбA=Н3нGЫъХz+{#;“,нй4+Ў 
§ЬW»iwй©йvч©Ђ&@ДЗёьу^^ЈрЪоi4‹‹gFтг“(э№к?ЇгYХZ\Ё=NМЉLSИ¤®sV4ЉLTЦр›‹€вДШ©/ ЋTВKC"оBZНХЉЁ©хЧхи>Wk•1IТќF+RFRN¤"ЂiґуIЉ 
Е©ж¶–Э”L…
.бћвўЕ’’ј]РЪ°Ъ)ШўќДjРsх8ҐЕ:!ыФя xVrvM”‚XМRґdЊ©ЗМTчџсы7ыХ
M9SЊћн/ИmYґYія Y/јmPАЪ"я x:X%0LІ :ѓЬTл5ґmжG
пЂМ0
sФSЊҐhЯ™~:”¬ТЧcЃшЁfы-ёD&#pЕШtФюU‡рым\к·}ўж-€B˜;Ђчи
ф‹ы8u;I­n“МЉQ†щэk‹С~y:гЅЮЎ$QDБ­љ ?|“Ыќл¶
B’‹{ё№OC‘У<=ioiЄkЌ(Іі›мл 
'q/?(=Ђ$ФуxbчKљ[;K­6ъ2<ёZS:L    зж #­v_t»/
щЂ†=NYќ“ТE\йИ#сЇ.XЩХ™QЉ Л8Z(~щєЋOGmфУЛППѕ„Mr{¶ – u<WРV–Йie
јjc@ a_?Д3* 
…Л“Ъѕ† 9ЋЈЅm[ ©ЌпE\ѓюA·џTюuOµrB§3’мнш'ъ›5ktшюIзЮЁBмFsЃ“я ЦН:X3¦cМЋFЃІ66p§я ЇTЪv6лC㹤Љv‡~РuЪАчП*ќDхєУЙiїљїЮR’µ€iQwє®qёЃA§Cюѕ?ч‡у®№;&f·$ѕІk+ѓ;”т­лLёѓЙHNмщ‰ї§NkFb.®.lЫпщЊР“ШчЌTФXмБк!МЧ
у—$gї_=.џхФТQJнj{(ч±Ј}Моcм95\і№[KyеV_=°€ПНtЧrTЪ†пOїь€ЌЇ©-Мя Ъ2L~ь2“я nџ­fVќ¶ўdv†дЖ°ИҐX€АЗЎаzЦojП
Sж¦Х’Х|юо·ЪzЬiйEЉк Ц§!
кOb
0ТФµua–е{I¦i
L
фUfЫёнОЮЩлMўІҐISVMШ§+‹E&hНl!j†µtЦ5ЭЪFdxc.Є=GzЅљЕсqcб=OaБтOя ^„®мДфZр—ЉДљ    7PF\к@dАъъW9г{+€фг§иђEmm у'¶¶„)˜Ч=[µs~ЦGІХо3CHег'pQьл¦Чж‚юЬ2Lк›XоaЈ
ч\c¶~S\УўЎ_™-/э}ЗDZќ=w<›iVБЖ
{ц— 
ЦЪE¤ 
­4q*±^„Ѓ^tіC{*ЬУ#ќдњдзћ{ЧЅYЭ-еЊ(0ІЖ®¦FkР­І8йоНьKo>©ьк–h$ъх¦“\ђ‡+“опш%ъ·°¦’“4Рђ&…}’+zi№¤&†®¬іОeєyЖPіn=*KЫЦЅ‘ђ)UЪqЯЮЄ“IєіцPN.Ъ­Љжz…! ћ)№ЕjH¤жЋ”ЬТ“Е 
)№ўЂ63IљJ(мЉ°ђ/–ІK(Ќ[ос’j°лVЈљ…aќ[
ќ®ЅF}«
оi.Oќ··•КЌє‘MЊЌІ,ЂЊ‚*<љљxA\<oч[ЁjйIJ    §pjМ\Х=RЯнљUЭ°л,.ЈкEj•ЉЦ4Я’W°ДбGjl©¶жxWaR¦sЊф"іX„ЪvvnЧюµ)уЊіЫЪЬЫЖыcёeкИэEY‹^ѕ†КD‘Dp‰2 ќ®>eзЁпхҐс%џц€пнqЂ“їCИэ
eW§dОnf‰­mgЅ№K{hћiњб#A’ЗШWіxI˜шKNЯњ€ИзЩ€Ї:шyя #ц‘я ]Џю‚kУtXM®…gu€gсзъЧ=JЌФtы$юыя ‘pZ\С‘7ЪкUЅ¦Vхcя )?Э_эUЧ=є”г7Х&k%fРвqW!№3H‘GenМx)зхЄХтNџmґф™—џъfџвj1i-ЫЫъм‡Жj2@g     0Yж©“L'лHMkNО*7Ѕ‰“»ёвM4љnкµaw
з°ЖҐд#®?эtTљ„\џA%wb¶i¤Ф·°K№`';ѓк;~•iЖJQR[0jЪЭFкfhНP‡nў™љ(n–™љ3@Ръ°’[ХeG 
?‰_Ё5W4fўpSVїЬ4мYћetHгB±¦q“’IпPЋ”МСљ!К†ЭЛ·А±Ћaчё"’?ЭйУіp$*Яљ†+©aRЁЯ)к¤?ZlУЛ;##§µsFЌK*nЬ©­zиоґ·кUЦз‘|LµшЉ;Ђ0'„}Hгь+‹ЇGш©енТя з§п9цщkО+Ц¦пrЛs[Г:љиЮ%УхRЙБ˜ҐzРљч¶УЧ~RxEїgЮУ­|еn3sхp?ZчІШх®\M&ж§gkR––dчч
q{$©ч    Вэ ЕU-McLЭQ(EEl‹nодЃ°sVО±я ?Oщ𪩤ҝ(OгЉ~ЁJMlXёјћй”П!rјj
ФНФ›ЄЈЕZ*ИoV<µjЫ[я Д™я }Orг™nU}?Е&¦ёєyЦ%`Є±&Е
йYV§*–QvЦя wь--НZц{[Ђй!ЫеHИr2Ѕ9ъVNjD»uґ’Ч
QШ6OPGҐAљt!*qе—MЅ?­M7qщЈuGєЌХ№#ЙўЈ&Љ ЭЭKє”GKељ,wQєџеQеСaЬfпj7“Л G@\Њ’i2jo,Х–‰ІС¶ЌЮiпЊVsџ-јЭ†Џш‡xч>$6дь–С…ЬЂЗщЏК№
н<^Йq§Mu姘ڴСп’ЄЉ НquЧF|СфУо0–еќ9 
є•І­*ЏЦЅНЙЇрґ>‰ффя ¦Ўї!џй^К⦶иЁlBO4УJx¦“X–&}h&ђћi      ТRn¦о§`xЈ4Вi3EЂu!¦о¤-M вh¦Qљ }h GeдТ€ЄаJ<є *yX«’Ck‰Z;ђ1`д}©<јХЙ­ћ_)—nРЂX 
W%ЕJ<оЛ^¶*=LЫ‹A 
ЕAЬ¤§ФЏЙц­ќІHњЄЁP}qQyuµgN.{ШOr§•SЖ€цЖ    !ЅX‚GЎ©<є‚хЕµЌДнАЋ6b~‚ЄҐ55mЃ;    вKл?±Е§YЬэ«mМ·3LЄ–| «ћxЇЅsT¤ж’є©УPЌ‘‹w:_Gжx¶Ья qїсТ?­zМЉY¶ЁЙ' хжЯ
`у5ы‰qДvзџ©кЦ 
§Эµ¶Ѕґгх®|Tщ#)цW4¦®S—K№Pш14€2С,Ђ°JН&­iІHukS;МЈх<Ф;>Х7—ч7ќїLсXSsSp›ѕ—/ҐИ‰ҐF_1<МмИЭЏJLЪћ±лї!sЙq[5 Ќ{цє„JС[ЫЛ§¶Dl‘‚ vдrЦ°ОkrК+{
ѓp—Юd[Hт‚0gИиAпY‚ЩЏjеВ.Tв–љkfЇкџ^пМr+sSЙg2\G    Жй•БгжйR‹F­[›bu;6ЗHбюBµ©7$»?ВВHА–†g‰ѕт§ў›°ЦНе©kыѓЋІ7уЁЕџµiMуA6 
ЛJ_(ъV°ґ>”бgмjДdy'ТЉЪgТЉ к6Rм«]]XЉы(ЩнVvQ°Pm”»*ЖБFК ЇІ±|\юG„5ikg˜Зх®‡esЫЙр®Гјjї›ЁюґР3жъ(ў¶2;Џкй¶·т1i
(Ая к­Їn®зYc&2TЋµжЪЅЛЮ‡…”рG–МЫЋ•мюУЕНѕя "HКњкF~™®jЉт±ґ~’¤у°icќЖdL1хц…WM?ШЧLљjЃНH,PvиЖџВ¬
ЬзЗЪҐ[,
t"СaKцd…i`0E“zT‚ИъVЯ’ґyCТЋP1ЕќX1;И’67  qйТґ<ЎйG—IУ‹Х…ЩћЦюcі·V94ўФ
їІЌ”ФRV@Qы0§}њUЅ‚—`§a<ЃйE[ЫEGb—9нE0¶”Їґб@
ЫFЪw4P6Цv»¤Б­hЧ:}МFHе_єЇ дr=А­J(АҐшy)ю”чvЧ%а_o'nаЋjќ·Гл›нZ
{6a6$i°6Њg·ZчлН.ЛPek«uvOєЩ*ГсХ8|=ҐЫ]%Мp1љ3”v•›iьMgыОkЯCOЭтЪЪ”ґ_
Xи¶i 
H    QЙх5ІЄЈўсRi:U™ЌЕҐў˜
#4›iш¤ ‘IЉu% &)§QЊР¤Е8ТPb”ЉJ\жЂPh 
ФґQ@¤ўЉ uQE ґQ@
~‚˜zQE &)¦Љ(JJ(  в’Љ((ўЉ J(ўЂЉCE NфQ@
hўЉяЩ



П.С. Пример от JnK, почему-то не работает, он просто даже не пытается что либо послать. И еще не вкурил 
Код

ParamList - список переменных и значений (1. строка передменная, 2. данные)

строка предметная еще как-то понял, но что за данные???

Вобщем  smile 
Хелп пожалуйста!!!
PM MAIL   Вверх
Zlo
Дата 2.8.2010, 23:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 235
Регистрация: 18.9.2004

Репутация: нет
Всего: 1



Ну неужели никто не хочет помоч!!!!((((
PM MAIL   Вверх
Страницы: (2) [Все] 1 2 
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »


 




[ Время генерации скрипта: 0.0983 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.