--- Merging r22851 into '.':

U    packages/fcl-db/src/base/fields.inc
--- Merging r22852 into '.':
U    packages/mysql/src/mysql.inc
U    packages/postgres/src/postgres3dyn.pp
U    packages/postgres/src/postgres3.pp
--- Merging r22857 into '.':
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r22871 into '.':
U    packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r22873 into '.':
U    packages/sqlite/src/sqlite3.inc
--- Merging r22898 into '.':
U    packages/fcl-db/tests/sqldbtoolsunit.pas

# revisions: 22851,22852,22857,22871,22873,22898
r22851 | reiniero | 2012-10-26 14:24:57 +0200 (Fri, 26 Oct 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/fields.inc

* Deal with DataSize of TStringField being larger than dsMaxStringSize
Patch by Laco, mantis 19940
r22852 | michael | 2012-10-26 19:10:35 +0200 (Fri, 26 Oct 2012) | 1 line
Changed paths:
   M /trunk/packages/mysql/src/mysql.inc
   M /trunk/packages/postgres/src/postgres3.pp
   M /trunk/packages/postgres/src/postgres3dyn.pp

* Patch from Ludo brands to add IsLibraryLoaded sqlite/src/sqlite3.inc
r22857 | ludob | 2012-10-27 13:53:14 +0200 (Sat, 27 Oct 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

TSQLite3Connection add support for adding/removing user-defined COLLATIONs; Mantis #22925 patch from Lacak2
r22871 | lacak | 2012-10-29 08:46:58 +0100 (Mon, 29 Oct 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

mssqlconn: implement missing methods CreateDB/DropDB
r22873 | michael | 2012-10-29 10:44:16 +0100 (Mon, 29 Oct 2012) | 1 line
Changed paths:
   M /trunk/packages/sqlite/src/sqlite3.inc

* Forgot to commit
r22898 | reiniero | 2012-11-01 16:21:54 +0100 (Thu, 01 Nov 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas

* FCL-DB: fix for MSSQL/Sybase db test framework errors when existing FPDEV table present.
Thanks to Lacak2 for the fix idea!

git-svn-id: branches/fixes_2_6@23907 -

packages/fcl-db/src/base/fields.inc

@@ -1107,10 +1107,10 @@ begin
   if DataSize <= dsMaxStringSize then
     begin
     Result:=GetData(@Buf);
-    buf[Size]:=#0;  //limit string to Size
+    Buf[Size]:=#0;  //limit string to Size
     If Result then
       begin
-      if transliterate then
+      if Transliterate then
         begin
         DataSet.Translate(Buf,TBuf,False);
         AValue:=TBuf;
@@ -1123,10 +1123,10 @@ begin
     begin
     SetLength(DynBuf,DataSize);
     Result:=GetData(@DynBuf[0]);
-    Dynbuf[Size]:=#0;  //limit string to Size
+    DynBuf[Size]:=#0;  //limit string to Size
     If Result then
       begin
-      if transliterate then
+      if Transliterate then
         begin
         SetLength(TDynBuf,DataSize);
         DataSet.Translate(@DynBuf[0],@TDynBuf[0],False);
@@ -1168,28 +1168,35 @@ end;
 procedure TStringField.SetAsString(const AValue: string);
 
 var Buf      : TStringFieldBuffer;
+    DynBuf   : array of char;
 
 begin
-  IF Length(AValue)=0 then
+  if Length(AValue)=0 then
     begin
     Buf := #0;
-    SetData(@buf);
+    SetData(@Buf);
     end
-  else if FTransliterate then
+  else if DataSize <= dsMaxStringSize then
     begin
-    DataSet.Translate(@AValue[1],Buf,True);
+    if FTransliterate then
+      DataSet.Translate(@AValue[1],Buf,True)
+    else
+      // The data is copied into the buffer, since some TDataset descendents copy
+      // the whole buffer-length in SetData. (See bug 8477)
+      Buf := AValue;
+    // If length(AValue) > DataSize the buffer isn't terminated properly
     Buf[DataSize-1] := #0;
-    SetData(@buf);
+    SetData(@Buf);
     end
   else
     begin
-    // The data is copied into the buffer, since some TDataset descendents copy
-    // the whole buffer-length in SetData. (See bug 8477)
-    Buf := AValue;
-    // If length(AValue) > Datasize the buffer isn't terminated properly
-    Buf[DataSize-1] := #0;
-    SetData(@Buf);
-    end;
+    SetLength(DynBuf, DataSize);
+    if FTransliterate then
+      DataSet.Translate(@AValue[1],@DynBuf[0],True)
+    else
+      StrPLCopy(@DynBuf[0], AValue, DataSize);
+    SetData(@DynBuf[0]);
+    end
 end;
 
 procedure TStringField.SetVarValue(const AValue: Variant);
@@ -1347,11 +1354,8 @@ end;
 
 procedure TNumericField.SetAsBoolean(AValue: Boolean);
 begin
-  if AValue then
-    SetAsLongint(1)
-  else
-    SetAsLongint(0);
-end; 
+  SetAsLongint(ord(AValue));
+end;
 
 { ---------------------------------------------------------------------
     TLongintField
@@ -1925,7 +1929,7 @@ var b : wordbool;
 
 begin
   If GetData(@b) then
-    result := b
+    Result := b
   else
     Result:=False;
 end;
@@ -1968,15 +1972,12 @@ end;
 
 function TBooleanField.GetAsInteger: integer;
 begin
-   if GetAsBoolean then
-    Result:=1
-   else
-    Result:=0;
+  Result := ord(GetAsBoolean);
 end;
 
 procedure TBooleanField.SetAsInteger(AValue: Integer);
 begin
-  SetAsBoolean(avalue<>0);
+  SetAsBoolean(AValue<>0);
 end;
 
 procedure TBooleanField.SetAsBoolean(AValue: Boolean);

packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -56,6 +56,7 @@ type
     Fstatus : STATUS;      // current result/rows fetch status
     function CheckError(const Ret: RETCODE): RETCODE;
     procedure DBExecute(const cmd: string);
+    procedure ExecuteDirectSQL(const Query: string);
     function TranslateFldType(SQLDataType: integer): TFieldType;
     function ClientCharset: TClientCharset;
     function AutoCommit: boolean;
@@ -97,6 +98,8 @@ type
     function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
   public
     constructor Create(AOwner : TComponent); override;
+    procedure CreateDB; override;
+    procedure DropDB; override;
     //property TDS:integer read Ftds;
   published
     // Redeclare properties from TSQLConnection
@@ -259,6 +262,31 @@ begin
   Ftds := DBTDS_UNKNOWN;
 end;
 
+procedure TMSSQLConnection.CreateDB;
+begin
+  ExecuteDirectSQL('CREATE DATABASE '+DatabaseName);
+end;
+
+procedure TMSSQLConnection.DropDB;
+begin
+  ExecuteDirectSQL('DROP DATABASE '+DatabaseName);
+end;
+
+procedure TMSSQLConnection.ExecuteDirectSQL(const Query: string);
+var ADatabaseName: string;
+begin
+  CheckDisConnected;
+  ADatabaseName:=DatabaseName;
+  DatabaseName:='';
+  try
+    Open;
+    DBExecute(Query);
+  finally
+    Close;
+    DatabaseName:=ADatabaseName;
+  end;
+end;
+
 function TMSSQLConnection.GetHandle: pointer;
 begin
   Result:=FDBProc;
@@ -311,7 +339,8 @@ const
   ANSI_DEFAULTS_ON: array[boolean] of shortstring = ('SET ANSI_DEFAULTS ON', 'SET QUOTED_IDENTIFIER ON');
   CURSOR_CLOSE_ON_COMMIT_OFF: array[boolean] of shortstring = ('SET CURSOR_CLOSE_ON_COMMIT OFF', 'SET CLOSE ON ENDTRAN OFF');
 begin
-  inherited DoInternalConnect;
+  // Do not call the inherited method as it checks for a non-empty DatabaseName, empty DatabaseName=default database defined for login
+  //inherited DoInternalConnect;
 
   InitialiseDBLib(DBLibLibraryName);
 
@@ -368,9 +397,11 @@ begin
   else
     DBExecute('SET TEXTSIZE 16777216');
 
-  if AutoCommit then DBExecute(IMPLICIT_TRANSACTIONS_OFF[IsSybase]); //set connection to autocommit mode - default
+  if AutoCommit then
+    DBExecute(IMPLICIT_TRANSACTIONS_OFF[IsSybase]); //set connection to autocommit mode - default
 
-  CheckError( dbuse(FDBProc, PChar(DatabaseName)) );
+  if DatabaseName <> '' then
+    CheckError( dbuse(FDBProc, PChar(DatabaseName)) );
 end;
 
 procedure TMSSQLConnection.DoInternalDisconnect;

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -94,6 +94,11 @@ type
     constructor Create(AOwner : TComponent); override;
     function GetInsertID: int64;
     procedure GetFieldNames(const TableName : string; List :  TStrings); override;
+    // See http://www.sqlite.org/c3ref/create_collation.html for detailed information
+    // If eTextRep=0 a default UTF-8 compare function is used (UTF8CompareCallback)
+    // Warning: UTF8CompareCallback needs a wide string manager on linux such as cwstring
+    // Warning: CollationName has to be a UTF-8 string
+    procedure CreateCollation(const CollationName: string; eTextRep: integer; Arg: Pointer=nil; Compare: xCompare=nil);
     procedure LoadExtension(LibraryFile: string);
   published
     property Options: TSqliteOptions read FOptions write SetOptions;
@@ -921,7 +926,27 @@ begin
   GetDBInfo(stColumns,TableName,'name',List);
 end;
 
-procedure Tsqlite3connection.LoadExtension(Libraryfile: String);
+function UTF8CompareCallback(user: pointer; len1: longint; data1: pointer; len2: longint; data2: pointer): longint; cdecl;
+var S1, S2: AnsiString;
+begin
+  SetString(S1, data1, len1);
+  SetString(S2, data2, len2);
+  Result := WideCompareStr(UTF8Decode(S1), UTF8Decode(S2));
+end;
+
+procedure TSQLite3Connection.CreateCollation(const CollationName: string;
+  eTextRep: integer; Arg: Pointer; Compare: xCompare);
+begin
+  if eTextRep = 0 then
+  begin
+    eTextRep := SQLITE_UTF8;
+    Compare := @UTF8CompareCallback;
+  end;
+  CheckConnected;
+  CheckError(sqlite3_create_collation(fhandle, PChar(CollationName), eTextRep, Arg, Compare));
+end;
+
+procedure TSQLite3Connection.LoadExtension(LibraryFile: String);
 var
   LoadResult: integer;
 begin

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -402,17 +402,40 @@ end;
 
 procedure TSQLDBConnector.TryDropIfExist(ATableName: String);
 begin
-  // This makes live soo much easier, since it avoids the exception if the table already
+  // This makes life soo much easier, since it avoids the exception if the table already
   // exists. And while this exeption is in a try..except statement, the debugger
-  // always shows the exception. Which is pretty annoying
-  // It only works with Firebird 2, though.
+  // always shows the exception, which is pretty annoying.
   try
     if SQLDbType = INTERBASE then
       begin
+      // This only works with Firebird 2+
       FConnection.ExecuteDirect('execute block as begin if (exists (select 1 from rdb$relations where rdb$relation_name=''' + ATableName + ''')) '+
-             'then execute statement ''drop table ' + ATAbleName + ';'';end');
+        'then execute statement ''drop table ' + ATAbleName + ';'';end');
       FTransaction.CommitRetaining;
       end;
+    if SQLDBType = mssql then
+      begin
+      // Checking is needed here to avoid getting "auto rollback" of a subsequent CREATE TABLE statement
+      // which leads to the rollback not referring to the right transaction=>SQL error
+      // Use SQL92 ISO standard INFORMATION_SCHEMA:
+      FConnection.ExecuteDirect(
+        'if exists (select * from INFORMATION_SCHEMA.TABLES where TABLE_TYPE=''BASE TABLE'' AND TABLE_NAME=''' + ATableName + ''') '+
+        'begin '+
+        'drop table ' + ATAbleName + ' '+
+        'end');
+      FTransaction.CommitRetaining;
+      end;
+    if SQLDbType = sybase then
+      begin
+      // Checking is needed here to avoid getting "auto rollback" of a subsequent CREATE TABLE statement
+      // which leads to the rollback not referring to the right transaction=>SQL error
+      // Can't use SQL standard information_schema; instead query sysobjects for User tables
+      FConnection.ExecuteDirect(
+        'if exists (select * from sysobjects where type = ''U'' and name=''' + ATableName + ''') '+
+        'begin '+
+        'drop table ' + ATAbleName + ' '+
+        'end');
+      end;
   except
     FTransaction.RollbackRetaining;
   end;

packages/mysql/src/mysql.inc

@@ -1602,6 +1602,7 @@ Function InitialiseMysql(argc:cint = -1; argv:PPchar = nil; groups:PPchar = nil)
 Procedure ReleaseMysql;
 
 var MysqlLibraryHandle : TLibHandle;
+  MysqlLoadedLibrary : String;
 {$ENDIF}
 
 implementation
@@ -1615,7 +1616,6 @@ ResourceString
 
 var 
   RefCount : integer;
-  LoadedLibrary : String;
 
 Function TryInitialiseMysql(Const LibraryName: String; argc: cint; argv: PPchar; groups: PPchar) : Integer;
 
@@ -1627,7 +1627,7 @@ begin
     if (MysqlLibraryHandle=nilhandle) then
       Exit;
     Inc(RefCount);
-    LoadedLibrary:=LibraryName;
+    MysqlLoadedLibrary:=LibraryName;
 // Only the procedure that are given in the c-library documentation are loaded, to
 // avoid problems with 'incomplete' libraries
     pointer(my_init) := GetProcedureAddress(MysqlLibraryHandle,'my_init');
@@ -1768,11 +1768,11 @@ begin
   Result := TryInitialiseMysql(LibraryName,argc,argv,groups);
   If Result = 0 then
     Raise EInOutError.CreateFmt(SErrLoadFailed,[LibraryName])
-  else If (LibraryName<>LoadedLibrary) then
+  else If (LibraryName<>MysqlLoadedLibrary) then
     begin
     Dec(RefCount);
     Result := RefCount;
-    Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+    Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[MysqlLoadedLibrary]);
     end;
 end;
 
@@ -1788,7 +1788,7 @@ begin
       begin
       Dec(RefCount);
       MysqlLibraryHandle := NilHandle;
-      LoadedLibrary:='';
+      MysqlLoadedLibrary:='';
       end
     end
 end;

packages/postgres/src/postgres3.pp

@@ -91,6 +91,8 @@ const
 
   function PQprotocolVersion(conn:PPGconn):longint;cdecl;external External_library name 'PQprotocolVersion';
 
+  function PQserverVersion(conn:PPGconn):longint;cdecl;external External_library name 'PQserverVersion';
+
   function PQerrorMessage(conn:PPGconn):Pchar;cdecl;external External_library name 'PQerrorMessage';
 
   function PQsocket(conn:PPGconn):longint;cdecl;external External_library name 'PQsocket';

packages/postgres/src/postgres3dyn.pp

@@ -82,6 +82,7 @@ var
   PQtransactionStatus : function (conn:PPGconn):PGTransactionStatusType;cdecl;
   PQparameterStatus : function (conn:PPGconn; paramName:Pchar):Pchar;cdecl;
   PQprotocolVersion : function (conn:PPGconn):longint;cdecl;
+  PQserverVersion : function (conn:PPGconn):longint;cdecl;
   PQerrorMessage : function (conn:PPGconn):Pchar;cdecl;
   PQsocket : function (conn:PPGconn):longint;cdecl;
   PQbackendPID : function (conn:PPGconn):longint;cdecl;
@@ -224,6 +225,7 @@ Procedure ReleasePostgres3;
 function PQsetdb(M_PGHOST,M_PGPORT,M_PGOPT,M_PGTTY,M_DBNAME : pchar) : ppgconn;
 
 var Postgres3LibraryHandle : TLibHandle;
+  Postgres3LoadedLibrary : String;
 
 implementation
 
@@ -233,7 +235,6 @@ resourcestring
 
 var
   RefCount : integer;
-  LoadedLibrary : String;
 
 procedure InitialisePostgres3;
 
@@ -260,7 +261,7 @@ begin
       Raise EInOutError.CreateFmt(SErrLoadFailed,[libpath]);
       end;
 
-    LoadedLibrary:=libpath;
+    Postgres3LoadedLibrary:=libpath;
     pointer(PQconnectStart) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectStart');
     pointer(PQconnectPoll) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectPoll');
     pointer(PQconnectdb) := GetProcedureAddress(Postgres3LibraryHandle,'PQconnectdb');
@@ -283,6 +284,7 @@ begin
     pointer(PQtransactionStatus) := GetProcedureAddress(Postgres3LibraryHandle,'PQtransactionStatus');
     pointer(PQparameterStatus) := GetProcedureAddress(Postgres3LibraryHandle,'PQparameterStatus');
     pointer(PQprotocolVersion) := GetProcedureAddress(Postgres3LibraryHandle,'PQprotocolVersion');
+    pointer(PQserverVersion) := GetProcedureAddress(Postgres3LibraryHandle,'PQserverVersion');
     pointer(PQerrorMessage) := GetProcedureAddress(Postgres3LibraryHandle,'PQerrorMessage');
     pointer(PQsocket) := GetProcedureAddress(Postgres3LibraryHandle,'PQsocket');
     pointer(PQbackendPID) := GetProcedureAddress(Postgres3LibraryHandle,'PQbackendPID');
@@ -367,10 +369,10 @@ begin
     InitialiseDllist(libpath);
     end
   else
-    if (libpath<>pqlib) and (LoadedLibrary<>libpath) then
+    if (libpath<>pqlib) and (Postgres3LoadedLibrary<>libpath) then
       begin
       Dec(RefCount);
-      Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+      Raise EInOUtError.CreateFmt(SErrAlreadyLoaded,[Postgres3LoadedLibrary]);
       end;
 end;
 

packages/sqlite/src/sqlite3.inc

@@ -5740,6 +5740,7 @@ function InitialiseSQLite(const LibraryName: String): Integer; deprecated;
 var
   SQLiteLibraryHandle: TLibHandle;
   SQLiteDefaultLibrary: String = Sqlite3Lib;
+  SQLiteLoadedLibrary: String;
 {$ENDIF LOAD_DYNAMICALLY}
 
 implementation
@@ -5927,7 +5928,6 @@ end;
 
 var
   RefCount: Integer;
-  LoadedLibrary: String;
 
 function TryInitializeSqlite(const LibraryName: string): Integer;
 begin
@@ -5940,7 +5940,7 @@ begin
       RefCount := 0;
       Exit(-1);
     end;
-    LoadedLibrary := LibraryName;
+    SQLiteLoadedLibrary := LibraryName;
     LoadAddresses(SQLiteLibraryHandle);
   end;
 end;
@@ -5952,8 +5952,8 @@ end;
 
 function  InitializeSQLite(const LibraryName: String) :integer;
 begin
-  if (LoadedLibrary <> '') and (LoadedLibrary <> LibraryName) then
-    raise EInoutError.CreateFmt(SErrAlreadyLoaded,[LoadedLibrary]);
+  if (SQLiteLoadedLibrary <> '') and (SQLiteLoadedLibrary <> LibraryName) then
+    raise EInoutError.CreateFmt(SErrAlreadyLoaded,[SQLiteLoadedLibrary]);
 
   result:= TryInitializeSQLIte(LibraryName);
   if result=-1 then
@@ -5972,7 +5972,7 @@ begin
     if SQLiteLibraryHandle <> NilHandle then
       UnloadLibrary(SQLiteLibraryHandle);
     SQLiteLibraryHandle := NilHandle;
-    LoadedLibrary := '';
+    SQLiteLoadedLibrary := '';
     RefCount := 0;
   end;
 end;