WebBrowser, заполнение поля типа file на Delphi

При работе с компонентом WebBrowser часто возникает необходимость заполнять поля форм на сайте. С обычными полями формы никаких проблем нету, для их заполнения существуют стандартные методы, а вот поле с типом file браузер упорно отказывается заполнять. Причина этому — защита пользователей. Если бы браузер позволил свободно подставлять в это поле путь к файлу на компьютере пользователя, тогда с помощью простенького JavaScript встроенного в страницу сайта можно бы было легко увести любой файл.

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

Варианты решения проблемы

1. Заполнять все необходимые поля формы, кроме поля отправки файла и перехватывать событие отправки данных, модифицируя при этом POST. По сути просто дополнять запрос данными о нужном нам файле
2. Формировать и отправлять POST запрос вручную (без использования браузера) при этом не забыв о том, что необходимо взять все кукисы браузера, а после отправки запроса переписать новые их значения обратно в браузер

Второй вариант я отбросил сразу: очень много работы и подводных камней. Остановился на первом. Но и тут незадача: оказывается, что во время перехвата запроса нам отдают не весь запрос, а только ту часть, что идёт до того места, где должно быть содержимое файла не смотря на то, что поле мы не заполняли. Google подсказал, что это ошибка программистов Microsoft, которые делали COM объект, при чем в новых версиях эта ошибка так и не исправлена (тестировал на IE 9).

Еще немного пугуглив, я понял, что идеального решения этой проблемы нету (о готовых решениях я вообще молчу), потому единственным приемлемым вариантом есть полностью формировать POST запрос самому и отправлять его средствами браузера (получается некое совмещение первого и второго варианта решения проблемы), а чтобы в будущем это всё можно было удобно использовать, то решил сразу написать удобный класс для формирования и отправки таких запросов (ссылка на исходный код в конце статьи).

Разработка класса

Первым делом определил для себя схему работы класса. Вкратце она следующая: создание массива параметров, формирование запроса, отправка запроса. А так же описал структуру элемента массива параметров:

  TCustomPostParam = record
    name : string;
    value : string;

    filename : string;
    content_type : string;
  end;

Далее определился какие должны быть методы заполнения массива параметров. У меня получилось 3:

1. Добавление любых параметров — универсальный метод, который позволяет добавлять любые параметры, будь то текстовое поле либо файл
2. Добавление файлов — удобный метод для добавления файлов любого типа. Сам считает содержимое файла и отправит необходимые данные в предыдущий метод
3. Добавление текстовых файлов — метод для добавления текстовых файлов, единственное отличие от предыдущего, что он сам заполняет content type

Получилось следующее:

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('https://site.ru/import-file.php');
    CustomRequest.SetContentType('multipart/form-data');
    CustomRequest.POST();
  finally
    CustomRequest.Free();
  end;	
end;

Заключение

Ссылка на полный исходный код: pastebin.com/DgykYAxK
Ссылка на md5hash (для работы необходима библиотека DCPcrypt): pastebin.com/cTS3ttwZ

Класс работает под версией Delphi 2009+ (т.е. Unicode версия компилятора) и с компонентом EmbeddedWB (который я настоятельно рекомендую использовать вместо стандартного TWebBrowser).

Статья может пригодится не только делфистам, описанные в ней проблемы встречаются и в других языках программирования, которые используют COM объект Майкрософтовского браузера Internet Explorer, а само решение (при наличии некоторых навыков) не сложно перевести на другой язык.

Автор: xpert13