Use TOpenTextFileDialog instead of TOpenDialog for two places where we load SQL and text cell contents. That dialog has an additional "Encoding" dropdown, where the user can select the file's encoding, which can be required if the auto detection did not succeed. Fixes issue #2025.

2025-08-26 20:00:16 +08:00 · 2010-06-20 10:05:37 +00:00
parent bd3c391b39
commit d436df314a
5 changed files with 90 additions and 88 deletions
--- a/source/helpers.pas
+++ b/source/helpers.pas
@ -29,8 +29,6 @@ type
  TVTreeDataArray = Array of TVTreeData;
  PVTreeDataArray = ^TVTreeDataArray;

-  TFileCharset = (fcsAnsi, fcsUnicode, fcsUnicodeSwapped, fcsUtf8);
-
  TOrderCol = class(TObject)
    ColumnName: String;
    SortDirection: Byte;
@ -123,10 +121,10 @@ type
  function GetTempDir: String;
  procedure SetWindowSizeGrip(hWnd: HWND; Enable: boolean);
  procedure SaveUnicodeFile(Filename: String; Text: String);
-  procedure OpenTextFile(const Filename: String; out Stream: TFileStream; out FileCharset: TFileCharset);
-  function GetFileCharset(Stream: TFileStream): TFileCharset;
-  function ReadTextfileChunk(Stream: TFileStream; FileCharset: TFileCharset; ChunkSize: Int64 = 0): String;
-  function ReadTextfile(Filename: String): String;
+  procedure OpenTextFile(const Filename: String; out Stream: TFileStream; var Encoding: TEncoding);
+  function DetectEncoding(Stream: TStream): TEncoding;
+  function ReadTextfileChunk(Stream: TFileStream; Encoding: TEncoding; ChunkSize: Int64 = 0): String;
+  function ReadTextfile(Filename: String; Encoding: TEncoding): String;
  function ReadBinaryFile(Filename: String; MaxBytes: Int64): AnsiString;
  procedure StreamToClipboard(Text, HTML: TStream; CreateHTMLHeader: Boolean);
  function WideHexToBin(text: String): AnsiString;
@ -1924,23 +1922,27 @@ end;
 {**
  Open a textfile unicode safe and return a stream + its charset
 }
-procedure OpenTextFile(const Filename: String; out Stream: TFileStream; out FileCharset: TFileCharset);
+procedure OpenTextFile(const Filename: String; out Stream: TFileStream; var Encoding: TEncoding);
 begin
  Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone);
  Stream.Position := 0;
-  FileCharset := GetFileCharset(Stream);
+  if Encoding = nil then
+    Encoding := DetectEncoding(Stream)
+  else
+    Stream.Position := Length(Encoding.GetPreamble);
 end;


 {**
-  Detect a file's character set which can be
-  UTF-16 BE with BOM
-  UTF-16 LE with BOM
-  UTF-8 with or without BOM
-  ANSI
+  Detect stream's content encoding by examing first 100k bytes (MaxBufferSize). Result can be:
+    UTF-16 BE with BOM
+    UTF-16 LE with BOM
+    UTF-8 with or without BOM
+    ANSI
+  Aimed to work better than WideStrUtils.IsUTF8String() which didn't work in any test case here.
  @see http://en.wikipedia.org/wiki/Byte_Order_Mark
 }
-function GetFileCharset(Stream: TFileStream): TFileCharset;
+function DetectEncoding(Stream: TStream): TEncoding;
 var
  ByteOrderMark: Char;
  BytesRead: Integer;
@ -1968,6 +1970,7 @@ const
      inc(i);
    end;
  end;
+
 begin
  // Byte Order Mark
  ByteOrderMark := #0;
@ -1985,11 +1988,11 @@ begin
  end;
  // Test Byte Order Mark
  if ByteOrderMark = UNICODE_BOM then
-    Result := fcsUnicode
+    Result := TEncoding.Unicode
  else if ByteOrderMark = UNICODE_BOM_SWAPPED then
-    Result := fcsUnicodeSwapped
+    Result := TEncoding.BigEndianUnicode
  else if Utf8Test = UTF8_BOM then
-    Result := fcsUtf8
+    Result := TEncoding.UTF8
  else begin
    { @note Taken from SynUnicode.pas }
    { If no BOM was found, check for leading/trailing byte sequences,
@ -2002,10 +2005,7 @@ begin
            US-ASCII chars, like usual in European languages. }

    // if no special characteristics are found it is not UTF-8
