Browse Source

--- Merging r22940 into '.':
U packages/dblib/src/dblib.pp
--- Merging r22941 into '.':
U packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r22949 into '.':
G packages/dblib/src/dblib.pp
U packages/ibase/src/ibase60.inc
U packages/fcl-db/src/sqldb/sqldb.pp
U packages/mysql/src/mysql.inc
U packages/postgres/src/postgres3dyn.pp
--- Merging r22960 into '.':
U packages/fcl-db/src/base/db.pas
U packages/fcl-db/src/base/dsparams.inc
--- Merging r22981 into '.':
U packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Merging r22985 into '.':
G packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r22986 into '.':
G packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

# revisions: 22940,22941,22949,22960,22981,22985,22986
r22940 | michael | 2012-11-06 14:40:50 +0100 (Tue, 06 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/dblib/src/dblib.pp

* trivial patch from Laco
r22941 | lacak | 2012-11-06 14:57:57 +0100 (Tue, 06 Nov 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

fcl-db: mssql: very basic support for variant data type, rather than raising exception.
(as dbconvert does not support SYBVARIANT atm, use direct Move to move raw data into blob buffer)
r22949 | michael | 2012-11-08 00:08:31 +0100 (Thu, 08 Nov 2012) | 2 lines
Changed paths:
M /trunk/packages/dblib/src/dblib.pp
M /trunk/packages/fcl-db/src/sqldb/sqldb.pp
M /trunk/packages/ibase/src/ibase60.inc
M /trunk/packages/mysql/src/mysql.inc
M /trunk/packages/postgres/src/postgres3dyn.pp

* Switched to using ansistring, because dynlibs use ansistrings
r22960 | lacak | 2012-11-09 08:41:03 +0100 (Fri, 09 Nov 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/base/db.pas
M /trunk/packages/fcl-db/src/base/dsparams.inc

fcl-db: change var params to out in TParams.ParseSQL to reduce compiler hints about uninitialized variables.
r22981 | lacak | 2012-11-12 10:57:28 +0100 (Mon, 12 Nov 2012) | 3 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

fcl-db: sqlite: cleanup + formatting
(use already defined constant JulianEpoch instead of own;
use UnicodeCompareStr instead of WideCompareStr)
r22985 | lacak | 2012-11-14 07:21:50 +0100 (Wed, 14 Nov 2012) | 4 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

fcl-db: mssql:
* implements GetConnectionInfo
* renames private method DBExecute to Execute (IMO slightly better name)
* reorders methods to reflex logical order in which they are called
r22986 | lacak | 2012-11-15 10:30:17 +0100 (Thu, 15 Nov 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

fcl-db: sqlite: call InitializeSQLite with SQLiteLibraryName (in same style like in DoInternalConnect)
to avoid exception when connection is already opened.

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

marco 12 years ago
parent
commit
3091ab9fe7

+ 3 - 2
packages/dblib/src/dblib.pp

@@ -134,6 +134,7 @@ const
   SYBNTEXT=$63;
   SYBINT8=$7F;
   SYBUNIQUE=$24;
+  SYBVARIANT=$62;
   //XSYBVARCHAR=$A7;
   //XSYBNVARCHAR=$E7;
   //XSYBNCHAR = $EF;
@@ -379,7 +380,7 @@ procedure dbwinexit;
 function dbsetlcharset(login:PLOGINREC; charset:PChar):RETCODE;
 function dbsetlsecure(login:PLOGINREC):RETCODE;
 
-function InitialiseDBLib(const LibraryName : shortstring = ''): integer;
+function InitialiseDBLib(const LibraryName : ansistring): integer;
 procedure ReleaseDBLib;
 
 implementation
@@ -390,7 +391,7 @@ uses SysUtils, Dynlibs;
 var DBLibLibraryHandle: TLibHandle;
     RefCount: integer;
 
-function InitialiseDBLib(const LibraryName : shortstring): integer;
+function InitialiseDBLib(const LibraryName : ansistring): integer;
 var libname : string;
 begin
   inc(RefCount);

+ 2 - 2
packages/fcl-db/src/base/db.pas

@@ -1231,8 +1231,8 @@ type
     Function  ParamByName(const Value: string): TParam;
     Function  ParseSQL(SQL: String; DoCreate: Boolean): String; overload;
     Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle): String; overload;
-    Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String; overload;
-    Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String; overload;
+    Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding): String; overload;
+    Function  ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding; out ReplaceString : string): String; overload;
     Procedure RemoveParam(Value: TParam);
     Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
     Property Dataset : TDataset Read GetDataset;

+ 3 - 3
packages/fcl-db/src/base/dsparams.inc

@@ -181,7 +181,7 @@ begin
   Result := ParseSQL(SQL,DoCreate,EscapeSlash,EscapeRepeat,ParameterStyle,pb, rs);
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String;
+Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat : Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding): String;
 
 var rs : string;
 
