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 42 by tony, Tue May 17 08:14:52 2016 UTC vs.
Revision 43 by tony, Thu Sep 22 17:10:15 2016 UTC

# Line 187 | Line 187 | type
187      FUserNames: TStringList;
188      FDataSets: TList;
189      FLoginCalled: boolean;
190    FCharSetSizes: array of integer;
191    FCharSetNames: array of RawByteString;
190      FDefaultCharSetName: RawByteString;
191 +    FDefaultCharSetID: integer;
192      {$IFDEF HAS_ANSISTRING_CODEPAGE}
194    FCodePages: array of TSystemCodePage;
193      FDefaultCodePage: TSystemCodePage;
194      {$ENDIF}
195      FUseDefaultSystemCodePage: boolean;
# Line 209 | Line 207 | type
207      function GetTransaction(Index: Integer): TIBTransaction;
208      function GetTransactionCount: Integer;
209      function Login(var aDatabaseName: string): Boolean;
212    procedure LoadCharSetInfo;
210      procedure SetDatabaseName(const Value: TIBFileName);
211      procedure SetDBParamByDPB(const Idx: Integer; Value: String);
212      procedure SetDBParams(Value: TStrings);
# Line 267 | Line 264 | type
264      property Transactions[Index: Integer]: TIBTransaction read GetTransaction;
265      property InternalTransaction: TIBTransaction read FInternalTransaction;
266      property DefaultCharSetName: RawByteString read FDefaultCharSetName;
267 +    property DefaultCharSetID: integer read FDefaultCharSetID;
268      {$IFDEF HAS_ANSISTRING_CODEPAGE}
269      property DefaultCodePage: TSystemCodePage read FDefaultCodePage;
270      {$ENDIF}
# Line 460 | Line 458 | type
458      procedure DoAfterDelete(Sender: TObject); virtual;
459      procedure DoAfterInsert(Sender: TObject); virtual;
460      procedure DoAfterPost(Sender: TObject); virtual;
463    function GetCharSetSize(CharSetID: integer): integer;
464    function GetDefaultCharSetSize: integer;
465    function GetCharSetName(CharSetID: integer): string;
461      function GetDefaultCharSetName: RawByteString;
462 <    {$IFDEF HAS_ANSISTRING_CODEPAGE}
468 <    function GetCodePage(CharSetID: integer): TSystemCodePage;
469 <    function GetDefaultCodePage: TSystemCodePage;
470 <    {$ENDIF}
462 >    function GetDefaultCharSetID: cardinal;
463      procedure HandleException(Sender: TObject);
464      procedure SetCursor;
465      procedure RestoreCursor;
# Line 641 | Line 633 | begin
633    if Connected then
634      InternalClose(False);
635    FDBSQLDialect := 1;
644  SetLength(FCharSetSizes,0);
645  SetLength(FCharSetNames,0);
636    FDefaultCharSetName := '';
637 +  FDefaultCharSetID := 0;
638    {$IFDEF HAS_ANSISTRING_CODEPAGE}
648  SetLength(FCodePages,0);
639    FDefaultCodePage := CP_NONE;
640    {$ENDIF}
641   end;
# Line 842 | Line 832 | begin
832        SQLObjects[i].DoAfterDatabaseDisconnect;
833   end;
834  
845 procedure TIBDataBase.LoadCharSetInfo;
846 var Query: TIBSQL;
847    i: integer;
848 begin
849  if not FInternalTransaction.Active then
850    FInternalTransaction.StartTransaction;
851  Query := TIBSQL.Create(self);
852  try
853    Query.Database := Self;
854    Query.Transaction := FInternalTransaction;
855    Query.SQL.Text := 'Select RDB$CHARACTER_SET_ID, RDB$BYTES_PER_CHARACTER, RDB$CHARACTER_SET_NAME ' +
856                      'From RDB$CHARACTER_SETS Order by 1 DESC'; {do not localize}
857    Query.Prepare;
858    Query.ExecQuery;
859    if not Query.EOF then
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                 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;
879  finally
880    Query.free;
881    FInternalTransaction.Commit;
882  end;
883 end;
884
835   procedure TIBDataBase.CheckStreamConnect;
836   var
837    i: integer;
# Line 1040 | Line 990 | var
990    sqlcode: Long;
991    IBErrorCode: Long;
992    status_vector: PISC_STATUS;
993 <  {$ifdef WINDOWS}
1044 <  acp: uint;
1045 <  {$endif}
993 >  CharSetID: integer;
994   begin
995    CheckInactive;
996    CheckDatabaseName;
# Line 1061 | Line 1009 | begin
1009     TempDBParams.Assign(FDBParams);
1010     if UseDefaultSystemCodePage then
1011     begin
1064     {$ifdef WINDOWS}
1065     acp := GetACP;
1012       {$IFDEF HAS_ANSISTRING_CODEPAGE}
1013 <     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(acp);
1014 <     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1015 <     {$ELSE}
1070 <     if (acp >= 1250) and (acp <= 1258) then
1071 <       TempDBParams.Values['lc_ctype'] := Format('WIN%d',[acp])
1013 >     {$ifdef WINDOWS}
1014 >     if TFirebirdCharacterSets.CodePage2CharSetID(GetACP,CharSetID) then
1015 >       TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1016       else
1073       TempDBParams.Values['lc_ctype'] :='UTF8';
1074     {$ENDIF}
1017       {$else}
1018 <     {$IFDEF HAS_ANSISTRING_CODEPAGE}
1019 <     TempDBParams.Values['lc_ctype'] := IBGetCharacterSetName(DefaultSystemCodePage);
1020 <     FDefaultCodePage := IBGetCodePage(AnsiUpperCase(TempDBParams.Values['lc_ctype']));
1079 <     {$ELSE}
1080 <     TempDBParams.Values['lc_ctype'] :='UTF8';
1081 <     {$ENDIF}
1018 >     if TFirebirdCharacterSets.CodePage2CharSetID(DefaultSystemCodePage,CharSetID) then
1019 >       TempDBParams.Values['lc_ctype'] := TFirebirdCharacterSets.GetCharsetName(CharSetID)
1020 >     else
1021       {$endif}
1022 +     {$ENDIF}
1023 +     TempDBParams.Values['lc_ctype'] :='UTF8';
1024     end;
1025     {Opportunity to override defaults}
1026     for i := 0 to FSQLObjects.Count - 1 do
# Line 1088 | Line 1029 | begin
1029           SQLObjects[i].DoBeforeDatabaseConnect(TempDBParams,aDBName);
1030     end;
1031     FDefaultCharSetName := AnsiUpperCase(TempDBParams.Values['lc_ctype']);
1032 <
1032 >   if FDefaultCharSetName <> '' then
1033 >     TFirebirdCharacterSets.CharSetName2CharSetID(FDefaultCharSetName,FDefaultCharSetID);
1034 >   {$IFDEF HAS_ANSISTRING_CODEPAGE}
1035 >   TFirebirdCharacterSets.CharSetID2CodePage(FDefaultCharSetID,FDefaultCodePage);
1036 >   {$ENDIF}
1037     { Generate a new DPB if necessary }
1038     if (FDBParamsChanged or (TempDBParams.Text <> FDBParams.Text)) then
1039     begin
# Line 1143 | Line 1088 | begin
1088    end;
1089    if not (csDesigning in ComponentState) then
1090      MonitorHook.DBConnect(Self);
1146  LoadCharSetInfo;
1091   end;
1092  
1093   procedure TIBDataBase.RemoveSQLObject(Idx: Integer);
# Line 2094 | Line 2038 | begin
2038    inherited Destroy;
2039   end;
2040  
2097 function TIBBase.GetCharSetSize(CharSetID: integer): integer;
2098 begin
2099  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetSizes)) then
2100    Result := Database.FCharSetSizes[CharSetID]
2101  else
2102    Result := 1; {Unknown character set}
2103 end;
2104
2105 function TIBBase.GetDefaultCharSetSize: integer;
2106 var DefaultCharSetName: string;
2107    i: integer;
2108 begin
2109  DefaultCharSetName := GetDefaultCharSetName;
2110  Result := 4; {worse case}
2111  for i := 0 to Length(Database.FCharSetSizes) - 1 do
2112    if Database.FCharSetNames[i] = DefaultCharSetName then
2113    begin
2114      Result := Database.FCharSetSizes[i];
2115      break;
2116    end;
2117 end;
2118
2119 function TIBBase.GetCharSetName(CharSetID: integer): string;
2120 begin
2121  if (CharSetID >= 0) and (CharSetID < Length(Database.FCharSetNames)) then
2122    Result := Database.FCharSetNames[CharSetID]
2123  else
2124    Result := ''; {Unknown character set}
2125 end;
2126
2041   function TIBBase.GetDefaultCharSetName: RawByteString;
2042   begin
2043    Result := Database.FDefaultCharSetName;
2044   end;
2045  
2046 < {$IFDEF HAS_ANSISTRING_CODEPAGE}
2133 < function TIBBase.GetCodePage(CharSetID: integer): TSystemCodePage;
2134 < begin
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;
2046 > function TIBBase.GetDefaultCharSetID: cardinal;
2047   begin
2048 <  Result := Database.FDefaultCodePage;
2048 >  Result := Database.DefaultCharSetID;
2049   end;
2050  
2146 {$ENDIF}
2147
2051   procedure TIBBase.HandleException(Sender: TObject);
2052   begin
2053    if assigned(Database) then

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines