--- ibx/trunk/runtime/IBDatabase.pas	2016/02/15 14:44:25	37
+++ ibx/trunk/runtime/IBDatabase.pas	2016/05/17 08:14:52	39
@@ -35,6 +35,11 @@ unit IBDatabase;
 
 {$Mode Delphi}
 
+{$IF FPC_FULLVERSION >= 20700 }
+{$codepage UTF8}
+{$DEFINE HAS_ANSISTRING_CODEPAGE}
+{$ENDIF}
+
 interface
 
 uses
@@ -183,7 +188,13 @@ type
     FDataSets: TList;
     FLoginCalled: boolean;
     FCharSetSizes: array of integer;
-    FCharSetNames: array of string;
+    FCharSetNames: array of RawByteString;
+    FDefaultCharSetName: RawByteString;
+    {$IFDEF HAS_ANSISTRING_CODEPAGE}
+    FCodePages: array of TSystemCodePage;
+    FDefaultCodePage: TSystemCodePage;
+    {$ENDIF}
+    FUseDefaultSystemCodePage: boolean;
     procedure EnsureInactive;
     function GetDBSQLDialect: Integer;
     function GetSQLDialect: Integer;
@@ -197,7 +208,7 @@ type
     function GetIdleTimer: Integer;
     function GetTransaction(Index: Integer): TIBTransaction;
     function GetTransactionCount: Integer;
-    function Login: Boolean;
+    function Login(var aDatabaseName: string): Boolean;
     procedure LoadCharSetInfo;
     procedure SetDatabaseName(const Value: TIBFileName);
     procedure SetDBParamByDPB(const Idx: Integer; Value: String);
@@ -255,6 +266,10 @@ type
     property TransactionCount: Integer read GetTransactionCount;
     property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
     property InternalTransaction: TIBTransaction read FInternalTransaction;
+    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
+    {$IFDEF HAS_ANSISTRING_CODEPAGE}
+    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
+    {$ENDIF}
 
   published
     property Connected;
@@ -270,6 +285,8 @@ type
     property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
     property DBSQLDialect : Integer read FDBSQLDialect;
     property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
+    property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
+                                               write FUseDefaultSystemCodePage;
     property AfterConnect;
     property AfterDisconnect;
     property BeforeConnect;
@@ -446,7 +463,11 @@ type
     function GetCharSetSize(CharSetID: integer): integer;
     function GetDefaultCharSetSize: integer;
     function GetCharSetName(CharSetID: integer): string;
-    function GetDefaultCharSetName: string;
+    function GetDefaultCharSetName: RawByteString;
+    {$IFDEF HAS_ANSISTRING_CODEPAGE}
+    function GetCodePage(CharSetID: integer): TSystemCodePage;
+    function GetDefaultCodePage: TSystemCodePage;
+    {$ENDIF}
     procedure HandleException(Sender: TObject);
     procedure SetCursor;
     procedure RestoreCursor;
