Ошибка отправки файла Delphi Twebbrowser

Question

Я пытаюсь загрузить файлы с twebbrowser в Delphi 10.1 Berlin. Все в порядке, но когда я пытаюсь загрузить файлы Unicode, delphi дает мне ошибку «Переполнение при преобразовании варианта типа (Word) в тип (Byte)». Как я могу исправить файлы Unicode?

procedure UploadFilesHttpPost(const wb:TWebBrowser; const URLstring: string; names, values, nFiles, vFiles: array of string) ; 
    var 
    strData, n, v, boundary: string; 
    URL: OleVariant; 
    Flags: OleVariant; 
    PostData: OleVariant; 
    Headers: OleVariant; 
    idx: Integer; 

    ms: TMemoryStream; 
    ss: TStringStream; 
    List: TStringList; 
begin 
    if (Length(names) <> Length(values)) then 
    raise Exception.Create('UploadFilesHttpPost: Names and Values must have the same length.') ; 
    if (Length(nFiles) <> Length(vFiles)) then 
    raise Exception.Create('UploadFilesHttpPost: FileNames and FileValues must have the same length.') ; 

    URL := 'about:blank'; 
    Flags := NavNoHistory or NavNoReadFromCache or NavNoWriteToCache or NavAllowAutosearch; 
    wb.Navigate2(URL, Flags) ; 
    while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages; 

    // anything random that WILL NOT occur in the data. 
    boundary := '---------------------------123456789'; 

    strData := ''; 
    for idx := Low(names) to High(names) do 
    begin 
    n := names[idx]; 
    v := values[idx]; 

    strData := strData + '--' + boundary + #13#10 + 'Content-Disposition: form-data; name="' + n + '"' + #13#10#13#10 + v + #13#10; 
    end; 

    for idx := Low(nFiles) to High(nFiles) do 
    begin 
    n := nFiles[idx]; 
    v := vFiles[idx]; 

    strData := strData + '--' + boundary + #13#10 + 'Content-Disposition: form-data; name="' + n + '"; filename="' + v + '"' + #13#10; 

    if v = '' then 
    begin 
     strData := strData + 'Content-Transfer-Encoding: binary'#13#10#13#10; 
    end 
    else 
    begin 
     if (CompareText(ExtractFileExt(v), '.JPG') = 0) or (CompareText(ExtractFileExt(v), '.JPEG') = 0) then 
     begin 
     strData := strData + 'Content-Type: image/pjpeg'#13#10#13#10; 
     end 
     else if (CompareText(ExtractFileExt(v), '.PNG') = 0) then 
     begin 
     strData := strData + 'Content-Type: image/x-png'#13#10#13#10; 
     end 
     else if (CompareText(ExtractFileExt(v), '.PDF') = 0) then 
     begin 
     strData := strData + 'Content-Type: application/pdf'#13#10#13#10; 
     end 
     else if (CompareText(ExtractFileExt(v), '.HTML') = 0) then 
     begin 
     end; 

     strData := strData + 'Content-Type: text/html'#13#10#13#10; 


     ms := TMemoryStream.Create; 
     try 
     ms.LoadFromFile(v) ; 
     ss := TStringStream.Create('') ; 
     try 
      ss.CopyFrom(ms, ms.Size) ; 

      strData := strData + ss.DataString + #13#10; 
     finally 
      ss.Free; 
     end; 
     finally 
     ms.Free; 
     end;  
    end; 

    strData := strData + '--' + boundary + '--'#13#10; // FOOTER 
    end; 

    strData := strData + #0; 

    {2. you must convert a string into variant array of bytes and every character from string is a value in array} 
    PostData := VarArrayCreate([0, Length(strData) - 1], varByte) ; 

    { copy the ordinal value of the character into the PostData array} 
    for idx := 1 to Length(strData) do PostData[idx-1] := Ord(strData[idx]) ; 

    {3. prepare headers which will be sent to remote web-server} 
    Headers := 'Content-Type: multipart/form-data; boundary=' + boundary + #13#10; 

    {4. you must navigate to the URL with your script and send as parameters your array with POST-data and headers} 
    URL := URLstring; 
    wb.Navigate2(URL, Flags, EmptyParam, PostData, Headers) ; 
    while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages; 
end; 

procedure TForm1.Button6Click(Sender: TObject); 
begin 
UploadFilesHttpPost(
    WebBrowser1, 
    'http://www.example.com/upload.php', 
    [], 
    [], 
    ['fileupload'], 
    ['c:\test.jpg']); 

end; 

Проблема на копии появляется порядковое значение символа в массив PostData, но не знает, как справиться с этим.

Answer 1

Вы используете Unicode-версию Delphi, где string является псевдонимом для UnicodeString, который кодируется UTF-16.

Вы пытаетесь отправить двоичные 8-битные данные, используя строки Unicode, и это просто не сработает. Вместо этого вам нужно будет base64-кодировать двоичные данные и установить заголовок Content-Transfer-Encoding на base64 вместо binary. Однако не все HTTP-серверы поддерживают base64 в сообщении multipart/form-data.

С multipart/form-data может обрабатывать двоичные данные без использования base64, вы должны просто публиковать как фактические двоичные данные как есть, а не обрабатывать его как строки вообще. Избавьтесь от TStringStream в целом, а затем поместите все ваши данные MIME (текстовые и двоичные) в TMemoryStream, а затем преобразуйте их в массив байтов для отправки TWebBrowser.

Например:

procedure WriteStringToStream(Stream: TStream; const S: string); 
var 
    U: UTF8String; 
begin 
    U := UTF8String(S); 
    Stream.WriteBuffer(PAnsiChar(U)^, Length(U)); 
end; 

