Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей.
Здесь обсуждаются безопасность, программирование, технологии и многое другое.
Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
 |
|
Delphi. Отправка файла на гейт. |

16.10.2009, 12:19
|
|
Reservists Of Antichat - Level 6
Регистрация: 05.03.2007
Сообщений: 1,985
Провел на форуме: 3288241
Репутация:
3349
|
|
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;
Последний раз редактировалось slesh; 16.10.2009 в 13:44..
|
|
|

16.10.2009, 13:22
|
|
Познающий
Регистрация: 13.10.2009
Сообщений: 63
Провел на форуме: 373897
Репутация:
13
|
|
можно пояснить как запихнуть код в делфи и последний код совсем не понятен. куда его пихать?
|
|
|

16.10.2009, 13:35
|
|
Reservists Of Antichat - Level 6
Регистрация: 05.03.2007
Сообщений: 1,985
Провел на форуме: 3288241
Репутация:
3349
|
|
s := SendFile('localhost', '/1.php', 'c:\test.txt');
возвращет ответ.
первый параметр - адрес сервера - host / ip
второй - путь и имя скрипта на который посылается файл.
третий - локальный файл который будет посылаться.
Юзать как? - вставляй куда угодно и юзай. Всё расписано.
|
|
|

16.10.2009, 13:39
|
|
Познающий
Регистрация: 13.10.2009
Сообщений: 63
Провел на форуме: 373897
Репутация:
13
|
|
вставил всю эту беду а делфи вот так-
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'
|
|
|

16.10.2009, 13:51
|
|
Reservists Of Antichat - Level 6
Регистрация: 05.03.2007
Сообщений: 1,985
Провел на форуме: 3288241
Репутация:
3349
|
|
код вставляется после implementation
учи Delphi или хотябы смотри как это она сама делает.
|
|
|

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

16.10.2009, 14:31
|
|
Познающий
Регистрация: 13.10.2009
Сообщений: 63
Провел на форуме: 373897
Репутация:
13
|
|
автор ну чего молчишь?
|
|
|

16.10.2009, 14:50
|
|
Познавший АНТИЧАТ
Регистрация: 29.04.2007
Сообщений: 1,189
Провел на форуме: 5749763
Репутация:
1680
|
|
Огромнейший респект!!!!!!!!!!!! Давно с этим вопросом мучались с дружбаном. Всё работает отлично.
|
|
|

16.10.2009, 14:52
|
|
Reservists Of Antichat - Level 6
Регистрация: 05.03.2007
Сообщений: 1,985
Провел на форуме: 3288241
Репутация:
3349
|
|
>>> учи Delphi или хотябы смотри как это она сама делает. <<<
Этим всё сказано. Учить людей умножению я не собираюсь )
Зачем тебе лезть в это, если ты не знаеш самый элементарных вещей.
|
|
|

16.10.2009, 16:40
|
|
Познающий
Регистрация: 13.10.2009
Сообщений: 63
Провел на форуме: 373897
Репутация:
13
|
|
вообщем спасибо Nightmarе помог наладить
|
|
|
|
 |
|
Похожие темы
|
| Тема |
Автор |
Раздел |
Ответов |
Последнее сообщение |
|
Литература Delphi
|
Sams |
С/С++, C#, Delphi, .NET, Asm |
2 |
19.03.2010 19:46 |
|
Books
|
PSalm69 |
Избранное |
248 |
27.10.2009 04:52 |
|
Virus.Win32.Induc.a или "Снова записки новичка"
|
_=(mac)=_ |
Защита ОС: вирусы, антивирусы, файрволы. |
5 |
24.08.2009 23:34 |
|
Форма и javascript, отправка файла
|
rcc0023 |
PHP, PERL, MySQL, JavaScript |
9 |
24.08.2009 16:19 |
|
Процесс создания программного обеспечения для распределенных вычислений (С++).
|
c0n Difesa |
Авторские статьи |
9 |
09.06.2009 16:33 |
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|