Delphi. Отправка файла на гейт.

[slesh]

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


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

Гейт представляет собой скрипт

<?
$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]

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

[slesh]

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

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

[mobilka]

вставил всю эту беду а делфи вот так-
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]

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

[mobilka]

код вставляется после implementation
учи Delphi или хотябы смотри как это она сама делает.
здорово. скомпилилось и получилась пустая форма. так и должно быть?
может хоть окошко какое куда файл вставлять и кнопка send?
я уже не говорю о прогрессбаре...

[mobilka]

автор ну чего молчишь?

[Nightmarе]

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

[slesh]

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

[mobilka]

вообщем спасибо Nightmarе помог наладить

[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]

господа помогите теперь сделать что бы не руками путь к загружаемому файлу писать а через опендиалог загружать и отправлять. сделал так-
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е]

по-хорошему вот так делать не айс
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]

пришла идея-
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]

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]

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

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

[Chrome~]

Вы задаете какие то нюбийские вопросы. Если вы изучали 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е]

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

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

[Chrome~]

Давайте уж тогда пофилософствуем как отправить на сервер файл больше чем позволяют настройки php “upload_max_filesize» и «post_max_size».
Никак, наверное. Хотя, может быть есть способ.
Мой вариант, отправлять файл по кускам, например по 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]

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

Если на сервере стоит наш скрипт... что нам стоит попдправиьт его вот так.

<?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]

пришла идея-
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$]

Всё работает. Респект!

[slesh]

мдауж

procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
SendFile('localhost', '/1.php', opendialog1.FileName);
end;
end;

[Nightmarе]

мдауж

procedure TForm1.Button2Click(Sender: Tlol);
begin
if OpenDialog1.Execute then
begin
SendFile('localhost', '/1.php', opendialog1.FileName);
end;
end;

Щас он к тебе в аську постучит :LOL:

[mobilka]

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

[mobilka]

ну неужели никто не поможет?

[Nightmarе]

ну неужели никто не поможет?
Сын мой! Молись усерднее всевышнему, если на тебе нет греха, Аллах не оставит тебя....

[mobilka]

ну дык чего так никто и не поможет?

[Gar|k]

осталось прикрутить прогрессбар но это не в моих силах ))))) сполз под стол ROFL

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

[Nightmarе]

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

[mobilka]

))))) сполз под стол ROFL

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

[Gar|k]

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

min,max,position

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

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

RTFM!!!

[intNet]

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

[xaker-boss]

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

[vvs777]

+1 ТС респект код хороший

учи Delphi или хотябы смотри как это она сама делает.

людям, задающим подобные вопросы надо описывать все начиная от Файл-создать-приложение итд...