Форум АНТИЧАТ

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)
-   С/С++, C#, Delphi, .NET, Asm (https://forum.antichat.xyz/forumdisplay.php?f=24)
-   -   Delphi. Отправка файла на гейт. (https://forum.antichat.xyz/showthread.php?t=148711)

slesh 16.10.2009 12:19
Delphi. Отправка файла на гейт.
 
Вот друг попросил помочь с функций отправки файла на сервер. По-быстрому навоял функцию. Думаю что она будет полезна и другим людям.


Работает всё на WinAPI + WinSock. Можно отправлять файлы до 2 гигов (не напряжно на память). После отправки файла функция возвращает страницу которую выдал сервак (с учетом HTTP заголовка)

Гейт представляет собой скрипт
PHP код:
<?
    $myfile = $_FILES['myfile']['tmp_name'];
    $name = basename($_FILES['myfile']['name']);

    if (!file_exists($myfile))
    {
        echo "error";
    }
    else
    {
        move_uploaded_file($myfile, $name);
        echo "ok";
    }

?>
Код функции:
Код:

uses winsock;

function SendFile(host, script, filename:string):string;
var
  sock : dword;
  ca : sockaddr_in;
  HTTPHeader : string;
  boundary : string;
  fs:dword;
  hFile : DWORD;
  buf : array [0..4095] of char;
  p : PHostEnt;
  rb : cardinal;
  len : integer;
  SubHeader1 : string;
  SubHeader2 : string;
begin
  result := '';
  // открываем файл на чтение
  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)); // получим ip по домену
      if p = nil then // если нету
      begin
        // значит это IP
        ca.sin_addr.s_addr := inet_addr(pchar(host));
      end
      else
      begin
        // выдерим ip
        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);
          // создаем части HTTP заголовка
        SubHeader1 :=  '--'+boundary+#13#10+
                      'Content-Disposition: form-data; name="myfile"; 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;
          // читаем 4 кила из файла
          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 // если есть чтото
          begin
            result := result + copy(buf, 0, len);
          end
          else
          begin // если нет больше данных то выходим из цикла
            break;
          end;
        end;
      end;
      closesocket(sock); // закрываем сокет
    end;
    CloseHandle(hFile); // закрываем файл
  end;
end;
Юзать это можно так:
Код:
var
  ws : TWSAData;
  s : string;
begin
  WSAStartup($101, ws);
  s := SendFile('localhost', '/1.php', 'c:\test.txt');
  ShowMessage(s);
end;

mobilka 16.10.2009 13:22
можно пояснить как запихнуть код в делфи и последний код совсем не понятен. куда его пихать?

slesh 16.10.2009 13:35
s := SendFile('localhost', '/1.php', 'c:\test.txt');
возвращет ответ.
первый параметр - адрес сервера - host / ip
второй - путь и имя скрипта на который посылается файл.
третий - локальный файл который будет посылаться.

Юзать как? - вставляй куда угодно и юзай. Всё расписано.

mobilka 16.10.2009 13:39
вставил всю эту беду а делфи вот так-
Цитата:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, winsock;
function SendFile(host, script, filename:string):string;
var
sock : dword;
ca : sockaddr_in;
HTTPHeader : string;
boundary : string;
fs:dword;
hFile : DWORD;
buf : array [0..4095] of char;
p : PHostEnt;
rb : cardinal;
len : integer;
SubHeader1 : string;
SubHeader2 : string;
begin
result := '';
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
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="myfile"; 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
begin
result := result + copy(buf, 0, len);
end
else
begin
break;
end;
end;
end;
closesocket(sock);
end;
CloseHandle(hFile);
end;
end;
type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

end.
ошибку при компиляции дает -
Цитата:
[Error] Unit1.pas(22): Statements not allowed in interface part
[Error] Unit1.pas(23): Undeclared identifier: 'result'
[Error] Unit1.pas(24): Undeclared identifier: 'filename'
[Warning] Unit1.pas(30): Comparison always evaluates to True
[Error] Unit1.pas(35): Undeclared identifier: 'host'
[Error] Unit1.pas(53): Undeclared identifier: 'script'
[Error] Unit1.pas(54): Incompatible types: 'String' and 'Integer'
[Warning] Unit1.pas(57): Combining signed and unsigned types - widened both operands
[Error] Unit1.pas(8): Unsatisfied forward or external declaration: 'SendFile'
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'

slesh 16.10.2009 13:51
код вставляется после implementation
учи Delphi или хотябы смотри как это она сама делает.

mobilka 16.10.2009 13:56
Цитата:
Сообщение от slesh
код вставляется после implementation
учи Delphi или хотябы смотри как это она сама делает.
здорово. скомпилилось и получилась пустая форма. так и должно быть?
может хоть окошко какое куда файл вставлять и кнопка send?
я уже не говорю о прогрессбаре...

mobilka 16.10.2009 14:31
автор ну чего молчишь?

Nightmarе 16.10.2009 14:50
Огромнейший респект!!!!!!!!!!!! Давно с этим вопросом мучались с дружбаном. Всё работает отлично.

slesh 16.10.2009 14:52
>>> учи Delphi или хотябы смотри как это она сама делает. <<<
Этим всё сказано. Учить людей умножению я не собираюсь )
Зачем тебе лезть в это, если ты не знаеш самый элементарных вещей.

mobilka 16.10.2009 16:40
вообщем спасибо Nightmarе помог наладить

Hellsp@wn 16.10.2009 16:59
по-хорошему вот так делать не айс
Код:
        while true do
        begin
          rb := 0;
          // читаем 4 кила из файла
          ReadFile(hFile, buf, 4096, rb, nil);
          if rb = 0 then break; // если не считалось то выход из цикла
          send(sock, buf, rb, 0); // пошлем считанные данные
        end;
далеко не факт что удасться отправить за раз 4096 :)

mobilka 16.10.2009 17:00
господа помогите теперь сделать что бы не руками путь к загружаемому файлу писать а через опендиалог загружать и отправлять. сделал так-
Цитата:
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
Listbox1.Items.Add(ExtractFileName(opendialog1.Fil eName));
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Listbox1.Clear;
end;
button2 вызывает опендиалог. имя выбранного файла отображается в листбоксе. button3 очищает листбокс если был выбран не тот файл. а вот как сделать что бы s := SendFile('localhost', '/1.php', 'c:\test.txt'); тут менялось ума не приложу

Nightmarе 16.10.2009 17:07
Цитата:
Сообщение от Hellsp@wn
по-хорошему вот так делать не айс
Код:
        while true do
        begin
          rb := 0;
          // читаем 4 кила из файла
          ReadFile(hFile, buf, 4096, rb, nil);
          if rb = 0 then break; // если не считалось то выход из цикла
          send(sock, buf, rb, 0); // пошлем считанные данные
        end;
далеко не факт что удасться отправить за раз 4096 :)
что рекомендуешь?

mobilka 16.10.2009 17:15
пришла идея-
s := SendFile('localhost', '/1.php', 'тут переменная какаято');
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
Listbox1.Items.Add(ExtractFileName(opendialog1.Fil eName));
тоже чтото надо дописать
end;
end;
господа не стесняемся предлагаем решение
может поможет кто?

slesh 16.10.2009 17:37
2 Hellsp@wn если бы да кабы. По хорошему нужно обрабатывать что разорвалась связь с серваком, а также что не удалось считать файл. итд итп. А друг юзверь вообще комп ребутнул. 4 кила полюбому уйдут в ядро, и send вернет это кол-во. другое дело, что не факт что они по сети передадутся.

хотя по хорошему достаточно просто подправить: Но всё равно это лишнее.
Код:

  wb := 0;
  error_flag := false;
  while wb < rb do
  begin
    len := send(sock, pointer(dword(@buf[0]) + wb)^, rb - wb, 0);   
    if len < 1 then
    begin
      error_flag := true;
      break;
    end;
    wb := wb + len;
  end;
 if error_flag then break;

ErrorNeo 16.10.2009 17:38
уважаемые.
этот код предполагает наличие у того, кто его пытается понять хотя бы основ знаний языка - на уровне "Delphi для самых начинающих".

Если вы вообще никогда не видели этого языка в глаза - не задавайте идиотских вопросов.

Chrome~ 16.10.2009 17:41
Вы задаете какие то нюбийские вопросы. Если вы изучали Delphi, то должны понимать, как вызвать эту функцию. К тому же автор все детально описал.
Цитата:
далеко не факт что удасться отправить за раз 4096
Почему не факт? Все будет нормально, если делать, скажем, так:
Код:
        while true do
        begin
          rb := 0;
          // читаем 4 кила из файла
          ReadFile(hFile, buf, 4096, rb, nil);
          if rb = 0 then break; // если не считалось то выход из цикла
          if send(sock, buf, rb, 0) <> rb then break; // пошлем считанные данные
        end;
Спасибо за код, slesh. (+ не могу поставить пока что)

Уже давно спросить хотел, так как сам занимаюсь этим... По моему самым правильным вариантом было бы начинать делать отправку файла вместе с заголовком, так как делают браузеры. К примеру: составил заголовок, который занимает 200 байт. Если мы решили отправлять по 4096 байт, то, соответственно, 4096-200=3896 байт считываем из файла, и заносим в массив. Это честно говоря не особо легко реализовать, особенно когда используем формат Content-Type: multipart/form-data, так как после отправки файла, мы должны отправить еще boundary.

Nightmarе 16.10.2009 17:55
Давайте уж тогда пофилософствуем как отправить на сервер файл больше чем позволяют настройки php “upload_max_filesize» и «post_max_size».

Мой вариант, отправлять файл по кускам, например по 1 метру на один POST запрос, а дальше php скрипт всё это добро склеит. Ну к каждому POST запросу допустим можно указать части, типа 1 из 20 и т.д…
Способ очень геморный и неудобный. Собственно, кто может что получше предложить?

Chrome~ 16.10.2009 18:14
Цитата:
Сообщение от Nightmarе
Давайте уж тогда пофилософствуем как отправить на сервер файл больше чем позволяют настройки php “upload_max_filesize» и «post_max_size».
Никак, наверное. Хотя, может быть есть способ.
Цитата:
Сообщение от Nightmarе
Мой вариант, отправлять файл по кускам, например по 1 метру на один POST запрос, а дальше php скрипт всё это добро склеит. Ну к каждому POST запросу допустим можно указать части, типа 1 из 20 и т.д…
Способ очень геморный и неудобный. Собственно, кто может что получше предложить?
Нет, это не очень удобно, лучше файл отправлять одним POST запросом (как и делал slesh).

Но если нужно учитывать значения upload_max_filesize и post_max_size, тогда можно было бы:
1) Получить от сервака сессию, которою потом передавать снова назад на сервер в виде либо кукиса, либо как параметр POST запроса.
2) Отправлять файл как ты уже говорил, кусками по 1 Мб., при этом указывать номер части и свою сессию. Сессия нужна для того, чтобы сервак знал, в какой файл будем записывать полученные данные. То есть, когда сервак только генерирует сессию, он должен создать уникальный префикс для файла, (скажем file_name_777_). Потом передаем клиенту сессию. Когда клиент уже будет отправлять нам данные на сервер, он должен будет указывать свою сессию, а сервак в свою очередь будет создавать файлы вида file_name_777_номер_части_файла с соответствующем содержанием.

Когда отослали все части, я бы сделал следующее: отослал бы дополнительный POST запрос на скрипт, в котором указывал бы сессию, и количество частей, которое я отправил. Сервер должен проверить, есть ли все части файла (то есть, существуют ли файлы file_name_777_1...file_name_777_N). Если существуют, - объединить всех в один файл, сами части удалить.

Но это мой вариант, хочу выслушать ваши, если есть ограничения в upload_max_filesize и post_max_size.

Gar|k 16.10.2009 18:52
Цитата:
Сообщение от Nightmarе
Давайте уж тогда пофилософствуем как отправить на сервер файл больше чем позволяют настройки php “upload_max_filesize» и «post_max_size».
Если на сервере стоит наш скрипт... что нам стоит попдправиьт его вот так.

PHP код:
<?php
if(empty($_POST)){
   echo ini_get("upload_max_filesize")."\n".ini_get("post_max_size")."\n\0";
   }
...
и в программе сперва наперво отправлять GET запрос... так же на стороне сервера можно эти значения в байты перевести...