-    Result := fcsAnsi;
-
-    // if Stream is nil, let Delphi raise the exception, by accessing Stream,
-    // to signal an invalid result
+    Result := TEncoding.Default;

    // start analysis at actual Stream.Position
    BufferSize := Min(MaxBufferSize, Stream.Size - Stream.Position);
@ -2019,7 +2019,7 @@ begin
      i := 0;
      while i < BufferSize do begin
        if FoundUTF8Strings = MinimumCountOfUTF8Strings then begin
-          Result := fcsUtf8;
+          Result := TEncoding.UTF8;
          Break;
        end;
        case Buffer[i] of
@ -2084,56 +2084,33 @@ begin
  end;
 end;

+
 {**
  Read a chunk out of a textfile unicode safe by passing a stream and its charset
 }
-function ReadTextfileChunk(Stream: TFileStream; FileCharset: TFileCharset; ChunkSize: Int64 = 0): String;
+function ReadTextfileChunk(Stream: TFileStream; Encoding: TEncoding; ChunkSize: Int64 = 0): String;
 var
-  SA: AnsiString;
-  P: PWord;
  DataLeft: Int64;
+  LBuffer: TBytes;
 begin
  DataLeft := Stream.Size - Stream.Position;
  if (ChunkSize = 0) or (ChunkSize > DataLeft) then
    ChunkSize := DataLeft;
-  if (FileCharset in [fcsUnicode, fcsUnicodeSwapped]) then begin
-    // BOM indicates Unicode text stream
-    if ChunkSize < SizeOf(Char) then
-      Result := ''
-    else begin
-      SetLength(Result, ChunkSize div SizeOf(Char));
-      Stream.Read(PChar(Result)^, ChunkSize);
-      if FileCharset = fcsUnicodeSwapped then begin
-        P := PWord(PChar(Result));
-        While (P^ <> 0) do begin
-          P^ := MakeWord(HiByte(P^), LoByte(P^));
-          Inc(P);
-        end;
-      end;
-    end;
-  end else if FileCharset = fcsUtf8 then begin
-    // BOM indicates UTF-8 text stream
-    SetLength(SA, ChunkSize div SizeOf(AnsiChar));
-    Stream.Read(PAnsiChar(SA)^, ChunkSize);
-    Result := UTF8ToString(SA);
-  end else begin
-    // without byte order mark it is assumed that we are loading ANSI text
-    SetLength(SA, ChunkSize div SizeOf(AnsiChar));
-    Stream.Read(PAnsiChar(SA)^, ChunkSize);
-    Result := String(SA);
-  end;
+  SetLength(LBuffer, ChunkSize);
+  Stream.ReadBuffer(Pointer(LBuffer)^, ChunkSize);
+  LBuffer := Encoding.Convert(Encoding, TEncoding.Unicode, LBuffer, 0, Length(LBuffer));
+  Result := TEncoding.Unicode.GetString(LBuffer);
 end;

 {**
  Read a unicode or ansi file into memory
 }
-function ReadTextfile(Filename: String): String;
+function ReadTextfile(Filename: String; Encoding: TEncoding): String;
 var
  Stream: TFileStream;
-  FileCharset: TFileCharset;
 begin
-  OpenTextfile(Filename, Stream, FileCharset);
-  Result := ReadTextfileChunk(Stream, FileCharset);
+  OpenTextfile(Filename, Stream, Encoding);
+  Result := ReadTextfileChunk(Stream, Encoding);
  Stream.Free;
 end;

@ -3280,7 +3257,7 @@ begin
  Screen.Cursor := crHourGlass;
  try
    if StartupMode then begin
-      Content := ReadTextfile(FileName);
+      Content := ReadTextfile(FileName, nil);
      Lines := Explode(CRLF, Content);
      for i:=0 to Lines.Count-1 do begin
        // Each line has 3 segments: reg path | data type | value. Continue if explode finds less or more than 3.
--- a/source/main.dfm
+++ b/source/main.dfm
@ -8317,13 +8317,6 @@ object MainForm: TMainForm
    Left = 40
    Top = 232
  end
