ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/IBDatabase.pas
(Generate patch)

Comparing ibx/trunk/runtime/IBDatabase.pas (file contents):
Revision 37 by tony, Mon Feb 15 14:44:25 2016 UTC vs.
Revision 39 by tony, Tue May 17 08:14:52 2016 UTC

# Line 35 | Line 35 | unit IBDatabase;
35  
36   {$Mode Delphi}
37  
38 + {$IF FPC_FULLVERSION >= 20700 }
39 + {$codepage UTF8}
40 + {$DEFINE HAS_ANSISTRING_CODEPAGE}
41 + {$ENDIF}
42 +
43   interface
44  
45   uses
# Line 183 | Line 188 | type
188      FDataSets: TList;
189      FLoginCalled: boolean;
190      FCharSetSizes: array of integer;
191 <    FCharSetNames: array of string;
191 >    FCharSetNames: array of RawByteString;
192 >    FDefaultCharSetName: RawByteString;
193 >    {$IFDEF HAS_ANSISTRING_CODEPAGE}
194 >    FCodePages: array of TSystemCodePage;
195 >    FDefaultCodePage: TSystemCodePage;
196 >    {$ENDIF}
197 >    FUseDefaultSystemCodePage: boolean;
198      procedure EnsureInactive;
199      function GetDBSQLDialect: Integer;
200      function GetSQLDialect: Integer;
# Line 197 | Line 208 | type
208      function GetIdleTimer: Integer;
209      function GetTransaction(Index: Integer): TIBTransaction;
210      function GetTransactionCount: Integer;
211 <    function Login: Boolean;
211 >    function Login(var aDatabaseName: string): Boolean;
212      procedure LoadCharSetInfo;
213      procedure SetDatabaseName(const Value: TIBFileName);
214      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
# Line 255 | Line 266 | type
266      property TransactionCount: Integer read GetTransactionCount;
267      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
268      property InternalTransaction: TIBTransaction read FInternalTransaction;
269 +    property DefaultCharSetName: RawByteString read FDefaultCharSetName;
270 +    {$IFDEF HAS_ANSISTRING_CODEPAGE}
271 +    property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
272 +    {$ENDIF}
273  
274    published
275      property Connected;
# Line 270 | Line 285 | type
285      property SQLHourGlass: Boolean read FSQLHourGlass write FSQLHourGlass default true;
286      property DBSQLDialect : Integer read FDBSQLDialect;
287      property TraceFlags: TTraceFlags read FTraceFlags write FTraceFlags;
288 +    property UseDefaultSystemCodePage: boolean read FUseDefaultSystemCodePage
289 +                                               write FUseDefaultSystemCodePage;
290      property AfterConnect;
291      property AfterDisconnect;
292      property BeforeConnect;
# Line 446 | Line 463 | type
463      function GetCharSetSize(CharSetID: integer): integer;
464      function GetDefaultCharSetSize: integer;
465      function GetCharSetName(CharSetID: integer): string;
466 <    function GetDefaultCharSetName: string;
466 >    function GetDefaultCharSetName: RawByteString;
467 >    {$IFDEF HAS_ANSISTRING_CODEPAGE}
468 >    function GetCodePage(CharSetID: integer): TSystemCodePage;
469 >    function GetDefaultCodePage: TSystemCodePage;
470 >    {$ENDIF}
471      procedure HandleException(Sender: TObject);
472      procedure SetCursor;
473      procedure RestoreCursor;
# Line 479 | Line 500 | procedure GenerateTPB(sl: TStrings; var
500   implementation
501  
502   uses IBIntf, IBSQLMonitor, IBCustomDataSet, IBDatabaseInfo, IBSQL, IBUtils,
503 <     typInfo;
503 >     typInfo, IBCodePage;
504  
505   { TIBDatabase }
506  
507 < constructor TIBDataBase.Create(AOwner: TComponent);
487 < {$ifdef WINDOWS}
488 < var acp: uint;
489 < {$endif}
507 > constructor TIBDataBase.Create(AOwner: TComponent);
508   begin
509    inherited Create(AOwner);
510    FIBLoaded := False;
# Line 502 | Line 520 | begin
520       (AOwner is TCustomApplication) and
521       TCustomApplication(AOWner).ConsoleApplication then
522      LoginPrompt := false;
523 <  {$ifdef UNIX}
524 <  if csDesigning in ComponentState then
525 <    FDBParams.Add('lc_ctype=UTF8');
508 <  {$else}
509 <  {$ifdef WINDOWS}
510 <  if csDesigning in ComponentState then
511 <  begin
512 <    acp := GetACP;
513 <    if (acp >= 1250) and (acp <= 1254) then
514 <      FDBParams.Values['lc_ctype'] := Format('WIN%d',[acp]);
515 <  end;
516 <  {$endif}
517 <  {$endif}
523 >  {$IFDEF HAS_ANSISTRING_CODEPAGE}
524 >  FDefaultCodePage := CP_NONE;
525 >  {$ENDIF}
526    FDBParamsChanged := True;
527    TStringList(FDBParams).OnChange := DBParamsChange;
528    TStringList(FDBParams).OnChanging := DBParamsChanging;
# Line 635 | Line 643 | begin
643    FDBSQLDialect := 1;
644    SetLength(FCharSetSizes,0);
645    SetLength(FCharSetNames,0);
646 +  FDefaultCharSetName := '';
647 +  {$IFDEF HAS_ANSISTRING_CODEPAGE}
648 +  SetLength(FCodePages,0);
649 +  FDefaultCodePage := CP_NONE;
650 +  {$ENDIF}
651   end;
652  
653   procedure TIBDataBase.CreateDatabase;
# Line 847 | Line 860 | begin
860      begin
861        SetLength(FCharSetSizes,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
862        SetLength(FCharSetNames,Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
863 +      {$IFDEF HAS_ANSISTRING_CODEPAGE}
864 +      SetLength(FCodePages, Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger + 1);
865 +      {$ENDIF}
866        for i := 0 to Length(FCharSetSizes) - 1 do FCharSetSizes[i] := 1;
867        repeat
868          FCharSetSizes[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
869                   Query.FieldByName('RDB$BYTES_PER_CHARACTER').AsInteger;
870          FCharSetNames[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
871 <                 Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString;
871 >                 Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString);
872 >        {$IFDEF HAS_ANSISTRING_CODEPAGE}
873 >        FCodePages[Query.FieldByName('RDB$CHARACTER_SET_ID').AsInteger] :=
874 >          IBGetCodePage(Trim(Query.FieldByName('RDB$CHARACTER_SET_NAME').AsString));
875 >        {$ENDIF}
876          Query.Next;
877        until Query.EOF;
878      end;
# Line 925 | Line 945 | begin
945    end;
946   end;
947  
948 < function TIBDataBase.Login: Boolean;
948 >  function TIBDataBase.Login(var aDatabaseName: string): Boolean;
949   var
950    IndexOfUser, IndexOfPassword: Integer;
951    Username, Password, OldPassword: String;
# Line 961 | Line 981 | begin
981        LoginParams.Assign(Params);
982        FOnLogin(Self, LoginParams);
983        Params.Assign (LoginParams);
984 +      aDatabaseName := FDBName;
985        HidePassword;
986      finally
987        LoginParams.Free;
# Line 982 | Line 1003 | begin
1003                                           Length(Params[IndexOfPassword]));
1004        OldPassword := password;
1005      end;
1006 <    result := IBGUIInterface.LoginDialogEx(DatabaseName, Username, Password, False);
1006 >    result := IBGUIInterface.LoginDialogEx(aDatabaseName, Username, Password, False);
1007      if result then
1008      begin
1009        if IndexOfUser = -1 then
# Line 1019 | Line 1040 | var
1040    sqlcode: Long;
1041    IBErrorCode: Long;
1042    status_vector: PISC_STATUS;
1043 +  {$ifdef WINDOWS}
1044 +  acp: uint;
1045 +  {$endif}
1046   begin
1047    CheckInactive;
1048    CheckDatabaseName;
# Line 1028 | Line 1052 | begin
1052      FDBParamsChanged := True;
1053    end;
1054    { Use builtin login prompt if requested }
1055 <  if (LoginPrompt or (csDesigning in ComponentState)) and not Login then
1055 >  aDBName := FDBName;
1056 >  if (LoginPrompt or (csDesigning in ComponentState)) and not Login(aDBName) then
1057      IBError(ibxeOperationCancelled, [nil]);
1058  
1059    TempDBParams := TStringList.Create;
1060    try
1061     TempDBParams.Assign(FDBParams);
1062 <   aDBName := FDBName;
1062 >   if UseDefaultSystemCodePage then
1063 >   begin
1064 >     {$ifdef WINDOWS}
1065 >     acp := GetACP;
1066 >     {$IFDEF HAS_ANSISTRING_CODEPAGE}
1067 >     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp);
1068 >     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1069 >     {$ELSE}
1070 >     if (acp >= 1250) and (acp <= 1258) then
1071 >       TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp])
1072 >     else
1073 >       TempDBParams.Values['lc_ctype'] :='UTF8';
1074 >     {$ENDIF}
1075 >     {$else}
1076 >     {$IFDEF HAS_ANSISTRING_CODEPAGE}
1077 >     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage);
1078 >     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1079 >     {$ELSE}
1080 >     TempDBParams.Values['lc_ctype'] :='UTF8';
1081 >     {$ENDIF}
1082 >     {$endif}
1083 >   end;
1084     {Opportunity to override defaults}
1085     for i := 0 to FSQLObjects.Count - 1 do
1086     begin
1087         if FSQLObjects[i] <> nil then
1088           SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1089     end;
1090 +   FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1091  
1092     { Generate a new DPB if necessary }
1093     if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
# Line 2077 | Line 2124 | begin
2124      Result := ''; {Unknown character set}
2125   end;
2126  
2127 < function TIBBase.GetDefaultCharSetName: string;
2127 > function TIBBase.GetDefaultCharSetName: RawByteString;
2128 > begin
2129 >  Result := Database.FDefaultCharSetName;
2130 > end;
2131 >
2132 > {$IFDEF HAS_ANSISTRING_CODEPAGE}
2133 > function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
2134   begin
2135 <  Result := AnsiUpperCase(Database.Params.Values['lc_ctype']);
2135 >  if (CharSetID >= 0) and (CharSetID < Length(Database.FCodePages)) then
2136 >    Result := Database.FCodePages[CharSetID]
2137 >  else
2138 >    Result := CP_NONE; {Unknown character set}
2139 > end;
2140 >
2141 > function TIBBase.GetDefaultCodePage: TSystemCodePage;
2142 > begin
2143 >  Result := Database.FDefaultCodePage;
2144   end;
2145  
2146 + {$ENDIF}
2147 +
2148   procedure TIBBase.HandleException(Sender: TObject);
2149   begin
2150    if assigned(Database) then

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines