- PVSM.RU - https://www.pvsm.ru -
При работе с компонентом WebBrowser часто возникает необходимость заполнять поля форм на сайте. С обычными полями формы никаких проблем нету, для их заполнения существуют стандартные методы, а вот поле с типом file браузер упорно отказывается заполнять. Причина этому — защита пользователей. Если бы браузер позволил свободно подставлять в это поле путь к файлу на компьютере пользователя, тогда с помощью простенького JavaScript встроенного в страницу сайта можно бы было легко увести любой файл.
Но так как программа использующая браузер и так имеет доступ к пользовательским файлам, теоретически, такая защита не должна была бы срабатывать против неё. Но имеем то, что имеем, а потому необходимо искать обходные пути.
Второй вариант я отбросил сразу: очень много работы и подводных камней. Остановился на первом. Но и тут незадача: оказывается, что во время перехвата запроса нам отдают не весь запрос, а только ту часть, что идёт до того места, где должно быть содержимое файла не смотря на то, что поле мы не заполняли. Google подсказал, что это ошибка программистов Microsoft, которые делали COM объект, при чем в новых версиях эта ошибка так и не исправлена (тестировал на IE 9).
Еще немного пугуглив, я понял, что идеального решения этой проблемы нету (о готовых решениях я вообще молчу), потому единственным приемлемым вариантом есть полностью формировать POST запрос самому и отправлять его средствами браузера (получается некое совмещение первого и второго варианта решения проблемы), а чтобы в будущем это всё можно было удобно использовать, то решил сразу написать удобный класс для формирования и отправки таких запросов (ссылка на исходный код в конце статьи).
Первым делом определил для себя схему работы класса. Вкратце она следующая: создание массива параметров, формирование запроса, отправка запроса. А так же описал структуру элемента массива параметров:
TCustomPostParam = record
name : string;
value : string;
filename : string;
content_type : string;
end;
Далее определился какие должны быть методы заполнения массива параметров. У меня получилось 3:
Получилось следующее:
function TCustomPostDataSender.AddParam(name, value: string; content_type : string = ''; filename : string = ''):integer;
var
h : integer;
begin
SetLength(FParams, Count() + 1);
h := high(FParams);
FParams[h].name := name;
FParams[h].value := value;
FParams[h].content_type := content_type;
FParams[h].filename := filename;
CheckBoundary(name + ' ' + value + ' ' + content_type);
result := h;
end;
procedure TCustomPostDataSender.AddFile(name, path, file_content_type: string);
var
s : TStringStream;
buf : string;
begin
if not FileExists(path) then exit;
file_content_type := Trim(file_content_type);
if file_content_type = '' then file_content_type := 'text/plain';
s := TStringStream.Create;
try
s.LoadFromFile(path);
buf := s.DataString;
if Pos('text', LowerCase(file_content_type)) = 1 then CheckUTF8(buf);
AddParam(name, buf, file_content_type, ExtractFileName(path));
finally
s.Free;
end;
end;
procedure TCustomPostDataSender.AddTextFile(name, path: string);
begin
if not FileExists(path) then exit;
if LowerCase(ExtractFileExt(path)) = '.xml'
then AddFile(name, path, 'text/xml')
else AddFile(name, path, 'text/plain');
end;
Дальше дело за написанием функции формирования и отправки запроса. У меня получилась такая:
function TCustomPostDataSender.POST():integer;
var
sURL, sFlags, sTargetFrame, sPostData, sHeaders : OleVariant;
i : integer;
buf : string;
begin
Result := 1;
if FURL = '' then exit;
try
sURL := FURL;
sFlags := 64; // Значение этого флага мне не известно, но браузер использует всегда именно такое
sHeaders := FGetHeader();
buf := '';
for i := 0 to Count() - 1 do
begin
if i = 0 then buf := buf + '--' + FBoundary + sLineBreak;
buf := buf + 'Content-Disposition: form-data; name="'+ FParams[i].name +'"';
// Если файл
if FParams[i].filename <> ''
then buf := buf + '; filename="'+ FParams[i].filename +'"' + sLineBreak + 'Content-Type: ' + FParams[i].content_type;
buf := buf + sLineBreak + sLineBreak;
buf := buf + FParams[i].value + sLineBreak;
buf := buf + '--' + FBoundary;
if i = Count() - 1 then buf := buf + '--';
buf := buf + sLineBreak;
end;
sPostData := StringToVariantArray(buf);
WB.Navigate2(sURL, sFlags, sTargetFrame, sPostData, sHeaders);
Clear();
Result := 0;
except
Result := 999;
end;
end;
Вдаваться в подробности остальных методов не буду, кому интересно может более детально изучить исходник всего класса. Скажу только, что метод вполне самодостаточный: сам следит за правильностью и уникальностью Boundary, сам формирует необходимые заголовки и сам переводит все данные в нужный тип.
Что касается возвращаемого значения, то лучше бы было сделать тип boolean, так как в данном случае функция возвращает 0 если запрос отправлен и 999 — если были ошибки (ко всему прочему еще и не даёт показать пользователю текст ошибки, что тоже очень плохо), но в своё оправдание скажу, что разрабатывался этот метод с заделом на будущее — где каждая ошибка имеет свой код, который и возвращается, а уже по этому коду программа должна определить как действовать и что сообщать пользователю. В любом случае поменять это не составит труда даже начинающему программисту.
var
CustomRequest : TCustomPostDataSender;
begin
CustomRequest := TCustomPostDataSender.Create(WebBrowser);
try
CustomRequest.AddTextFile('import', FILE_PATH);
CustomRequest.AddParam('action', 'save');
CustomRequest.AddParam('submit', 'Import');
CustomRequest.SetURL('http://site.ru/import-file.php');
CustomRequest.SetContentType('multipart/form-data');
CustomRequest.POST();
finally
CustomRequest.Free();
end;
end;
Ссылка на полный исходный код: pastebin.com/DgykYAxK [1]
Ссылка на md5hash (для работы необходима библиотека DCPcrypt [2]): pastebin.com/cTS3ttwZ [3]
Класс работает под версией Delphi 2009+ (т.е. Unicode версия компилятора) и с компонентом EmbeddedWB (который я настоятельно рекомендую использовать вместо стандартного TWebBrowser).
Статья может пригодится не только делфистам, описанные в ней проблемы встречаются и в других языках программирования, которые используют COM объект Майкрософтовского браузера Internet Explorer, а само решение (при наличии некоторых навыков) не сложно перевести на другой язык.
Автор: xpert13
Сайт-источник PVSM.RU: https://www.pvsm.ru
Путь до страницы источника: https://www.pvsm.ru/delphi/6815
Ссылки в тексте:
[1] pastebin.com/DgykYAxK: http://pastebin.com/DgykYAxK
[2] DCPcrypt: http://www.cityinthesky.co.uk/opensource/dcpcrypt
[3] pastebin.com/cTS3ttwZ: http://pastebin.com/cTS3ttwZ
Нажмите здесь для печати.