@@ -236,7 +236,7 @@ begin
   end; {case}
 end;
 
-Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding; var ReplaceString : string): String;
+Function TParams.ParseSQL(SQL: String; DoCreate, EscapeSlash, EscapeRepeat: Boolean; ParameterStyle : TParamStyle; out ParamBinding: TParambinding; out ReplaceString : string): String;
 
 type
   // used for ParamPart
@@ -268,7 +268,7 @@ begin
   ParamCount:=0;
   NewQueryLength:=Length(SQL);
   SetLength(ParamPart,ParamAllocStepSize);
-  SetLength(Parambinding,ParamAllocStepSize);
+  SetLength(ParamBinding,ParamAllocStepSize);
   QuestionMarkParamCount:=0; // number of ? params found in query so far
 
   ReplaceString := '$';

+ 136 - 73
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -44,6 +44,12 @@ uses
 
 type
 
+  TServerInfo = record
+    ServerVersion: string;
+    ServerVersionString: string;
+    UserName: string;
+  end;
+
   TClientCharset = (ccNone, ccUTF8, ccISO88591, ccUnknown);
 
   { TMSSQLConnection }
@@ -54,8 +60,9 @@ type
     FDBProc : PDBPROCESS;
     Ftds    : integer;     // TDS protocol version
     Fstatus : STATUS;      // current result/rows fetch status
+    FServerInfo: TServerInfo;
     function CheckError(const Ret: RETCODE): RETCODE;
-    procedure DBExecute(const cmd: string);
+    procedure Execute(const cmd: string); overload;
     procedure ExecuteDirectSQL(const Query: string);
     function TranslateFldType(SQLDataType: integer): TFieldType;
     function ClientCharset: TClientCharset;
@@ -72,10 +79,6 @@ type
     function AllocateCursorHandle:TSQLCursor; override;
     procedure DeAllocateCursorHandle(var cursor:TSQLCursor); override;
     function AllocateTransactionHandle:TSQLHandle; override;
-    // - Statement handling
-    function StrToStatementType(s : string) : TStatementType; override;
-    procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
-    procedure UnPrepareStatement(cursor:TSQLCursor); override;
     // - Transaction handling
     function GetTransactionHandle(trans:TSQLHandle):pointer; override;
     function StartDBTransaction(trans:TSQLHandle; AParams:string):boolean; override;
@@ -83,6 +86,10 @@ type
     function Rollback(trans:TSQLHandle):boolean; override;
     procedure CommitRetaining(trans:TSQLHandle); override;
     procedure RollbackRetaining(trans:TSQLHandle); override;
+    // - Statement handling
+    function StrToStatementType(s : string) : TStatementType; override;
+    procedure PrepareStatement(cursor:TSQLCursor; ATransaction:TSQLTransaction; buf:string; AParams:TParams); override;
+    procedure UnPrepareStatement(cursor:TSQLCursor); override;
     // - Statement execution
     procedure Execute(cursor:TSQLCursor; ATransaction:TSQLTransaction; AParams:TParams); override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
@@ -166,12 +173,20 @@ type
   { TDBLibCursor }
 
   TDBLibCursor = class(TSQLCursor)
+  private
+    FConnection: TMSSQLConnection;                    // owner connection
+    FQuery: string;                                   // :ParamNames converted to $1,$2,..,$n
+    FParamReplaceString: string;
   protected
-    FQuery: string;         //:ParamNames converted to $1,$2,..,$n
-    FCanOpen: boolean;      //can return rows?
+    FCanOpen: boolean;                                // can return rows?
     FRowsAffected: integer;
-    FParamReplaceString: string;
-    function ReplaceParams(AParams: TParams; ASQLConnection: TMSSQLConnection): string; //replaces parameters placeholders $1,$2,..$n in FQuery with supplied values in AParams
+    function ReplaceParams(AParams: TParams): string; // replaces parameters placeholders $1,$2,..$n in FQuery with supplied values in AParams
+    procedure Prepare(Buf: string; AParams: TParams);
+    procedure Execute(AParams: TParams);
+    function Fetch: boolean;
+    procedure Put(column: integer; out s: string); overload;
+  public
+    constructor Create(AConnection: TMSSQLConnection); overload;
   end;
 
 
@@ -202,8 +217,18 @@ end;
 
 { TDBLibCursor }
 
-function TDBLibCursor.ReplaceParams(AParams: TParams; ASQLConnection: TMSSQLConnection): string;
-var i:integer;
+procedure TDBLibCursor.Prepare(Buf: string; AParams: TParams);
+var
+  ParamBinding : TParamBinding;
+begin
+  if assigned(AParams) and (AParams.Count > 0) then
+    FQuery:=AParams.ParseSQL(Buf, false, sqEscapeSlash in FConnection.ConnOptions, sqEscapeRepeat in FConnection.ConnOptions, psSimulated, ParamBinding, FParamReplaceString)
+  else
+    FQuery:=Buf;
+end;
+
+function TDBLibCursor.ReplaceParams(AParams: TParams): string;
+var i: integer;
     ParamNames, ParamValues: array of string;
 begin
   if Assigned(AParams) and (AParams.Count > 0) then //taken from mysqlconn, pqconnection
@@ -213,8 +238,7 @@ begin
     for i := 0 to AParams.Count -1 do
     begin
       ParamNames[AParams.Count-i-1] := format('%s%d', [FParamReplaceString, AParams[i].Index+1]);
-      ParamValues[AParams.Count-i-1] := ASQLConnection.GetAsSQLText(AParams[i]);
-      //showmessage(ParamNames[AParams.Count-i-1] + '=' + ParamValues[AParams.Count-i-1]);
+      ParamValues[AParams.Count-i-1] := FConnection.GetAsSQLText(AParams[i]);
     end;
     Result := stringsreplace(FQuery, ParamNames, ParamValues, [rfReplaceAll]);
   end
@@ -222,6 +246,32 @@ begin
     Result := FQuery;
 end;
 
+procedure TDBLibCursor.Execute(AParams: TParams);
+begin
+  Fconnection.Execute(Self, nil, AParams);
+end;
+
+function TDBLibCursor.Fetch: boolean;
+begin
+  Result := Fconnection.Fetch(Self);
+end;
+
+procedure TDBLibCursor.Put(column: integer; out s: string);
+var
+  data: PByte;
+  datalen: DBINT;
+begin
+  data := dbdata(Fconnection.FDBProc, column);
+  datalen := dbdatlen(Fconnection.FDBProc, column);
+  SetString(s, PAnsiChar(data), datalen);
+end;
+
+constructor TDBLibCursor.Create(AConnection: TMSSQLConnection);
+begin
+  inherited Create;
+  FConnection := AConnection;
+end;
+
 
 { TSybaseConnection }
 
@@ -285,7 +335,7 @@ begin
   DatabaseName:='';
   try
     Open;
-    DBExecute(Query);
+    Execute(Query);
   finally
     Close;
     DatabaseName:=ADatabaseName;
@@ -343,6 +393,7 @@ const
   IMPLICIT_TRANSACTIONS_OFF: array[boolean] of shortstring = ('SET IMPLICIT_TRANSACTIONS OFF', 'SET CHAINED OFF');
   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');
+  VERSION_NUMBER: array[boolean] of shortstring = ('SERVERPROPERTY(''ProductVersion'')', '@@version_number');
 begin
   // Do not call the inherited method as it checks for a non-empty DatabaseName, empty DatabaseName=default database defined for login
   //inherited DoInternalConnect;
@@ -394,19 +445,38 @@ begin
   //while dbresults(FDBProc) = SUCCEED do ;
 
   // Also SQL Server ODBC driver and Microsoft OLE DB Provider for SQL Server set ANSI_DEFAULTS to ON when connecting
-  //DBExecute(ANSI_DEFAULTS_ON[IsSybase]);
-  DBExecute('SET QUOTED_IDENTIFIER ON');
+  //Execute(ANSI_DEFAULTS_ON[IsSybase]);
+  Execute('SET QUOTED_IDENTIFIER ON');
 
   if Params.IndexOfName(STextSize) <> -1 then
-    DBExecute('SET TEXTSIZE '+Params.Values[STextSize])
+    Execute('SET TEXTSIZE '+Params.Values[STextSize])
   else
-    DBExecute('SET TEXTSIZE 16777216');
+    Execute('SET TEXTSIZE 16777216');
 
   if AutoCommit then
-    DBExecute(IMPLICIT_TRANSACTIONS_OFF[IsSybase]); //set connection to autocommit mode - default
+    Execute(IMPLICIT_TRANSACTIONS_OFF[IsSybase]); //set connection to autocommit mode - default
 
   if DatabaseName <> '' then
     CheckError( dbuse(FDBProc, PChar(DatabaseName)) );
+
+  with TDBLibCursor.Create(Self) do
+  begin
+    try
+      Prepare(format('SELECT cast(%s as varchar), @@version, user_name()', [VERSION_NUMBER[IsSybase]]), nil);
+      Execute(nil);
+      if Fetch then
+      begin
+        Put(1, FServerInfo.ServerVersion);
+        Put(2, FServerInfo.ServerVersionString);
+        Put(3, FServerInfo.UserName);
+      end;
+    except
+      FServerInfo.ServerVersion:='';
+      FServerInfo.ServerVersionString:='';
+      FServerInfo.UserName:='';
+    end;
+    Free;
+  end;
 end;
 
 procedure TMSSQLConnection.DoInternalDisconnect;
@@ -421,7 +491,7 @@ end;
 
 function TMSSQLConnection.AllocateCursorHandle: TSQLCursor;
 begin
-   Result:=TDBLibCursor.Create;
+   Result:=TDBLibCursor.Create(Self);
 end;
 
 procedure TMSSQLConnection.DeAllocateCursorHandle(var cursor: TSQLCursor);
@@ -438,26 +508,6 @@ begin
     Result:=inherited StrToStatementType(s);
 end;
 
-procedure TMSSQLConnection.PrepareStatement(cursor: TSQLCursor;
-   ATransaction: TSQLTransaction; buf: string; AParams: TParams);
-var
-  ParamBinding : TParamBinding;
-begin
-  with cursor as TDBLibCursor do
-  begin
-    if assigned(AParams) and (AParams.Count > 0) then
-      FQuery:=AParams.ParseSQL(buf, false, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psSimulated, ParamBinding, FParamReplaceString)
-    else
-      FQuery:=buf;
-  end;
-end;
-
-procedure TMSSQLConnection.UnPrepareStatement(cursor: TSQLCursor);
-begin
-  if assigned(FDBProc) and (Fstatus <> NO_MORE_ROWS) then
-    dbcanquery(FDBProc);
-end;
-
 function TMSSQLConnection.AllocateTransactionHandle: TSQLHandle;
 begin
   Result:=nil;
@@ -472,31 +522,31 @@ function TMSSQLConnection.StartDBTransaction(trans: TSQLHandle; AParams: string)
 begin
   Result := not AutoCommit;
   if Result then
-    DBExecute(SBeginTransaction);
+    Execute(SBeginTransaction);
 end;
 
 function TMSSQLConnection.Commit(trans: TSQLHandle): boolean;
 begin
-  DBExecute('COMMIT');
+  Execute('COMMIT');
   Result:=true;
 end;
 
 function TMSSQLConnection.Rollback(trans: TSQLHandle): boolean;
 begin
-  DBExecute('ROLLBACK');
+  Execute('ROLLBACK');
   Result:=true;
 end;
 
 procedure TMSSQLConnection.CommitRetaining(trans: TSQLHandle);
 begin
   if Commit(trans) then
-    DBExecute(SBeginTransaction);
+    Execute(SBeginTransaction);
 end;
 
 procedure TMSSQLConnection.RollbackRetaining(trans: TSQLHandle);
 begin
   if Rollback(trans) then
-    DBExecute(SBeginTransaction);
+    Execute(SBeginTransaction);
 end;
 
 function TMSSQLConnection.AutoCommit: boolean;
@@ -504,15 +554,6 @@ begin
   Result := StrToBoolDef(Params.Values[SAutoCommit], False);
 end;
 
-procedure TMSSQLConnection.DBExecute(const cmd: string);
-begin
-  DBErrorStr:='';
-  DBMsgStr  :='';
-  CheckError( dbcmd(FDBProc, PChar(cmd)) );
-  CheckError( dbsqlexec(FDBProc) );
-  CheckError( dbresults(FDBProc) );
-end;
-
 function TMSSQLConnection.ClientCharset: TClientCharset;
 begin
 {$IF (FPC_VERSION>=2) AND (FPC_RELEASE>4)}
@@ -534,6 +575,27 @@ begin
 {$ENDIF}
 end;
 
+procedure TMSSQLConnection.PrepareStatement(cursor: TSQLCursor;
+   ATransaction: TSQLTransaction; buf: string; AParams: TParams);
+begin
+  (cursor as TDBLibCursor).Prepare(buf, AParams);
+end;
+
+procedure TMSSQLConnection.UnPrepareStatement(cursor: TSQLCursor);
+begin
+  if assigned(FDBProc) and (Fstatus <> NO_MORE_ROWS) then
+    dbcanquery(FDBProc);
+end;
+
+procedure TMSSQLConnection.Execute(const cmd: string);
+begin
+  DBErrorStr:='';
+  DBMsgStr  :='';
+  CheckError( dbcmd(FDBProc, PChar(cmd)) );
+  CheckError( dbsqlexec(FDBProc) );
+  CheckError( dbresults(FDBProc) );
+end;
+
 procedure TMSSQLConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransaction; AParams: TParams);
 var c: TDBLibCursor;
     cmd: string;
@@ -541,8 +603,8 @@ var c: TDBLibCursor;
 begin
   c:=cursor as TDBLibCursor;
 
-  cmd := c.ReplaceParams(AParams, Self);
-  DBExecute(cmd);
+  cmd := c.ReplaceParams(AParams);
+  Execute(cmd);
 
   res := SUCCEED;
   repeat
@@ -556,7 +618,7 @@ begin
       repeat until dbnextrow(FDBProc) = NO_MORE_ROWS;
       res := CheckError( dbresults(FDBProc) );
     end;
-  until (res = NO_MORE_RESULTS) or c.FCanOpen;
+  until c.FCanOpen or (res = NO_MORE_RESULTS) or (res = FAIL);
 
   if res = NO_MORE_RESULTS then
     Fstatus := NO_MORE_ROWS
@@ -593,6 +655,7 @@ begin
     SQLBINARY:           Result:=ftBytes;
     SQLVARBINARY:        Result:=ftVarBytes;
     SYBUNIQUE:           Result:=ftGuid;
+    SYBVARIANT:          Result:=ftBlob;
   else
     DatabaseErrorFmt('Unsupported SQL DataType %d "%s"', [SQLDataType, dbprtype(SQLDataType)]);
     Result:=ftUnknown;
@@ -634,13 +697,6 @@ begin
         FieldType := ftAutoInc;
     end;
 
-{   // dbcolinfo(), dbcoltype() maps VARCHAR->CHAR, VARBINARY->BINARY:
-    if col.VarLength {true also when column is nullable} then
-      case FieldType of
-        ftFixedChar: FieldType := ftString;
-        ftBytes    : FieldType := ftVarBytes;
-      end;
-}
     with TFieldDef.Create(FieldDefs, FieldDefs.MakeNameUnique(FieldName), FieldType, FieldSize, (col.Null=0) and (not col.Identity), i) do
     begin
       // identity, timestamp and calculated column are not updatable
@@ -655,14 +711,14 @@ end;
 
 function TMSSQLConnection.Fetch(cursor: TSQLCursor): boolean;
 begin
-  //Compute rows resulting from the COMPUTE clause are not processed
+  // Compute rows resulting from the COMPUTE clause are not processed
   repeat
     Fstatus := dbnextrow(FDBProc);
     Result  := Fstatus=REG_ROW;
   until Result or (Fstatus = NO_MORE_ROWS);
 
   if Fstatus = NO_MORE_ROWS then
-    while dbresults(FDBProc) <> NO_MORE_RESULTS do //process remaining results if there are any
+    while dbresults(FDBProc) <> NO_MORE_RESULTS do // process remaining results if there are any
       repeat until dbnextrow(FDBProc) = NO_MORE_ROWS;
 end;
 
@@ -805,22 +861,19 @@ procedure TMSSQLConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;
    ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
 var data: PByte;
     datalen: DBINT;
-    srctype: INT;
 begin
-  //see also LoadField
-  srctype:=dbcoltype(FDBProc, FieldDef.FieldNo);
+  // see also LoadField
   data:=dbdata(FDBProc, FieldDef.FieldNo);
   datalen:=dbdatlen(FDBProc, FieldDef.FieldNo);
 
   ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, datalen);
-
-  ABlobBuf^.BlobBuffer^.Size :=
-    dbconvert(FDBProc, srctype, data , datalen, srctype, ABlobBuf^.BlobBuffer^.Buffer, datalen);
+  Move(data^, ABlobBuf^.BlobBuffer^.Buffer^, datalen);
+  ABlobBuf^.BlobBuffer^.Size := datalen;
 end;
 
 procedure TMSSQLConnection.FreeFldBuffers(cursor: TSQLCursor);
 begin
-   inherited FreeFldBuffers(cursor);
+  inherited FreeFldBuffers(cursor);
 end;
 
 procedure TMSSQLConnection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string);
@@ -892,11 +945,21 @@ begin
 end;
 
 function TMSSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
+const
+  SERVER_TYPE: array[boolean] of string = ('Microsoft SQL Server', 'ASE'); // product_name returned in TDS login token; same like ODBC SQL_DBMS_NAME
 begin
   Result:='';
   try
     InitialiseDBLib(DBLibLibraryName);
     case InfoType of
+      citServerType:
+        Result:=SERVER_TYPE[IsSybase];
+      citServerVersion:
+        if Connected then
+          Result:=FServerInfo.ServerVersion;
+      citServerVersionString:
+        if Connected then
+          Result:=FServerInfo.ServerVersionString;
       citClientName:
         Result:=TMSSQLConnectionDef.LoadedLibraryName;
     else

+ 1 - 1
packages/fcl-db/src/sqldb/sqldb.pp

@@ -475,7 +475,7 @@ type
   TSQLConnectionClass = Class of TSQLConnection;
 
   { TConnectionDef }
-  TLibraryLoadFunction = Function (Const S : ShortString) : Integer;
+  TLibraryLoadFunction = Function (Const S : AnsiString) : Integer;
   TLibraryUnLoadFunction = Procedure;
   TConnectionDef = Class(TPersistent)
     Class Function TypeName : String; virtual;

+ 29 - 31
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -86,7 +86,7 @@ type
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
     // New methods
     procedure execsql(const asql: string);
-    procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override; // Differs from SQLDB.
+    procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); override;
     function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
     function StrToStatementType(s : string) : TStatementType; override;
@@ -122,8 +122,10 @@ implementation
 uses
   dbconst, sysutils, dateutils, FmtBCD;
 
+{$IF NOT DECLARED(JulianEpoch)} // sysutils/datih.inc
 const
-  JulianDateShift = 2415018.5; //distance from "julian day 0" (January 1, 4713 BC 12:00AM) to "1899-12-30 00:00AM"
+  JulianEpoch = TDateTime(-2415018.5); // "julian day 0" is January 1, 4713 BC 12:00AM
+{$ENDIF}
 
 type
 
@@ -139,7 +141,7 @@ type
    fparambinding: array of Integer;
    procedure checkerror(const aerror: integer);
    procedure bindparams(AParams : TParams);
-   Procedure Prepare(Buf : String; APArams : TParams);
+   Procedure Prepare(Buf : String; AParams : TParams);
    Procedure UnPrepare;
    Procedure Execute;
    Function Fetch : Boolean;
@@ -178,37 +180,34 @@ Procedure TSQLite3Cursor.bindparams(AParams : TParams);
 Var
   I : Integer;
   P : TParam;  
-  pc : pchar;
   str1: string;
-  cu1: currency;
   do1: double;
-  parms : array of Integer;
   wstr1: widestring;
   
 begin