@@ -479,14 +500,11 @@ procedure GenerateTPB(sl: TStrings; var
 implementation
 
 uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
-     typInfo;
+     typInfo, IBCodePage;
 
 { TIBDatabase }
 
- constructor TIBDataBase.Create(AOwner: TComponent);
-{$ifdef WINDOWS}
-var acp: uint;
-{$endif}
+constructor TIBDataBase.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FIBLoaded := False;
@@ -502,19 +520,9 @@ begin
      (AOwner is TCustomApplication) and
      TCustomApplication(AOWner).ConsoleApplication then
     LoginPrompt := false;
-  {$ifdef UNIX}
-  if csDesigning in ComponentState then
-    FDBParams.Add('lc_ctype=UTF8');
-  {$else}
-  {$ifdef WINDOWS}
-  if csDesigning in ComponentState then
-  begin
-    acp := GetACP;
-    if (acp >= 1250) and (acp <= 1254) then
-      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
-  end;
-  {$endif}
-  {$endif}
+  {$IFDEF HAS_ANSISTRING_CODEPAGE}
+  FDefaultCodePage := CP_NONE;
+  {$ENDIF}
   FDBParamsChanged := True;
   TStringList(FDBParams).OnChange := DBParamsChange;
   TStringList(FDBParams).OnChanging := DBParamsChanging;
@@ -635,6 +643,11 @@ begin
   FDBSQLDialect := 1;
   SetLength(FCharSetSizes,0);
   SetLength(FCharSetNames,0);
+  FDefaultCharSetName := '';
+  {$IFDEF HAS_ANSISTRING_CODEPAGE}
+  SetLength(FCodePages,0);
+  FDefaultCodePage := CP_NONE;
+  {$ENDIF}
 end;
 
  procedure TIBDataBase.CreateDatabase;
@@ -847,12 +860,19 @@ begin
     begin
       SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
       SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
+      {$IFDEF HAS_ANSISTRING_CODEPAGE}
+      SetLength(FCodePages, Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
+      {$ENDIF}
       for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
       repeat
         FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
                  Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
         FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
-                 Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
+                 Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
+        {$IFDEF HAS_ANSISTRING_CODEPAGE}
+        FCodePages[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
+          IBGetCodePage(Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString));
+        {$ENDIF}
         Query.Next;
       until Query.EOF;
     end;
@@ -925,7 +945,7 @@ begin
   end;
 end;
 
- function TIBDataBase.Login: Boolean;
+  function TIBDataBase.Login(var aDatabaseName: string): Boolean;
 var
   IndexOfUser, IndexOfPassword: Integer;
   Username, Password, OldPassword: String;
@@ -961,6 +981,7 @@ begin
       LoginParams.Assign(Params);
       FOnLogin(Self, LoginParams);
       Params.Assign (LoginParams);
+      aDatabaseName := FDBName;
       HidePassword;
     finally
       LoginParams.Free;
@@ -982,7 +1003,7 @@ begin
                                          Length(Params[IndexOfPassword]));
       OldPassword := password;
     end;
-    result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
+    result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
     if result then
     begin
       if IndexOfUser = -1 then
@@ -1019,6 +1040,9 @@ var
   sqlcode: Long;
   IBErrorCode: Long;
   status_vector: PISC_STATUS;
+  {$ifdef WINDOWS}
+  acp: uint;
+  {$endif}
 begin
   CheckInactive;
   CheckDatabaseName;
@@ -1028,19 +1052,42 @@ begin
     FDBParamsChanged := True;
   end;
   { Use builtin login prompt if requested }
-  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
+  aDBName := FDBName;
+  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
     IBError(ibxeOperationCancelled, [nil]);
 
   TempDBParams := TStringList.Create;
   try
    TempDBParams.Assign(FDBParams);
-   aDBName := FDBName;
+   if UseDefaultSystemCodePage then
+   begin
+     {$ifdef WINDOWS}
+     acp := GetACP;
+     {$IFDEF HAS_ANSISTRING_CODEPAGE}
+     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp);
+     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
+     {$ELSE}
+     if (acp >= 1250) and (acp <= 1258) then
+       TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp])
+     else
+       TempDBParams.Values['lc_ctype'] :='UTF8';
+     {$ENDIF}
+     {$else}
+     {$IFDEF HAS_ANSISTRING_CODEPAGE}
+     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage);
+     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
+     {$ELSE}
+     TempDBParams.Values['lc_ctype'] :='UTF8';
+     {$ENDIF}
+     {$endif}
+   end;
    {Opportunity to override defaults}
    for i := 0 to FSQLObjects.Count - 1 do
    begin
        if FSQLObjects[i] <> nil then
          SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
    end;
+   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
 
    { Generate a new DPB if necessary }
    if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
@@ -2077,11 +2124,27 @@ begin
     Result := ''; {Unknown character set}
 end;
 
-function TIBBase.GetDefaultCharSetName: string;
+function TIBBase.GetDefaultCharSetName: RawByteString;
+begin
+  Result := Database.FDefaultCharSetName;
+end;
+
+{$IFDEF HAS_ANSISTRING_CODEPAGE}
+function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
 begin
-  Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
+  if (CharSetID >= 0) and (CharSetID < Length(Database.FCodePages)) then
+    Result := Database.FCodePages[CharSetID]
+  else
+    Result := CP_NONE; {Unknown character set}
+end;
+
+function TIBBase.GetDefaultCodePage: TSystemCodePage;
+begin
+  Result := Database.FDefaultCodePage;
 end;
 
+{$ENDIF}
+
 procedure TIBBase.HandleException(Sender: TObject);
 begin
   if assigned(Database) then