-  object OpenDialogSQLFile: TOpenDialog
-    DefaultExt = 'sql'
-    Filter = 'SQL-Scripts (*.sql)|*.sql|All files (*.*)|*.*'
-    Options = [ofHideReadOnly, ofAllowMultiSelect, ofEnableSizing]
-    Left = 40
-    Top = 160
-  end
  object SaveDialogSQLFile: TSaveDialog
    DefaultExt = 'sql'
    Filter = 'SQL-Scripts (*.sql)|*.sql|All Files (*.*)|*.*'
--- a/source/main.pas
+++ b/source/main.pas
@ -15,7 +15,7 @@ uses
  SynEdit, SynEditTypes, SynEditKeyCmds, VirtualTrees, DateUtils,
  ShlObj, SynEditMiscClasses, SynEditSearch, SynEditRegexSearch, SynCompletionProposal, SynEditHighlighter,
  SynHighlighterSQL, Tabs, SynUnicode, SynRegExpr, WideStrUtils, ExtActns,
-  CommCtrl, Contnrs, Generics.Collections, SynEditExport, SynExportHTML, Math,
+  CommCtrl, Contnrs, Generics.Collections, SynEditExport, SynExportHTML, Math, ExtDlgs,
  routine_editor, trigger_editor, event_editor, options, EditVar, helpers, createdatabase, table_editor,
  TableTools, View, Usermanager, SelectDBObject, connections, sqlhelp, mysql_connection,
  mysql_api, insertfiles, searchreplace, loaddata, copytable, VTHeaderPopup;
@ -295,7 +295,6 @@ type
    menuExporttables: TMenuItem;
    popupListHeader: TVTHeaderPopupMenu;
    SynCompletionProposal: TSynCompletionProposal;
-    OpenDialogSQLFile: TOpenDialog;
    SaveDialogSQLFile: TSaveDialog;
    SynEditSearch1: TSynEditSearch;
    SynEditRegexSearch1: TSynEditRegexSearch;
@ -593,7 +592,7 @@ type
    procedure QFvaluesClick(Sender: TObject);
    procedure InsertDate(Sender: TObject);
    procedure actDataSetNullExecute(Sender: TObject);
-    function QueryLoad( filename: String; ReplaceContent: Boolean = true ): Boolean;
+    function QueryLoad(Filename: String; ReplaceContent: Boolean; Encoding: TEncoding): Boolean;
    procedure AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
        Column: TColumnIndex; out EditLink: IVTEditLink);
    procedure AnyGridEditCancelled(Sender: TBaseVirtualTree; Column: TColumnIndex);
@ -839,6 +838,7 @@ type
    DBObjectsMaxRows: Int64;
    ProcessListMaxTime: Int64;
    ActiveObjectEditor: TDBObjectEditor;
+    FileEncodings: TStringList;

    // Cached forms
    TableToolsDialog: TfrmTableTools;
@ -958,6 +958,7 @@ type
    procedure ParseSelectedTableStructure;
    function AnyGridEnsureFullRow(Grid: TVirtualStringTree; Node: PVirtualNode): Boolean;
    procedure DataGridEnsureFullRows(Grid: TVirtualStringTree; SelectedOnly: Boolean);
+    function GetEncodingByName(Name: String): TEncoding;
 end;


@ -1446,6 +1447,8 @@ begin
  SelectedTableForeignKeys := TForeignKeyList.Create;

  FProcessDBtreeFocusChanges := True;
+
+  FileEncodings := Explode(',', 'Auto detect (may fail),ANSI,ASCII,Unicode,Unicode Big Endian,UTF-8,UTF-7');
 end;


@ -1575,7 +1578,7 @@ begin
  for i:=0 to FCmdlineFilenames.Count-1 do begin
    if i>0 then
      actNewQueryTabExecute(Self);
-    if not QueryLoad(FCmdlineFilenames[i]) then
+    if not QueryLoad(FCmdlineFilenames[i], True, nil) then
      actCloseQueryTabExecute(Self);
  end;
 end;
@ -1691,7 +1694,7 @@ begin
    if not FileExists(StartupScript) then
      MessageDlg('Error: Startup script file not found: '+StartupScript, mtError, [mbOK], 0)
    else begin
-      StartupSQL := ReadTextfile(StartupScript);
+      StartupSQL := ReadTextfile(StartupScript, nil);
      StartupBatch := SplitSQL(StartupSQL);
      for i:=0 to StartupBatch.Count-1 do try
        Connection.Query(StartupBatch[i].SQL);
@ -2632,14 +2635,26 @@ end;
 procedure TMainForm.actLoadSQLExecute(Sender: TObject);
 var
  i: Integer;