-  for I:=1  to high(fparambinding)+1 do 
+  for I:=1 to high(fparambinding)+1 do
     begin
-    P:=aparams[fparambinding[I-1]];
-    if P.isnull then 
+    P:=AParams[fparambinding[I-1]];
+    if P.IsNull then
       checkerror(sqlite3_bind_null(fstatement,I))
     else 
       case P.datatype of
-        ftinteger,
-        ftboolean,
-        ftsmallint: checkerror(sqlite3_bind_int(fstatement,I,p.asinteger));
-        ftword:     checkerror(sqlite3_bind_int(fstatement,I,P.asword));
-        ftlargeint: checkerror(sqlite3_bind_int64(fstatement,I,P.aslargeint));
-        ftbcd,
-        ftfloat,
-        ftcurrency:
+        ftInteger,
+        ftBoolean,
+        ftSmallint: checkerror(sqlite3_bind_int(fstatement,I,P.AsInteger));
+        ftWord:     checkerror(sqlite3_bind_int(fstatement,I,P.AsWord));
+        ftLargeint: checkerror(sqlite3_bind_int64(fstatement,I,P.AsLargeint));
+        ftBcd,
+        ftFloat,
+        ftCurrency:
                 begin
                 do1:= P.AsFloat;
                 checkerror(sqlite3_bind_double(fstatement,I,do1));
                 end;
-        ftdatetime,
-        ftdate,
-        fttime: begin
-                do1:= P.AsFloat + JulianDateShift;
+        ftDateTime,
+        ftDate,
+        ftTime: begin
+                do1:= P.AsFloat - JulianEpoch;
                 checkerror(sqlite3_bind_double(fstatement,I,do1));
                 end;
         ftFMTBcd:
@@ -216,9 +215,9 @@ begin
                 str1:=BCDToStr(P.AsFMTBCD, Fconnection.FSQLFormatSettings);
                 checkerror(sqlite3_bind_text(fstatement, I, PChar(str1), length(str1), sqlite3_destructor_type(SQLITE_TRANSIENT)));
                 end;
-        ftstring,
+        ftString,
         ftFixedChar,
-        ftmemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
+        ftMemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
                 str1:= p.asstring;
                 checkerror(sqlite3_bind_text(fstatement,I,pcharstr(str1), length(str1),@freebindstring));
                 end;
@@ -239,12 +238,12 @@ begin
     end;   
 end;
 
-Procedure TSQLite3Cursor.Prepare(Buf : String; APArams : TParams);
+Procedure TSQLite3Cursor.Prepare(Buf : String; AParams : TParams);
 
 begin
-  if assigned(aparams) and (aparams.count > 0) then 
-    buf := aparams.parsesql(buf,false,false,false,psinterbase,fparambinding);
-  checkerror(sqlite3_prepare(fhandle,pchar(buf),length(buf),@fstatement,@ftail));
+  if assigned(AParams) and (AParams.Count > 0) then
+    Buf := AParams.ParseSQL(Buf,false,false,false,psInterbase,fparambinding);
+  checkerror(sqlite3_prepare(fhandle,pchar(Buf),length(Buf),@fstatement,@ftail));
   FPrepared:=True;
 end;
 
@@ -414,7 +413,6 @@ var
  FN,FD : string;
  ft1   : tfieldtype;
  size1, size2 : integer;
- ar1   : TStringArray;
  fi    : integer;
  st    : psqlite3_stmt;
 
@@ -621,7 +619,7 @@ begin
                begin
                PDateTime(buffer)^ := sqlite3_column_double(st,fnum);
                if PDateTime(buffer)^ > 1721059.5 {Julian 01/01/0000} then
-                  PDateTime(buffer)^ := PDateTime(buffer)^ - JulianDateShift; //backward compatibility hack
+                  PDateTime(buffer)^ := PDateTime(buffer)^ + JulianEpoch; //backward compatibility hack
                end;
     ftFixedChar,
     ftString: begin
@@ -932,7 +930,7 @@ function TSQLite3Connection.GetConnectionInfo(InfoType: TConnInfoType): string;
 begin
   Result:='';
   try
-    InitializeSqlite;
+    InitializeSqlite(SQLiteLibraryName);
     case InfoType of
       citServerType:
         Result:=TSQLite3ConnectionDef.TypeName;
