Delphi Twebbrowser投稿アップロードファイルが失敗する

Question

tweebrowserでDelphi 10.1 Berlinにファイルをアップロードしようとしています。すべてが大丈夫ですが、ユニコードファイルを読み込もうとすると、delphiは "タイプ（Word）の型をバイト（Byte）に変換中にオーバーフロー"というエラーを表示しています。 ユニコードファイルの修正方法を教えてください。

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ビットデータを投稿しようとしていますが、それは単に動作しません。代わりに、バイナリデータをbase64エンコードし、の代わりにContent-Transfer-Encodingヘッダーをbase64に設定する必要があります。ただし、すべてのHTTPサーバーがmultipart/form-dataの投稿にbase64をサポートするわけではありません。

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はあなたが本当にで始まるように、このようにそれを使用すべきではない、ビジュアルコンポーネントです。

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;