procedure WriteLineToStream(Stream: TStream; const S: string = ''); 
begin 
    WriteStringToStream(Stream, S); 
    WriteStringToStream(Stream, #13#10); 
end; 

procedure UploadFilesHttpPost(const wb:TWebBrowser; const URLstring: string; names, values, nFiles, vFiles: array of string) ; 
var 
    boundary, ext: string; 
    Flags, Headers, PostData: OleVariant; 
    idx: Integer; 
    ms: TMemoryStream; 
    fs: TFileStream; 
    Ptr: Pointer; 
begin 
    if Length(names) <> Length(values) then 
    raise Exception.Create('UploadFilesHttpPost: Names and Values must have the same length.') ; 
    if Length(nFiles) <> Length(vFiles) then 
    raise Exception.Create('UploadFilesHttpPost: FileNames and FileValues must have the same length.') ; 

    Flags := NavNoHistory or NavNoReadFromCache or NavNoWriteToCache or NavAllowAutosearch 

    wb.Navigate2('about:blank', Flags); 
    while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages; 

    // anything random that WILL NOT occur in the data. 
    boundary := '---------------------------123456789'; 

    ms := TMemoryStream.Create; 
    try 
    for idx := Low(names) to High(names) do 
    begin 
     WriteLineToStream(ms, '--' + boundary); 
     WriteLineToStream(ms, 'Content-Disposition: form-data; name=' + AnsiQuotedStr(names[idx], #34)); 
     WriteLineToStream(ms); 
     WriteLineToStream(values[idx]); 
    end; 

    for idx := Low(nFiles) to High(nFiles) do 
    begin 
     WriteLineToStream(ms, '--' + boundary); 
     WriteLineToStream(ms, 'Content-Disposition: form-data; name=' + AnsiQuotedStr(nFiles[idx], #34) + '; filename=' + AnsiQuotedStr(ExtractFileName(vFiles[idx]), #34)); 
     WriteLineToStream(ms, 'Content-Transfer-Encoding: binary');  

     WriteStringToStream(ms, 'Content-Type: '); 
     ext := ExtractFileExt(vFiles[idx]); 
     if SameText(ext, '.JPG') or SameText(ext, '.JPEG') then 
     begin 
     WriteStringToStream(ms, 'imag/pjpeg'); 
     end 
     else if SameText(ext, '.PNG') then 
     begin 
     WriteStringToStream(ms, 'image/x-png'); 
     end 
     else if SameText(ext, '.PDF') then 
     begin 
     WriteStringToStream(ms, 'application/pdf'); 
     end 
     else if SameText(ext, '.HTML') then 
     begin 
     WriteStringToStream(ms, 'text/html'); 
     end else 
     begin 
     WriteStringToStream(ms, 'application/octet-stream'); 
     end; 
     WriteLineToStream(ms); 

     WriteLineToStream(ms); 

     fs := TFileStream.Create(vFiles[idx], fmOpenRead or fmShareDenyWrite); 
     try 
     ms.CopyFrom(fs, 0); 
     finally 
     fs.Free; 
     end; 

     WriteLineToStream(ms); 
    end; 

    WriteLineToStream('--' + boundary + '--'); 

    PostData := VarArrayCreate([0, ms.Size-1], varByte); 
    Ptr := VarArrayLock(PostData); 
    try 
     Move(ms.Memory^, Ptr^, ms.Size); 
    finally 
     VarArrayUnlock(PostData); 
    end; 
    finally 
    ms.Free; 
    end; 

    Headers := 'Content-Type: multipart/form-data; boundary=' + boundary + #13#10; 

    wb.Navigate2(URLstring, Flags, EmptyParam, PostData, Headers); 
    while (wb.ReadyState <> READYSTATE_COMPLETE) or (wb.busy) do Application.ProcessMessages; 
end; 

procedure TForm1.Button6Click(Sender: TObject); 
begin 
    UploadFilesHttpPost(
    WebBrowser1, 
    'http://www.example.com/upload.php', 
    [], 
    [], 
    ['fileupload'], 
    ['c:\test.jpg'] 
); 
end; 

Это, как говорится, TWebBrowser является визуальный компонент, вы действительно не должны использовать его таким образом, чтобы начать с. Лучший вариант был бы использовать невизуальный HTTP компонент/библиотеку вместо этого, например, как TIdHTTP компонента Инди:

uses 
    IdHTTP, IdMultipartFormDataStream; 

procedure UploadFilesHttpPost(const URLstring: string; names, values, nFiles, vFiles: array of string) ; 
var 
    idx: Integer; 
    HTTP: TIdHTTP; 
    PostData: TIdMultipartFormDataStream; 
begin 
    if Length(names) <> Length(values) then 
    raise Exception.Create('UploadFilesHttpPost: Names and Values must have the same length.') ; 
    if Length(nFiles) <> Length(vFiles) then 
    raise Exception.Create('UploadFilesHttpPost: FileNames and FileValues must have the same length.') ; 

    HTTP := TIdHTTP.Create; 
    try 
    PostData := TIdMultipartFormDataStream.Create; 
    try 
     for idx := Low(names) to High(names) do 
     begin 
     PostData.AddFormField(names[idx], values[idx]); 
     end; 
     for idx := Low(nFiles) to High(nFiles) do 
     begin 
     PostData.AddFile(nFiles[idx], vFiles[idx]); 
     end; 
     HTTP.Post(URLstring, PostData); 
    finally 
     PostData.Free; 
    end; 
    finally 
    HTTP.Free; 
    end; 
end; 

procedure TForm1.Button6Click(Sender: TObject); 
begin 
    UploadFilesHttpPost(
    'http://www.example.com/upload.php', 
    [], 
    [], 
    ['fileupload'], 
    ['c:\test.jpg'] 
); 
end;