@@ -956,7 +954,7 @@ var S1, S2: AnsiString;
 begin
   SetString(S1, data1, len1);
   SetString(S2, data2, len2);
-  Result := WideCompareStr(UTF8Decode(S1), UTF8Decode(S2));
+  Result := UnicodeCompareStr(UTF8Decode(S1), UTF8Decode(S2));
 end;
 
 procedure TSQLite3Connection.CreateCollation(const CollationName: string;

+ 3 - 3
packages/ibase/src/ibase60.inc

@@ -2459,7 +2459,7 @@ var
   isc_suspend_window : function (_para1:PISC_STATUS; _para2:Pisc_win_handle):ISC_STATUS; extdecl;
 {$ENDIF}
 
-function InitialiseIBase60(Const LibraryName : String) : integer;
+function InitialiseIBase60(Const LibraryName : AnsiString) : integer;
 function InitialiseIBase60 : integer;
 procedure ReleaseIBase60;
 
@@ -2481,7 +2481,7 @@ var
   RefCount : integer;
   LoadedLibrary : String;
 
-Function TryInitialiseIBase60(Const LibraryName : String) : integer;
+Function TryInitialiseIBase60(Const LibraryName : AnsiString) : integer;
 
 begin
   Result := 0;
@@ -2689,7 +2689,7 @@ begin
   Result := RefCount;
 end;
 
-function InitialiseIBase60(Const LibraryName : String) : integer;
+function InitialiseIBase60(Const LibraryName : AnsiString) : integer;
 
 begin
   Result := TryInitialiseIBase60(LibraryName);

+ 5 - 5
packages/mysql/src/mysql.inc

@@ -1596,8 +1596,8 @@ uses
 {$endif}
 
 {$IFDEF LinkDynamically}
-Function InitialiseMysql(Const LibraryName : String) : Integer;
-Function InitialiseMysql(Const LibraryName : String; argc: cint; argv:PPchar = Nil; groups:PPchar = nil) : Integer;
+Function InitialiseMysql(Const LibraryName : AnsiString) : Integer;
+Function InitialiseMysql(Const LibraryName : AnsiString; argc: cint; argv:PPchar = Nil; groups:PPchar = nil) : Integer;
 Function InitialiseMysql(argc:cint = -1; argv:PPchar = nil; groups:PPchar = nil) : Integer;
 Procedure ReleaseMysql;
 
@@ -1617,7 +1617,7 @@ ResourceString
 var 
   RefCount : integer;
 
-Function TryInitialiseMysql(Const LibraryName: String; argc: cint; argv: PPchar; groups: PPchar) : Integer;
+Function TryInitialiseMysql(Const LibraryName: AnsiString; argc: cint; argv: PPchar; groups: PPchar) : Integer;
 
 begin
   Result := 0;
@@ -1756,13 +1756,13 @@ begin
   Result := RefCount;
 end;
 
-Function InitialiseMysql(Const LibraryName: String) : Integer;
+Function InitialiseMysql(Const LibraryName: AnsiString) : Integer;
 
 begin
   Result:=InitialiseMySQL(LibraryName,-1,Nil,Nil);
 end;
 
-Function InitialiseMysql(Const LibraryName: String; argc: cint; argv: PPchar; groups:PPchar) : Integer;
+Function InitialiseMysql(Const LibraryName: AnsiString; argc: cint; argv: PPchar; groups:PPchar) : Integer;
 
 begin
   Result := TryInitialiseMysql(LibraryName,argc,argv,groups);

+ 2 - 2
packages/postgres/src/postgres3dyn.pp

@@ -218,7 +218,7 @@ var
 { Get encoding id from environment variable PGCLIENTENCODING  }
   PQenv2encoding: function :longint;cdecl;
 
-Function InitialisePostgres3(Const libpath : shortstring) : integer;
+Function InitialisePostgres3(Const libpath : ansistring) : integer;
 Procedure InitialisePostgres3;
 Procedure ReleasePostgres3;
 
@@ -247,7 +247,7 @@ begin
 end;
 
 
-function InitialisePostgres3(Const libpath : shortstring) : Integer;
+function InitialisePostgres3(Const libpath : ansistring) : Integer;
 
 begin
   inc(RefCount);