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

git-svn-id: trunk@22985 -

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)
-  protected
+  private
-    FQuery: string;         //:ParamNames converted to $1,$2,..,$n
+    FConnection: TMSSQLConnection;                    // owner connection
-    FCanOpen: boolean;      //can return rows?
+    FQuery: string;                                   // :ParamNames converted to $1,$2,..,$n
-    FRowsAffected: integer;
     FParamReplaceString: string;
-    function ReplaceParams(AParams: TParams; ASQLConnection: TMSSQLConnection): string; //replaces parameters placeholders $1,$2,..$n in FQuery with supplied values in AParams
+  protected
+    FCanOpen: boolean;                                // can return rows?
+    FRowsAffected: integer;
+    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;
+procedure TDBLibCursor.Prepare(Buf: string; AParams: TParams);
-var i:integer;
+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]);
+      ParamValues[AParams.Count-i-1] := FConnection.GetAsSQLText(AParams[i]);
-      //showmessage(ParamNames[AParams.Count-i-1] + '=' + ParamValues[AParams.Count-i-1]);
     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]);
+  //Execute(ANSI_DEFAULTS_ON[IsSybase]);
-  DBExecute('SET QUOTED_IDENTIFIER ON');
+  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);
+  cmd := c.ReplaceParams(AParams);
-  DBExecute(cmd);
+  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
@@ -635,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
@@ -656,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;
 
@@ -806,10 +861,8 @@ 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);
   data:=dbdata(FDBProc, FieldDef.FieldNo);
   datalen:=dbdatlen(FDBProc, FieldDef.FieldNo);
 
@@ -820,7 +873,7 @@ 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