в своих клиентах я испольую вместо send и recv такие функции
Код:
// отослать ВСЕ ... - правильная функция
int sendall(SOCKET s, char *buf, int len, int flags)
{
    int total = 0;
    int n;

    while(total < len)
    {
        n = send(s, buf+total, len-total, flags);
        if(n == -1) { break; }
        total += n;
    }

    return (n==-1 ? -1 : total);
}

// принять ВСЕ ... - правильная функция
int recvall(SOCKET s, char *buf, int len, int flags)
{
    int total = 0;
    int n;

    while(total < len)
    {
        n = recv(s, buf+total, len-total, flags);
        if(n == -1) { break; }
        total += n;
    }

    return (n==-1 ? -1 : total);
}
ну и + к этому можно сокету задать время жизни... при обрыве связи на строне сервака через некоторое время он сам откинется.

mobilka 16.10.2009 19:01
Цитата:
Сообщение от mobilka
пришла идея-
s := SendFile('localhost', '/1.php', 'тут переменная какаято');
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
Listbox1.Items.Add(ExtractFileName(opendialog1.Fil eName));
тоже чтото надо дописать
end;
end;
господа не стесняемся предлагаем решение
может поможет кто?
может поможет кто?

$Atlet$ 16.10.2009 21:56
Всё работает. Респект!

slesh 16.10.2009 22:22
мдауж
Код:
procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
      SendFile('localhost', '/1.php', opendialog1.FileName);       
  end;
end;

Nightmarе 16.10.2009 23:36
Цитата:
Сообщение от slesh
мдауж
Код:
procedure TForm1.Button2Click(Sender: Tlol);
begin
  if OpenDialog1.Execute then
  begin
      SendFile('localhost', '/1.php', opendialog1.FileName);       
  end;
end;
Щас он к тебе в аську постучит :LOL:

mobilka 17.10.2009 14:43
вот господа кое как с помощью вышеотписавшегося человека придал ей божеский вид. сделал кнопку загрузки файла и даже полосу (edit) ввода хоста. осталось прикрутить прогрессбар но это не в моих силах. кто может это сделать вот вам исходники
http://webfile.ru/4012376

mobilka 17.10.2009 15:29
ну неужели никто не поможет?

Nightmarе 17.10.2009 15:42
Цитата:
Сообщение от mobilka
ну неужели никто не поможет?
Сын мой! Молись усерднее всевышнему, если на тебе нет греха, Аллах не оставит тебя....

mobilka 17.10.2009 18:33
ну дык чего так никто и не поможет?

Gar|k 17.10.2009 18:44
Цитата:
Сообщение от mobilka
осталось прикрутить прогрессбар но это не в моих силах
))))) сполз под стол ROFL

mobilka набери в поске - "delphi как прикрутить прогресс бар", а корректнее "delphi работа с прогресс баром" ну еще RTFM )

Nightmarе 17.10.2009 19:03
прикрутить прогрессбар несложно, берёшь гайку, отвёртки и прикручиваешь....
Если не можешь, обратись к сантехникам.

mobilka 17.10.2009 20:09
Цитата:
Сообщение от Gar|k
))))) сполз под стол ROFL

mobilka набери в поске - "delphi как прикрутить прогресс бар", а корректнее "delphi работа с прогресс баром" ну еще RTFM )
не могу найти что надо. помогите кто нибудь.

Gar|k 17.10.2009 21:12
mobilka, мда ппц... идешь в закладку win32 кидаешь на форму progress bar
у него есть параметры...

min,max,position

когда передавать файл собираешься смотришь размер файла и присваешь прогресс бару - ProgressBar1.max = размер файла...

далее где у тебя цикл отправки файла (send там и тд...) пишешь
ProgressBar1.postion = ProgressBar1.postion + количество отправленных байт (send возврщает скока байт было отправлено)

RTFM!!!

intNet 17.10.2009 22:43
mobilka, Если ты не знаешь основ языка, куда тебе работа с сокетами и т.п.?
Вопросы такого уровня здесь не задают.

xaker-boss 17.10.2009 23:40
блин. Сколько же я искал то кого метода:) Спасибо те, лови + - сы!

vvs777 18.10.2009 12:32
+1 ТС респект код хороший

Цитата:
учи Delphi или хотябы смотри как это она сама делает.
людям, задающим подобные вопросы надо описывать все начиная от Файл-создать-приложение итд...


Время: 00:38