+  Dialog: TOpenTextFileDialog;
+  Encoding: TEncoding;
 begin
-  if OpenDialogSQLfile.Execute then begin
-    for i:=0 to OpenDialogSQLfile.Files.Count-1 do begin
+  //  if IsWindowsVista then
+  //    Dialog := TFileOpenDialog.Create(Self);
+  Dialog := TOpenTextFileDialog.Create(Self);
+  Dialog.Options := Dialog.Options + [ofAllowMultiSelect];
+  Dialog.Filter := 'SQL-Scripts (*.sql)|*.sql|All files (*.*)|*.*';
+  Dialog.DefaultExt := 'sql';
+  Dialog.Encodings.Assign(FileEncodings);
+  Dialog.EncodingIndex := 0;
+  if Dialog.Execute then begin
+    Encoding := GetEncodingByName(Dialog.Encodings[Dialog.EncodingIndex]);
+    for i:=0 to Dialog.Files.Count-1 do begin
      if i > 0 then
        actNewQueryTabExecute(Sender);
-      QueryLoad(OpenDialogSQLfile.Files[i]);
+      QueryLoad(Dialog.Files[i], True, Encoding);
    end;
  end;
+  Dialog.Free;
 end;


@ -3269,7 +3284,7 @@ begin
    p := Pos(' ', Filename) + 1;
    filename := Copy(Filename, p, Length(Filename));
  end;
-  QueryLoad(Filename);
+  QueryLoad(Filename, True, nil);
 end;


@ -4742,7 +4757,7 @@ begin
  end else if (src = ActiveQueryHelpers) and (ActiveQueryHelpers.ItemIndex > -1) then begin
    // Snippets tab
    if ActiveQueryTabset.TabIndex = 3 then begin
-      QueryLoad( DirnameSnippets + ActiveQueryHelpers.Items[ActiveQueryHelpers.ItemIndex] + '.sql', False );
+      QueryLoad( DirnameSnippets + ActiveQueryHelpers.Items[ActiveQueryHelpers.ItemIndex] + '.sql', False, nil);
      LoadText := False;
    // All other tabs
    end else begin
@ -4782,7 +4797,7 @@ begin
  for i:=0 to AFiles.Count-1 do begin
    if i > 0 then
      actNewQueryTab.Execute;
-    QueryLoad(AFiles[i], false);
+    QueryLoad(AFiles[i], False, nil);
  end;
 end;

@ -4987,7 +5002,7 @@ end;



-function TMainForm.QueryLoad( filename: String; ReplaceContent: Boolean = true ): Boolean;
+function TMainForm.QueryLoad(Filename: String; ReplaceContent: Boolean; Encoding: TEncoding): Boolean;

 var
  filecontent: String;
@ -5019,7 +5034,8 @@ begin
      mrYes:
        begin
          RunFileDialog := TRunSQLFileForm.Create(Self);
-          RunFileDialog.SQLFileName := filename;
+          RunFileDialog.SQLFileName := Filename;
+          RunFileDialog.FileEncoding := Encoding;
          RunFileDialog.ShowModal;
          RunFileDialog.Free;
          // Add filename to history menu
@ -5044,8 +5060,8 @@ begin
    PagecontrolMain.ActivePage := tabQuery;
  LogSQL('Loading file "'+filename+'" ('+FormatByteNumber(FileSize)+') into query tab #'+IntToStr(ActiveQueryTab.Number)+' ...', lcInfo);
  try
-    filecontent := ReadTextfile(filename);
-    if Pos( DirnameSnippets, filename ) = 0 then
+    filecontent := ReadTextfile(Filename, Encoding);
+    if Pos( DirnameSnippets, Filename ) = 0 then
      AddOrRemoveFromQueryLoadHistory( filename, true );
    FillPopupQueryLoad;
    ActiveQueryMemo.UndoList.AddGroupBreak;
@ -5634,7 +5650,7 @@ end;
 }
 procedure TMainForm.menuInsertSnippetAtCursorClick(Sender: TObject);
 begin
-  QueryLoad( DirnameSnippets + ActiveQueryHelpers.Items[ActiveQueryHelpers.ItemIndex] + '.sql', False );
+  QueryLoad(DirnameSnippets + ActiveQueryHelpers.Items[ActiveQueryHelpers.ItemIndex] + '.sql', False, nil);
 end;


@ -5643,7 +5659,7 @@ end;
 }
 procedure TMainForm.menuLoadSnippetClick(Sender: TObject);
 begin
-  QueryLoad( DirnameSnippets + ActiveQueryHelpers.Items[ActiveQueryHelpers.ItemIndex] + '.sql', True );
+  QueryLoad(DirnameSnippets + ActiveQueryHelpers.Items[ActiveQueryHelpers.ItemIndex] + '.sql', True, nil);
 end;


@ -9101,7 +9117,7 @@ begin
    ParseCommandLineParameters(ParamBlobToStr(Msg.CopyDataStruct.lpData));
    for i:=0 to FCmdlineFilenames.Count-1 do begin
      actNewQueryTabExecute(self);
-      if not QueryLoad(FCmdlineFilenames[i]) then
+      if not QueryLoad(FCmdlineFilenames[i], True, nil) then
        actCloseQueryTabExecute(Self);
    end;
    if Assigned(FCmdlineConnectionParams) then
@ -9194,6 +9210,20 @@ begin
 end;


+function TMainForm.GetEncodingByName(Name: String): TEncoding;
+begin
+  Result := nil;
+  case FileEncodings.IndexOf(Name) of
+    1: Result := TEncoding.Default;
+    2: Result := TEncoding.ASCII;
+    3: Result := TEncoding.Unicode;
+    4: Result := TEncoding.BigEndianUnicode;
+    5: Result := TEncoding.UTF8;
+    6: Result := TEncoding.UTF7;
+  end;
+end;
+
+

 { TQueryTab }

--- a/source/runsqlfile.pas
+++ b/source/runsqlfile.pas
@ -29,6 +29,7 @@ type
  public
    { Public declarations }
    SQLFileName : String;
+    FileEncoding: TEncoding;
  end;


@ -48,7 +49,6 @@ uses
 procedure TRunSQLFileForm.FormActivate(Sender: TObject);
 var
  Stream              : TFileStream;
-  FileCharset         : TFileCharset;
  lines               : String;
  filesize,
  querycount,
@ -78,7 +78,7 @@ begin
    // Start file operations
    filesize := _GetFileSize( SQLFileName );

-    OpenTextfile(SQLFileName, Stream, FileCharset );
+    OpenTextfile(SQLFileName, Stream, FileEncoding);
    lblPositionValue.Caption := FormatNumber( Stream.Position ) + ' / ' + FormatNumber( filesize );
    Repaint;

@ -86,7 +86,7 @@ begin
    begin
      // Read lines from SQL file until buffer reaches a limit of some MB
      // This strategy performs vastly better than looping through each line
-      lines := ReadTextfileChunk(Stream, FileCharset, 5*SIZE_MB);
+      lines := ReadTextfileChunk(Stream, FileEncoding, 5*SIZE_MB);

      // Display position in file
      lblPositionValue.Caption := FormatByteNumber( Stream.Position ) + ' / ' + FormatByteNumber( filesize );
--- a/source/texteditor.pas
+++ b/source/texteditor.pas
@ -4,7 +4,7 @@ interface

 uses
  Windows, Classes, Graphics, Forms, Controls, StdCtrls, VirtualTrees,
-  ComCtrls, ToolWin, Dialogs, SysUtils, Menus,
+  ComCtrls, ToolWin, Dialogs, SysUtils, Menus, ExtDlgs,
  helpers;

 {$I const.inc}
@ -217,14 +217,16 @@ end;

 procedure TfrmTextEditor.btnLoadTextClick(Sender: TObject);
 var
-  d: TOpenDialog;
+  d: TOpenTextFileDialog;
 begin
-  d := TOpenDialog.Create(Self);
+  d := TOpenTextFileDialog.Create(Self);
  d.Filter := 'Textfiles (*.txt)|*.txt|All files (*.*)|*.*';
  d.FilterIndex := 0;
+  d.Encodings.Assign(MainForm.FileEncodings);
+  d.EncodingIndex := 0;
  if d.Execute then try
    Screen.Cursor := crHourglass;
-    memoText.Text := ReadTextFile(d.FileName);
+    memoText.Text := ReadTextFile(d.FileName, MainForm.GetEncodingByName(d.Encodings[d.EncodingIndex]));
    if (memoText.MaxLength > 0) and (Length(memoText.Text) > memoText.MaxLength) then
      memoText.Text := copy(memoText.Text, 0, memoText.MaxLength);
  finally