View Issue Details

IDProjectCategoryView StatusLast Update
0017303FPCDatabasepublic2012-03-27 09:52
ReporterLacaKAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version2.5.1Product Build 
Target Version3.0.0Fixed in Version3.0.0 
Summary0017303: MS SQL Server connection component (TMSSQLConnection class)
Descriptiondescendant of TSQLConnection class, which uses either Microsoft Client DB-Library (ntwdblib.dll)
 or db-lib (dblib.dll) from FreeTDS project (multiplatform) as native client library.
Tested only under Windows, so some work for *nix must be done.

Files: mssqlconn.pp - TMSSQLConnection class
       dblib.pp - DB-Library API (static linkage either to ntwdblib.dll or dblib.dll)
       dblib.dll - compiled FreeTDS db-lib API (AFAIK FreeTDS project does not release precompiled libraries, so I used MS Visual C++ 2005 Express (free) to build it)

Some "optimalization" suggestions:
1. add to TParams class method, which replaces parameter placeholders in parsed SQL (produced by TParams.ParseSQL) $1,..,$n with values of parameters
There is in mssqlconn.pp method ReplaceParams with same source code (which replaces $1,..,$n with actual parameter values formated using GetAsSQLText) as in mysqlconn.pp and pqconnection.pp
So if we move this method to dsparams.inc (or in sqldb.pp) and make it global, we should get rid of "duplicated code".

2. add function/method to determine storage size of individual field types
There is private method TCustomBufDataset.GetFieldSize in bufdataset.pas which do it (just like property DataSize of TField)
If we move this method to fields.inc into TFieldDef class and make it public (or implement property TFieldDef.DataSize read GetFieldSize),
 then we will have in one place "size handling" and if some datatype storage will be changed or added, then only this unit will be modified
 and we can get rid of "repeated" code (in TSQLConnection descendants) like this (to determine fields storage size into record buffer):
  case FieldDef.DataType of
   ftString:= destlen:=FieldDef.Size+1;
   ftSmallint: destlen:=sizeof(smallint);
   ftInteger: destlen:=sizeof(integer);
   ftLargeInt: destlen:=sizeof(int64);
   ftCurrency,ftFloat: destlen:=sizeof(double);
   ftBoolean: destlen:=sizeof(wordbool);
   ...etc.
  end;
TagsNo tags attached.
Fixed in Revision20522
FPCOldBugId
FPCTarget
Attached Files
  • mssqlconn_beta1.zip (113,986 bytes)
  • mssqlconn_beta2.zip (114,600 bytes)
  • mssqltest.pas (4,858 bytes)
    program mssqltest;
    
    {Test program for Lacak2's mssqlconn
    Microsoft SQL Server connection.
    Defaults are set up for SQL Express database on local machine.
    
    Required:
    Windows (or fixed source code for Linux/OSX)
    FreeTDS dblib.dll
    freetds.conf (see mssqlconn.pas)
    Microsoft SQL Server database (e.g. SQL Express)
    }
    {$mode objfpc}{$H+}
    {$APPTYPE CONSOLE}
    uses {$IFDEF UNIX} {$IFDEF UseCThreads}
      cthreads, {$ENDIF} {$ENDIF}
      Classes,
      SysUtils,
      sqldb,
      mssqlconn;
    
    const
      Database = 'master'; //always present on an MS SQL system.
    var
      FConnection: TMSSQLConnection;
      FQuery: TSQLQuery;
      FTransaction: TSQLTransaction;
      FServer: string;
      FInstance: string;
      FTrustedAuth: boolean;
      //Trusted authentication/SSPI. If on, no username/password required
      FUsername: string;
      FPassword: string;
    
    procedure GetUserInfo;
    var
      Response: string;
      Scroll: integer;
    begin
      writeln('MSSQL Test program');
      writeln('******************');
      writeln('Please enter/confirm your connection settings for this test:');
      writeln('');
      Response := '';
      writeln('Enter server name or IP for SQL server or ' + LineEnding +
        'nothing to keep current setting: ' + FServer);
      readln(Response);
      if Response <> '' then
      begin
        FServer := Response;
      end;
    
      Response := '';
      writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
        'nothing to keep current setting: ' + FInstance);
      readln(Response);
      if Response <> '' then
      begin
        FInstance := Response;
      end;
    
      Response := '';
      writeln('Authenticate with your current Windows (trusted authentication/SSPI)?' +
        LineEnding + 'Enter nothing to keep current setting: Y');
      readln(Response);
      Response := AnsiUpperCase(Response);
      if Response = 'N' then
      begin
        FTrustedAuth := False;
      end
      else
      begin
        FTrustedAuth := True;
      end;
    
      if FTrustedAuth = False then
      begin
        Response := '';
        writeln('Enter SQL Server username or ' + LineEnding +
          'nothing to keep current setting: ' + FUsername);
        readln(Response);
        if Response <> '' then
        begin
          FUsername := Response;
        end;
    
        Response := '';
        writeln('Enter password ' + LineEnding +
          '(NOTE NOT HIDDEN ON SCREEN): ';
        readln(Response);
        if Response <> '' then
        begin
          FPassword := Response;
        end;
      end;
      //scroll some, the lazy way
      for Scroll := 0 to 200 do
      begin
        writeln('');
      end;
    end;
    
    procedure ShowUserInfo;
    begin
      writeln('Current connection settings:');
      writeln('Server/Instance:' + FServer + '/' + FInstance);
      if FTrustedAuth = True then
      begin
        writeln('Trusted authentication/SSPI is on.');
      end
      else
      begin
        writeln('Trusted authentication/SSPI is off.');
        writeln('Username: ' + FUsername);
        writeln('Password not shown.');
      end;
    end;
    
    procedure GetDatabases;
    const
      SQL = 'select name,database_id,create_date from master.sys.databases;';
    begin
      FQuery.SQL.Text:=SQL;
      writeln('Going to run: ' + LineEnding +
      SQL);
      FQuery.Open;
      while not FQuery.EOF do
      begin
        writeln(
        FQuery.Fields[0].AsString, ',',
        FQuery.Fields[1].AsString, ',',
        FQuery.Fields[2].AsString, ','
        );
        FQuery.Next;
      end;
    end;
    
    {
    //to do.
    function TestStoredProcedure: boolean;
    const
      SQL = 'execute master.sys.sp_who;';
      //won't return results...
    begin
    end;
    }
    
    procedure Connect;
    begin
      FConnection:=TMSSQLConnection.Create(nil);
      FConnection.HostName:=FServer;
      FConnection.DatabaseName:=Database;
      if FTrustedAuth=true then
      begin
        //do nothing for now, don't know how to handle!
        writeln('don''t know how to handle trusted auth!');
      end
      else
      begin
        FConnection.UserName:=FUsername;
        FConnection.Password:=FPassword;
      end;
      FConnection.CharSet:='UTF-8';
      try
        FConnection.Connected:=true;
      except
        on E: exception do
        begin
          writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
          raise; //stop program
        end;
      end;
    
      FTransaction:=TSQLTransaction.Create(nil);
      FConnection.Transaction:=FTransaction;
    
      FQuery:=TSQLQuery.Create(nil);
      FQuery.Database:=FConnection;
    end;
    
    procedure Disconnect;
    begin
      FTransaction.Active:=false;
      FQuery.Free;
      FConnection.Close;
      FConnection.Free;
    end;
    
    begin
      FTrustedAuth := True;
      FServer := '.'; //current host
      FInstance := '.'; //default FInstance
      FUsername := 'sa'; //default administrator account
      FPassword := ''; //default FPassword on older versions
      GetUserInfo; //ask user for connection settings and...
      ShowUserInfo; //...repeat it back to him
      { Now try a connect to the master database, and run a simple query }
      Connect;
      GetDatabases; //Show query results;
      Disconnect;
    end.
    
    
    mssqltest.pas (4,858 bytes)
  • dblib.pp.diff (1,202 bytes)
    --- dblib.pp.ori	Tue Sep 14 10:56:14 2010
    +++ dblib.pp	Tue Sep 06 15:38:59 2011
    @@ -19,11 +19,13 @@
         FreeTDS:
           tds version = 7.0 - MS SQL Server 7
                         7.1 - MS SQL Server 2000 (*default*)
    -                    7.2 - MS SQL Server 2005
    +                    7.2 - MS SQL Server 2005/2008
           tds version can be set using env.var. TDSVER or in freetds.conf or .freetds.conf
     }
     unit dblib;
     
    +{$mode objfpc}
    +
     //{$DEFINE ntwdblib} //if you are using MS SQL Server Client Library (ntwdblib.dll)
     {$DEFINE freetds} //if you are using db-lib from FreeTDS project (Microsoft+Sybase support)
     
    @@ -156,9 +158,9 @@
          month: INT;       // 1 - 12
          {$IFDEF freetds}
          day: INT;         // 1 - 31
    -     dayofyear: INT;   // 1 - 366 (in sybdb.h are dayofyear and day echanged!)
    +     dayofyear: INT;   // 1 - 366 (in sybdb.h dayofyear and day are changed around!)
          {$ELSE}
    -     dayofyear: INT;   // 1 - 366 (in sybdb.h are dayofyear and day echanged!)
    +     dayofyear: INT;   // 1 - 366 (in sybdb.h dayofyear and day are changed around!)
          day: INT;         // 1 - 31
          {$ENDIF}
          week: INT;        // 1 - 54 (for leap years)
    
    dblib.pp.diff (1,202 bytes)
  • mssqltest2.pas (7,178 bytes)
    program mssqltest;
    
    {Test program for Lacak2's mssqlconn
    Microsoft SQL Server connection.
    Defaults are set up for SQL Express database on local machine.
    
    Required:
    Windows (or fixed source code for Linux/OSX)
    FreeTDS dblib.dll
    
    Microsoft SQL Server database (e.g. SQL Express)
    (Note: you could try with Sybase ASE as well, as FreeTDS should support this)
    
    Optional
    freetds.conf; see mssqlconn.pas and
    http://www.freetds.org/userguide/freetdsconf.htm
    }
    {$mode objfpc}{$H+}
    {$APPTYPE CONSOLE}
    uses {$IFDEF UNIX} {$IFDEF UseCThreads}
      cthreads, {$ENDIF} {$ENDIF}
      Classes,
      SysUtils,
      sqldb,
      mssqlconn;
    
    const
      Database = 'master'; //always present on an MS SQL system.
    var
      FConnection: TMSSQLConnection;
      FQuery: TSQLQuery;
      FTransaction: TSQLTransaction;
      FServer: string;
      FInstance: string;
      FPort: integer;
      FTrustedAuth: boolean;  
      //Trusted authentication/SSPI. If on, no username/password required
      FUseInstance: boolean; //whether to use instance or port when connecting
      FUsername: string;
      FPassword: string;
    
    procedure GetUserInfo;
    var
      Response: string;
      Scroll: integer;
    begin
      // Defaults
      FTrustedAuth := True;
      FServer := '127.0.0.1'; {current host;
      using '.' might only work for named pipes connection, 
      or when udp 1434 service runs, don't know}
      FInstance := '.'; //default FInstance
      FPort := 1433; //default port for MSSQL default instance, if the port is fixed, not dynamic
      FUseInstance := true; //use instance instead of port
      FUsername := 'sa'; //default administrator account
      FPassword := ''; //default FPassword on older versions
    
      writeln('MSSQL Test program');
      writeln('******************');
      writeln('Please enter/confirm your connection settings for this test:');
      writeln('');
      Response := '';
      writeln('Enter server name or IP for SQL server.' + LineEnding +
        'or enter nothing to keep current setting: ' + FServer);
      readln(Response);
      if Response <> '' then
      begin
        FServer := Response;
      end;
    
      Response := '';
      FUseInstance:=true;
      writeln('You can connect to an MS SQL Server database by specifyin either a port or an instance. ' + LineEnding +
        'Port (default 1433 for MSSQL, 5000 for Sybase ASE): the port on which the instance is listening.' + LineEnding +
        'Instance: for this, MS SQL needs to run the relevant service on UDP port 1434.' + LineEnding +
        'For default modern MS SQL Server installations, using instance would be easiest.' + LineEnding + 
        '' + LineEnding +
        'Press I or enter if you want to specify instance, or press P to specify port: I');
      readln(Response);
      Response:=AnsiUpperCase(Response);
      if Response = 'P' then
      begin
        // Use port when explicitly specified:
        FUseInstance:=false;  
      end
      else
      begin
        // Use instance by default:
        FUseInstance:=true;
      end;
    
      if FUseInstance=true then
      begin  
        // Get instance info
        Response := '';
        writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
          'nothing to keep current setting: ' + FInstance);
        readln(Response);
        if Response <> '' then
        begin
          FInstance := Response;
        end;
      end
      else
      begin
        // Get port info
        Response := '';
        writeln('Enter port number where the server is listening on or ' + LineEnding +
          'nothing to keep current setting: ' + IntToStr(FPort));
        readln(Response);
        if Response <> '' then
        begin
          FPort := StrToInt(Response);
        end;    
      end;
     
    
      Response := '';
      writeln('Authenticate with your current Windows user (trusted authentication/SSPI)?' +
        LineEnding + 'Enter nothing to keep current setting: Y');
      readln(Response);
      Response := AnsiUpperCase(Response);
      if Response = 'N' then
      begin
        FTrustedAuth := False;
      end
      else
      begin
        FTrustedAuth := True;
      end;
    
      if FTrustedAuth = False then
      begin
        Response := '';
        //see 
        //http://www.freetds.org/userguide/domains.htm
        //for domain logon/SSPI/trusted auth details
        //Domain login apparently can be done with username
        //and password, using presumably NTLM
        writeln('Enter SQL Server username. ' + LineEnding +
          '(or Windows username: DOMAIN\username)' + LineEnding +
          'Enter nothing to keep current setting: ' + FUsername);
        readln(Response);
        if Response <> '' then
        begin
          FUsername := Response;
        end;
    
        Response := '';
        writeln('Enter password ' + LineEnding +
          '(NOTE NOT HIDDEN ON SCREEN): ');
        readln(Response);
        if Response <> '' then
        begin
          FPassword := Response;
        end;
      end;
      //scroll some, the lazy way
      for Scroll := 0 to 200 do
      begin
        writeln('');
      end;
    end;
    
    procedure ShowUserInfo;
    begin
      writeln('Current connection settings:');
      writeln('Server: ' + FServer);
      if FUseInstance=true then
      begin
        writeln('Instance: ' + FInstance);
      end
      else
      begin
        writeln('Port: ' + IntToStr(FPort));
      end;
    
      if FTrustedAuth = True then
      begin
        writeln('Trusted authentication/SSPI is on.');
      end
      else
      begin
        writeln('Trusted authentication/SSPI is off.');
        writeln('Username: ' + FUsername);
        writeln('Password not shown.');
      end;
    end;
    
    procedure GetDatabases;
    const
      SQL = 'select name,database_id,create_date from master.sys.databases;';
    begin
      FQuery.SQL.Text:=SQL;
      writeln('Going to run: ' + LineEnding +
      SQL);  
      FQuery.Open;
      writeln('==============================================================');
      while not FQuery.EOF do
      begin
        writeln(
        Trim(FQuery.Fields[0].AsString) , ',' , 
        Trim(FQuery.Fields[1].AsString) , ',' ,
        Trim(FQuery.Fields[2].AsString)
        );
        FQuery.Next;
      end;
      writeln('==============================================================');
    end;
    
    {
    //to do.
    function TestStoredProcedure: boolean;
    const
      SQL = 'execute master.sys.sp_who;';
      //won't return results...
    begin
    end;
    }
    
    procedure Connect;
    begin
      FConnection:=TMSSQLConnection.Create(nil);
      FConnection.HostName:=FServer;
      FConnection.DatabaseName:=Database;
      if FTrustedAuth=true then
      begin
        // this works automatically??!?
      end
      else
      begin
        FConnection.UserName:=FUsername;
        FConnection.Password:=FPassword;
      end;
      FConnection.CharSet:='UTF-8';
      try
        FConnection.Connected:=true;
      except
        on E: exception do
        begin
          writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
          raise; //stop program
        end;
      end;
    
      FTransaction:=TSQLTransaction.Create(nil);
      FConnection.Transaction:=FTransaction;
    
      FQuery:=TSQLQuery.Create(nil);
      FQuery.Database:=FConnection;
    end;
    
    procedure Disconnect;
    begin
      FTransaction.Active:=false;
      FQuery.Free;
      FConnection.Close;
      FConnection.Free;
    end;
    
    begin
      GetUserInfo; //ask user for connection settings and...
      ShowUserInfo; //...repeat it back to him
      { Now try a connect to the master database, and run a simple query }
      Connect;
      GetDatabases; //Show query results;
      Disconnect;
    end.
    
    
    mssqltest2.pas (7,178 bytes)
  • mssqltest3.pas (7,622 bytes)
    program mssqltest;
    
    {Test program for Lacak2's mssqlconn
    Microsoft SQL Server connection.
    Defaults are set up for SQL Express database on local machine.
    
    Required:
    Windows (or fixed source code for Linux/OSX)
    FreeTDS dblib.dll
    
    Microsoft SQL Server database (e.g. SQL Express)
    (Note: you could try with Sybase ASE as well, as FreeTDS should support this)
    
    Optional
    freetds.conf; see mssqlconn.pas and
    http://www.freetds.org/userguide/freetdsconf.htm
    }
    {$mode objfpc}{$H+}
    {$APPTYPE CONSOLE}
    uses {$IFDEF UNIX} {$IFDEF UseCThreads}
      cthreads, {$ENDIF} {$ENDIF}
      Classes,
      SysUtils,
      sqldb,
      mssqlconn;
    
    const
      Database = 'master'; //always present on an MS SQL system.
    var
      FConnection: TMSSQLConnection;
      FQuery: TSQLQuery;
      FTransaction: TSQLTransaction;
      FServer: string;
      FInstance: string;
      FPort: integer;
      FTrustedAuth: boolean;  
      //Trusted authentication/SSPI. If on, no username/password required
      FUseInstance: boolean; //whether to use instance or port when connecting
      FUsername: string;
      FPassword: string;
    
    procedure GetUserInfo;
    var
      Response: string;
      Scroll: integer;
    begin
      // Defaults
      FTrustedAuth := True;
      FServer := '127.0.0.1'; {current host;
      using '.' might only work for named pipes connection, 
      or when udp 1434 service runs, don't know}
      FInstance := '.'; //default FInstance
      FPort := 1433; //default port for MSSQL default instance, if the port is fixed, not dynamic
      FUseInstance := true; //use instance instead of port
      FUsername := 'sa'; //default administrator account
      FPassword := ''; //default FPassword on older versions
    
      writeln('MSSQL Test program');
      writeln('******************');
      writeln('Please enter/confirm your connection settings for this test:');
      writeln('');
      Response := '';
      writeln('Enter server name or IP for SQL server.' + LineEnding +
        'or enter nothing to keep current setting: ' + FServer);
      readln(Response);
      if Response <> '' then
      begin
        FServer := Response;
      end;
    
      Response := '';
      FUseInstance:=true;
      writeln('You can connect to an MS SQL Server database by specifyin either a port or an instance. ' + LineEnding +
        'Port (default 1433 for MSSQL, 5000 for Sybase ASE): the port on which the instance is listening.' + LineEnding +
        'Instance: for this, MS SQL needs to run the relevant service on UDP port 1434.' + LineEnding +
        'For default modern MS SQL Server installations, using instance would be easiest.' + LineEnding + 
        '' + LineEnding +
        'Press I or enter if you want to specify instance, or press P to specify port: I');
      readln(Response);
      Response:=AnsiUpperCase(Response);
      if Response = 'P' then
      begin
        // Use port when explicitly specified:
        FUseInstance:=false;  
      end
      else
      begin
        // Use instance by default:
        FUseInstance:=true;
      end;
    
      if FUseInstance=true then
      begin  
        // Get instance info
        Response := '';
        writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
          'nothing to keep current setting: ' + FInstance);
        readln(Response);
        if Response <> '' then
        begin
          FInstance := Response;
        end;
      end
      else
      begin
        // Get port info
        Response := '';
        writeln('Enter port number where the server is listening on or ' + LineEnding +
          'nothing to keep current setting: ' + IntToStr(FPort));
        readln(Response);
        if Response <> '' then
        begin
          FPort := StrToInt(Response);
        end;    
      end;
     
    
      Response := '';
      writeln('Authenticate with your current Windows user (trusted authentication/SSPI)?' +
        LineEnding + 'Enter nothing to keep current setting: Y');
      readln(Response);
      Response := AnsiUpperCase(Response);
      if Response = 'N' then
      begin
        FTrustedAuth := False;
      end
      else
      begin
        FTrustedAuth := True;
      end;
    
      if FTrustedAuth = False then
      begin
        Response := '';
        //see 
        //http://www.freetds.org/userguide/domains.htm
        //for domain logon/SSPI/trusted auth details
        //Domain login apparently can be done with username
        //and password, using presumably NTLM
        writeln('Enter SQL Server username. ' + LineEnding +
          '(or Windows username: DOMAIN\username)' + LineEnding +
          'Enter nothing to keep current setting: ' + FUsername);
        readln(Response);
        if Response <> '' then
        begin
          FUsername := Response;
        end;
    
        Response := '';
        writeln('Enter password ' + LineEnding +
          '(NOTE NOT HIDDEN ON SCREEN): ');
        readln(Response);
        if Response <> '' then
        begin
          FPassword := Response;
        end;
      end;
      //scroll some, the lazy way
      for Scroll := 0 to 200 do
      begin
        writeln('');
      end;
    end;
    
    procedure ShowUserInfo;
    begin
      writeln('Current connection settings:');
      writeln('Server: ' + FServer);
      if FUseInstance=true then
      begin
        writeln('Instance: ' + FInstance);
      end
      else
      begin
        writeln('Port: ' + IntToStr(FPort));
      end;
    
      if FTrustedAuth = True then
      begin
        writeln('Trusted authentication/SSPI is on.');
      end
      else
      begin
        writeln('Trusted authentication/SSPI is off.');
        writeln('Username: ' + FUsername);
        writeln('Password not shown.');
      end;
    end;
    
    procedure GetDatabases;
    const
      SQL = 'select name,database_id,create_date from master.sys.databases;';
    begin
      FQuery.SQL.Text:=SQL;
      writeln('Going to run: ' + LineEnding +
      SQL);  
      FQuery.Open;
      writeln('==============================================================');
      while not FQuery.EOF do
      begin
        writeln(
        Trim(FQuery.Fields[0].AsString) , ',' , 
        Trim(FQuery.Fields[1].AsString) , ',' ,
        Trim(FQuery.Fields[2].AsString)
        );
        FQuery.Next;
      end;
      writeln('==============================================================');
    end;
    
    {
    //to do.
    function TestStoredProcedure: boolean;
    const
      SQL = 'execute master.sys.sp_who;';
      //won't return results...
    begin
    end;
    }
    
    procedure Connect;
    begin
      FConnection:=TMSSQLConnection.Create(nil);
      FConnection.CharSet:='UTF-8';  
      FConnection.HostName:=FServer;
      FConnection.DatabaseName:=Database;
      
      if FUseInstance=true then
      begin
        //Don't know how to specify instance, so just guessing:
        writeln('Don''t know how to specify instance to connection component, so just guessing:');
        //FConnection.InstanceName:=FInstance;
        FConnection.DatabaseName:=Database+'\'+FInstance;
      end
      else
      begin
        writeln('Don''t know how to specify port to connection component...');
        //FConnection.Port:=FPort;
      end;
    
      if FTrustedAuth=true then
      begin
        // this works automatically??!?
      end
      else
      begin
        FConnection.UserName:=FUsername;
        FConnection.Password:=FPassword;
      end;
    
      try
        FConnection.Connected:=true;
      except
        on E: exception do
        begin
          writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
          raise; //stop program
        end;
      end;
    
      FTransaction:=TSQLTransaction.Create(nil);
      FConnection.Transaction:=FTransaction;
    
      FQuery:=TSQLQuery.Create(nil);
      FQuery.Database:=FConnection;
    end;
    
    procedure Disconnect;
    begin
      FTransaction.Active:=false;
      FQuery.Free;
      FConnection.Close;
      FConnection.Free;
    end;
    
    begin
      GetUserInfo; //ask user for connection settings and...
      ShowUserInfo; //...repeat it back to him
      { Now try a connect to the master database, and run a simple query }
      Connect;
      GetDatabases; //Show query results;
      Disconnect;
    end.
    
    
    mssqltest3.pas (7,622 bytes)
  • mssqlconn_rc1.zip (824,868 bytes)
  • mssqltest4.pas (7,651 bytes)
    program mssqltest;
    
    {Test program for Lacak2's mssqlconn
    Microsoft SQL Server connection.
    Defaults are set up for SQL Express database on local machine.
    
    Required:
    Windows (or fixed source code for Linux/OSX)
    mssqlcon wrapper for dblib.dll
    FreeTDS dblib.dll
    
    Microsoft SQL Server database (e.g. SQL Express)
    (Note: you could try with Sybase ASE as well, as FreeTDS should support this)
    
    Optional
    freetds.conf; see mssqlconn.pas and
    http://www.freetds.org/userguide/freetdsconf.htm
    }
    {$mode objfpc}{$H+}
    {$APPTYPE CONSOLE}
    uses {$IFDEF UNIX} {$IFDEF UseCThreads}
      cthreads, {$ENDIF} {$ENDIF}
      Classes,
      SysUtils,
      sqldb,
      mssqlconn;
    
    const
      Database = 'master'; //always present on an MS SQL system.
    var
      FConnection: TMSSQLConnection;
      FQuery: TSQLQuery;
      FTransaction: TSQLTransaction;
      FServer: string;
      FInstance: string;
      FPort: integer;
      FTrustedAuth: boolean;  
      //Trusted authentication/SSPI. If on, no username/password required
      FUseInstance: boolean; //whether to use instance or port when connecting
      FUsername: string;
      FPassword: string;
    
    procedure GetUserInfo;
    var
      Response: string;
      Scroll: integer;
    begin
      // Defaults
      FTrustedAuth := True;
      FServer := '127.0.0.1'; {current host;
      using '.' might only work for named pipes connection, 
      or when udp 1434 service runs, don't know}
      FInstance := '.'; //default FInstance
      FPort := 1433; //default port for MSSQL default instance, if the port is fixed, not dynamic
      FUseInstance := true; //use instance instead of port
      FUsername := 'sa'; //default administrator account
      FPassword := ''; //default FPassword on older versions
    
      writeln('MSSQL Test program');
      writeln('******************');
      writeln('Please enter/confirm your connection settings for this test:');
      writeln('');
      Response := '';
      writeln('Enter server name or IP for SQL server.' + LineEnding +
        'or enter nothing to keep current setting: ' + FServer);
      readln(Response);
      if Response <> '' then
      begin
        FServer := Response;
      end;
    
      Response := '';
      FUseInstance:=true;
      writeln('You can connect to an MS SQL Server database by specifyin either a port or an instance. ' + LineEnding +
        'Port (default 1433 for MSSQL, 5000 for Sybase ASE): the port on which the instance is listening.' + LineEnding +
        'Instance: for this, MS SQL needs to run the relevant service on UDP port 1434.' + LineEnding +
        'For default modern MS SQL Server installations, using instance would be easiest.' + LineEnding + 
        '' + LineEnding +
        'Press I or enter if you want to specify instance, or press P to specify port: I');
      readln(Response);
      Response:=AnsiUpperCase(Response);
      if Response = 'P' then
      begin
        // Use port when explicitly specified:
        FUseInstance:=false;  
      end
      else
      begin
        // Use instance by default:
        FUseInstance:=true;
      end;
    
      if FUseInstance=true then
      begin  
        // Get instance info
        Response := '';
        writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
          'nothing to keep current setting: ' + FInstance);
        readln(Response);
        if Response <> '' then
        begin
          FInstance := Response;
        end;
      end
      else
      begin
        // Get port info
        Response := '';
        writeln('Enter port number where the server is listening on or ' + LineEnding +
          'nothing to keep current setting: ' + IntToStr(FPort));
        readln(Response);
        if Response <> '' then
        begin
          FPort := StrToInt(Response);
        end;    
      end;
     
    
      Response := '';
      writeln('Authenticate with your current Windows user (trusted authentication/SSPI)?' +
        LineEnding + 'Enter nothing to keep current setting: Y');
      readln(Response);
      Response := AnsiUpperCase(Response);
      if Response = 'N' then
      begin
        FTrustedAuth := False;
      end
      else
      begin
        FTrustedAuth := True;
      end;
    
      if FTrustedAuth = False then
      begin
        Response := '';
        //see 
        //http://www.freetds.org/userguide/domains.htm
        //for domain logon/SSPI/trusted auth details
        //Domain login apparently can be done with username
        //and password, using presumably NTLM
        writeln('Enter SQL Server username. ' + LineEnding +
          '(or Windows username: DOMAIN\username)' + LineEnding +
          'Enter nothing to keep current setting: ' + FUsername);
        readln(Response);
        if Response <> '' then
        begin
          FUsername := Response;
        end;
    
        Response := '';
        writeln('Enter password ' + LineEnding +
          '(NOTE NOT HIDDEN ON SCREEN): ');
        readln(Response);
        if Response <> '' then
        begin
          FPassword := Response;
        end;
      end;
      //scroll some, the lazy way
      for Scroll := 0 to 200 do
      begin
        writeln('');
      end;
    end;
    
    procedure ShowUserInfo;
    begin
      writeln('Current connection settings:');
      writeln('Server: ' + FServer);
      if FUseInstance=true then
      begin
        writeln('Instance: ' + FInstance);
      end
      else
      begin
        writeln('Port: ' + IntToStr(FPort));
      end;
    
      if FTrustedAuth = True then
      begin
        writeln('Trusted authentication/SSPI is on.');
      end
      else
      begin
        writeln('Trusted authentication/SSPI is off.');
        writeln('Username: ' + FUsername);
        writeln('Password not shown.');
      end;
    end;
    
    procedure GetDatabases;
    const
      SQL = 'select name,database_id,create_date from master.sys.databases;';
    begin
      FQuery.SQL.Text:=SQL;
      writeln('Going to run: ' + LineEnding +
      SQL);  
      FQuery.Open;
      writeln('==============================================================');
      while not FQuery.EOF do
      begin
        writeln(
        Trim(FQuery.Fields[0].AsString) , ',' , 
        Trim(FQuery.Fields[1].AsString) , ',' ,
        Trim(FQuery.Fields[2].AsString)
        );
        FQuery.Next;
      end;
      FQuery.Close;
      writeln('==============================================================');
    end;
    
    procedure TestStoredProcedure;
    const
      SQL = 'execute master.sys.sp_who;';
      //Can return results, but we don't care...
    begin
      FQUery.Close;
      FQuery.SQL.Text:=SQL;
      writeln('Going to execute SP: ' + LineEnding +
      SQL);
      FQuery.ExecSQL;
      writeln('Done executing SP.');
    end;
    
    
    procedure Connect;
    begin
      FConnection:=TMSSQLConnection.Create(nil);
      FConnection.CharSet:='UTF-8';    
      FConnection.DatabaseName:=Database;
      
      if FUseInstance=true then
      begin        
        FConnection.HostName:=FServer+'\'+FInstance;
      end
      else
      begin
        if FPort=0 then FPort:=1433; //Default for SQL server
        FConnection.HostName:=FServer+':'+IntToStr(FPort);
      end;
    
      if FTrustedAuth=true then
      begin
        // this works automatically??!?
      end
      else
      begin
        FConnection.UserName:=FUsername;
        FConnection.Password:=FPassword;
      end;
    
      try
        FConnection.Connected:=true;
      except
        on E: exception do
        begin
          writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
          raise; //stop program
        end;
      end;
    
      FTransaction:=TSQLTransaction.Create(nil);
      FConnection.Transaction:=FTransaction;
    
      FQuery:=TSQLQuery.Create(nil);
      FQuery.Database:=FConnection;
    end;
    
    procedure Disconnect;
    begin
      FTransaction.Active:=false;
      FQuery.Free;
      FConnection.Close;
      FConnection.Free;
    end;
    
    begin
      GetUserInfo; //ask user for connection settings and...
      ShowUserInfo; //...repeat it back to him
      { Now try a connect to the master database, and run a simple query }
      Connect;
      GetDatabases; //Show query results;
      TestStoredProcedure; //Execute a stored procedure.
      Disconnect;
    end.
    
    
    mssqltest4.pas (7,651 bytes)
  • mssqlconn_RC1_2.zip (12,435 bytes)
  • mssqlconn_rc2.zip (829,472 bytes)
  • tests_mssql.patch (11,856 bytes)
    Index: database.ini.txt
    ===================================================================
    --- database.ini.txt	(revision 20570)
    +++ database.ini.txt	(working copy)
    @@ -94,6 +94,15 @@
     connectorparams=sqlite3
     name=test.db
     
    +; MS SQL Server database:
    +[mssql]
    +connector=sql
    +connectorparams=mssql
    +name=pubs
    +user=sa
    +password=
    +hostname=127.0.0.1
    +
     ; TDBf: DBase/FoxPro database:
     [dbf]
     connector=dbf
    Index: sqldbtoolsunit.pas
    ===================================================================
    --- sqldbtoolsunit.pas	(revision 20570)
    +++ sqldbtoolsunit.pas	(working copy)
    @@ -6,14 +6,15 @@
     
     uses
       Classes, SysUtils, toolsunit,
    -  db,
    -  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
    +  db, sqldb,
    +  mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn,
    +  ibconnection, pqconnection, odbcconn, oracleconnection, sqlite3conn, mssqlconn;
     
    -type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3);
    +type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3,mssql);
     
     const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
           DBTypesNames : Array [TSQLDBTypes] of String[19] =
    -             ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3');
    +        ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL');
                  
           FieldtypeDefinitionsConst : Array [TFieldType] of String[20] =
             (
    @@ -24,25 +25,25 @@
               '',
               'BOOLEAN',
               'FLOAT',
    -          '',
    -          'DECIMAL(18,4)',
    +          '',             // ftCurrency
    +          'DECIMAL(18,4)',// ftBCD
               'DATE',
               'TIME',
    -          'TIMESTAMP',
    +          'TIMESTAMP',    // ftDateTime
               '',
               '',
               '',
    -          'BLOB',
    -          'BLOB',
    -          'BLOB',
    +          'BLOB',         // ftBlob
    +          'BLOB',         // ftMemo
    +          'BLOB',         // ftGraphic
               '',
               '',
               '',
               '',
               '',
    -          'CHAR(10)',
    +          'CHAR(10)',     // ftFixedChar
               '',
    -          'BIGINT',
    +          'BIGINT',       // ftLargeInt
               '',
               '',
               '',
    @@ -52,10 +53,10 @@
               '',
               '',
               '',
    +          '',             // ftGuid
    +          'TIMESTAMP',    // ftTimestamp
    +          'NUMERIC(18,6)',// ftFmtBCD
               '',
    -          'TIMESTAMP',
    -          'NUMERIC(18,6)',
    -          '',
               ''
             );
                  
    @@ -156,6 +157,20 @@
         end;
       if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
       if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
    +  if SQLDbType = MSSQL then
    +    begin
    +    Fconnection := TMSSQLConnection.Create(nil);
    +    FieldtypeDefinitions[ftBoolean] := 'BIT';
    +    FieldtypeDefinitions[ftCurrency]:= 'MONEY';
    +    FieldtypeDefinitions[ftDate]    := 'DATETIME';
    +    FieldtypeDefinitions[ftTime]    := '';
    +    FieldtypeDefinitions[ftDateTime]:= 'DATETIME';
    +    FieldtypeDefinitions[ftBytes]   := 'BINARY(5)';
    +    FieldtypeDefinitions[ftVarBytes]:= 'VARBINARY(10)';
    +    FieldtypeDefinitions[ftBlob]    := 'IMAGE';
    +    FieldtypeDefinitions[ftMemo]    := 'TEXT';
    +    FieldtypeDefinitions[ftGraphic] := '';
    +    end;
     
       if SQLDbType in [mysql40,mysql41,mysql50,mysql51,mysql55,odbc,interbase] then
         begin
    @@ -169,7 +184,7 @@
             testValues[ftDateTime,t] := copy(testValues[ftDateTime,t],1,19)+'.000';
           end;
         end;
    -  if SQLDbType in [postgresql,interbase] then
    +  if SQLDbType in [postgresql,interbase,mssql] then
         begin
         // Some db's do not support times > 24:00:00
         testTimeValues[3]:='13:25:15.000';
    @@ -182,11 +197,15 @@
           end;
         end;
     
    -  if SQLDbType in [sqlite3] then
    -    testValues[ftCurrency]:=testValues[ftBCD]; //decimal separator for currencies must be decimal point
    +  // DecimalSeparator must correspond to monetary locale (lc_monetary) set on PostgreSQL server
    +  // Here we assume, that locale on client side is same as locale on server
    +  if SQLDbType in [postgresql] then
    +    for t := 0 to testValuesCount-1 do
    +      testValues[ftCurrency,t] := QuotedStr(CurrToStr(testCurrencyValues[t]));
     
       // SQLite does not support fixed length CHAR datatype
       // MySQL by default trimms trailing spaces on retrieval; so set sql-mode="PAD_CHAR_TO_FULL_LENGTH" - supported from MySQL 5.1.20
    +  // MSSQL set SET ANSI_PADDING ON
       if SQLDbType in [sqlite3] then
         for t := 0 to testValuesCount-1 do
           testValues[ftFixedChar,t] := PadRight(testValues[ftFixedChar,t], 10);
    @@ -291,7 +310,10 @@
               begin
               sql := sql + ',F' + Fieldtypenames[FType];
               if testValues[FType,CountID] <> '' then
    -            sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
    +            if FType in [ftCurrency] then
    +              sql1 := sql1 + ',' + testValues[FType,CountID]
    +            else
    +              sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
               else
                 sql1 := sql1 + ',NULL';
               end;
    @@ -303,7 +325,10 @@
     
         Ftransaction.Commit;
       except
    -    if Ftransaction.Active then Ftransaction.Rollback
    +    on E: Exception do begin
    +      //writeln(E.Message);
    +      if Ftransaction.Active then Ftransaction.Rollback;
    +    end;
       end;
     end;
     
    Index: testfieldtypes.pas
    ===================================================================
    --- testfieldtypes.pas	(revision 20570)
    +++ testfieldtypes.pas	(working copy)
    @@ -778,12 +778,9 @@
     
         end;
       TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
    -
    -
     end;
     
     procedure TTestFieldTypes.TestIntParamQuery;
    -
     begin
       TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
     end;
    @@ -793,9 +790,14 @@
       TestXXParamQuery(ftFMTBcd,FieldtypeDefinitionsConst[ftFMTBcd],testValuesCount);
     end;
     
    +procedure TTestFieldTypes.TestDateParamQuery;
    +begin
    +  TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount);
    +end;
    +
     procedure TTestFieldTypes.TestTimeParamQuery;
     begin
    -  TestXXParamQuery(ftTime,FieldtypeDefinitionsConst[ftTime],testValuesCount);
    +  TestXXParamQuery(ftTime,FieldtypeDefinitions[ftTime],testValuesCount);
     end;
     
     procedure TTestFieldTypes.TestDateTimeParamQuery;
    @@ -821,7 +823,7 @@
     
     procedure TTestFieldTypes.TestVarBytesParamQuery;
     begin
    -  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount);
    +  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount, SQLDbType<>mssql);
     end;
     
     procedure TTestFieldTypes.TestStringParamQuery;
    @@ -835,13 +837,7 @@
       TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
     end;
     
    -procedure TTestFieldTypes.TestDateParamQuery;
     
    -begin
    -  TestXXParamQuery(ftDate,'DATE',testDateValuesCount);
    -end;
    -
    -
     procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
     
     var i : integer;
    @@ -885,7 +881,10 @@
                          Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
                        else
                          Params.ParamByName('field1').AsBlob := testBytesValues[i];
    -        ftVarBytes:Params.ParamByName('field1').AsString := testBytesValues[i];
    +        ftVarBytes:if cross then
    +                     Params.ParamByName('field1').AsString := testBytesValues[i]
    +                   else
    +                     Params.ParamByName('field1').AsBlob := testBytesValues[i];
           else
             AssertTrue('no test for paramtype available',False);
           end;
    @@ -1241,6 +1240,11 @@
           Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
           Query.SQL.Text:='execute procedure FPDEV_PROC';
         end
    +    else if SQLDbType = mssql then
    +    begin
    +      Connection.ExecuteDirect('create procedure FPDEV_PROC as select 1 union select 2;');
    +      Query.SQL.Text:='execute FPDEV_PROC';
    +    end
         else
         begin
           Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
    @@ -1526,10 +1530,11 @@
         begin
         with query do
           begin
    -      if (sqlDBtype=interbase) then
    -        SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21'''
    -      else
    -        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
    +      case sqlDBtype of
    +        interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
    +        mssql     : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
    +        else        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
    +      end;
           Open;
           close;
           ServerFilter:='ID=21';
    @@ -1650,7 +1655,7 @@
     procedure TTestFieldTypes.TestBug9744;
     var i : integer;
     begin
    -  if SQLDbType in [interbase,postgresql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
    +  if SQLDbType in [interbase,postgresql,mssql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
     
       with TSQLDBConnector(DBConnector) do
         begin
    @@ -1820,6 +1825,8 @@
       else
       begin
         datatype:=FieldtypeDefinitions[ftTime];
    +    if datatype = '' then
    +      Ignore(STestNotApplicable);
         if sqlDBType = sqlite3 then
           testIntervalValuesCount := 5
         else if sqlDBType in MySQLdbTypes then
    @@ -1847,6 +1854,12 @@
         values:='DEFAULT VALUES';
         fieldtype:=ftInteger;
       end
    +  else if sqlDBType = mssql then
    +  begin
    +    datatype:='INTEGER IDENTITY';
    +    values:='DEFAULT VALUES';
    +    fieldtype:=ftAutoInc;
    +  end
       else
         Ignore(STestNotApplicable);
     
    @@ -1919,14 +1932,14 @@
     
     procedure TTestFieldTypes.TestTemporaryTable;
     begin
    -  if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t support temporary tables');
    +  if SQLDbType in [interbase,mssql] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t support temporary tables');
     
       with TSQLDBConnector(DBConnector).Query do
         begin
         SQL.Clear;
         SQL.Add('CREATE TEMPORARY TABLE TEMP1 (id int)');
         ExecSQL;
    -    SQL.Text :=  'INSERT INTO TEMP1(id) values (5)';
    +    SQL.Text := 'INSERT INTO TEMP1(id) values (5)';
         ExecSQL;
         SQL.Text := 'SELECT * FROM TEMP1';
         Open;
    @@ -2050,4 +2063,3 @@
     initialization
       if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
     end.
    -
    Index: toolsunit.pas
    ===================================================================
    --- toolsunit.pas	(revision 20570)
    +++ toolsunit.pas	(working copy)
    @@ -315,10 +315,7 @@
         testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
         testValues[ftInteger,i] := IntToStr(testIntValues[i]);
         testValues[ftLargeint,i] := IntToStr(testLargeIntValues[i]);
    -    // The decimalseparator was set to a comma for currencies and to a dot for ftBCD values.
    -    // DecimalSeparator for PostgreSQL must correspond to monetary locale set on PostgreSQL server
    -    // Here we assume, that locale on client side is same as locale on server
    -    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i]);
    +    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i],FormatSettings);
         testValues[ftBCD,i] := CurrToStr(testCurrencyValues[i],FormatSettings);
         // For date '0001-01-01' other time-part like '00:00:00' causes "Invalid variant type cast", because of < MinDateTime constant
         if (testDateValues[i]>'0001-01-01') and (testTimeValues[i]>='00:00:01') and (testTimeValues[i]<'24:00:00') then
    
    tests_mssql.patch (11,856 bytes)
  • tests_mssql_date.patch (3,271 bytes)
    Index: sqldbtoolsunit.pas
    ===================================================================
    --- sqldbtoolsunit.pas	(revision 20584)
    +++ sqldbtoolsunit.pas	(working copy)
    @@ -243,6 +243,7 @@
         begin
         database := Fconnection;
         transaction := Ftransaction;
    +    PacketRecords := -1;  // To avoid: "Connection is busy with results for another hstmt" (ODBC,MSSQL)
         end;
     end;
     
    Index: testfieldtypes.pas
    ===================================================================
    --- testfieldtypes.pas	(revision 20584)
    +++ testfieldtypes.pas	(working copy)
    @@ -140,16 +140,16 @@
         '1991-03-01',
         '2040-10-16',
         '1977-09-29',
    +    '1899-12-29',
    +    '1899-12-30',
    +    '1899-12-31',
    +    '1900-01-01',
         '1800-03-30',
    -    '1650-05-10',
         '1754-06-04',
    +    '1650-05-10',
         '0904-04-12',
         '0199-07-09',
    -    '0001-01-01',
    -    '1899-12-29',
    -    '1899-12-30',
    -    '1899-12-31',
    -    '1900-01-01'
    +    '0001-01-01'
       );
     
       testBytesValuesCount = 5;
    @@ -608,16 +608,7 @@
         '2000-01-01 10:00:00',
         '2000-01-01 23:59:59',
         '1994-03-06 11:54:30',
    -    '2040-10-16',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
    -    '1400-02-03 12:21:53',
    -    '0354-11-20 21:25:15',
    -    '1333-02-03 21:44:21',
    -    '1800-03-30',
    -    '1650-05-10',
    -    '1754-06-04',
    -    '0904-04-12',
    -    '0199-07-09',
    -    '0001-01-01',
    +    '1754-06-04',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
         '1899-12-29',
         '1899-12-30',
         '1899-12-31',
    @@ -628,7 +619,16 @@
         '1899-12-29 18:00:51',
         '1903-04-02 01:04:02',
         '1815-09-24 03:47:22',
    -    '2100-01-01 01:01:01'
    +    '2040-10-16',
    +    '2100-01-01 01:01:01',
    +    '1400-02-03 12:21:53',          // MS SQL 2005 doesn't support datetimes before 1753
    +    '0354-11-20 21:25:15',
    +    '1333-02-03 21:44:21',
    +    '1800-03-30',
    +    '1650-05-10',
    +    '0904-04-12',
    +    '0199-07-09',
    +    '0001-01-01'
       );
     
     var
    @@ -853,7 +853,6 @@
     
       with TSQLDBConnector(DBConnector).Query do
         begin
    -    PacketRecords := -1;
         sql.clear;
         sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
     
    Index: toolsunit.pas
    ===================================================================
    --- toolsunit.pas	(revision 20584)
    +++ toolsunit.pas	(working copy)
    @@ -138,25 +138,25 @@
         '2004-03-01',
         '1991-02-28',
         '1991-03-01',
    +    '1997-11-29',
         '2040-10-16',
         '1977-09-29',
    +    '1977-12-31',
    +    '1917-12-29',
    +    '1900-01-01',
    +    '1899-12-31',
    +    '1899-12-30',
    +    '1899-12-29',
         '1800-03-30',
    +    '1754-06-04',
    +    '1753-01-01',
         '1650-05-10',
    -    '1754-06-04',
         '0904-04-12',
         '0199-07-09',
    -    '0001-01-01',
    +    '0079-11-29',
         '0031-11-02',
    -    '1899-12-29',
    -    '1899-12-30',
    -    '1899-12-31',
    -    '1977-09-29',
    -    '1917-12-29',
    -    '0079-11-29',
    -    '1997-11-29',
    -    '0001-01-01',
    -    '1997-11-29',
    -    '1900-01-01'
    +    '0001-12-31',
    +    '0001-01-01'
       );
     
       testTimeValues : Array[0..testValuesCount-1] of string = (
    @@ -177,7 +177,7 @@
         '15:35:12.000',
         '16:45:12.010',
         '13:55:12.200',
    -    '13:46:12.542',
    +    '13:46:12.543',
         '15:35:12.000',
         '17:25:12.530',
         '19:45:12.003',
    
    tests_mssql_date.patch (3,271 bytes)
  • dblib.pp.diff2 (596 bytes)

Activities

2010-08-30 07:34

 

mssqlconn_beta1.zip (113,986 bytes)

2010-10-04 12:21

 

mssqlconn_beta2.zip (114,600 bytes)

LacaK

2010-10-04 12:22

developer   ~0041473

Minor fixes.

Marcos Douglas

2011-09-06 15:12

reporter   ~0051510

This is a very interesting (new) PATH for MYSQL users, like me.
There is the possibility of this being considered?

Marco van de Voort

2011-09-06 15:46

manager   ~0051511

I don't think FPC should go into the third party DLL building and distributing business.

Sure, we can put the DLL in contrib/ if the license allows.

Reinier Olislagers

2011-09-06 17:16

developer   ~0051514

Last edited: 2011-09-06 17:18

@Marcos, you do realise this is a Microsoft SQL Server database connection object, not a MySQL database connection object?

I tried to write a test program (attached mssqltest.pas) but didn't get a connection.
What wasn't clear to me:
1. How freetds.conf should look like, I had just:
[global]
tds version = 7.1
client charset = UTF-8
2. How to specify instance? Seems you can specify host/servername; do you just append the instance, e.g. 192.168.42.42\SQLEXPRESS
3. If you can specify SSPI/Trusted authentication/windows authentication, and how.
Connection didn't work: "Adaptive Server is unavailable or does not exist"
(Happy to take this to the fpc mailing list, just want to make sure people know there's something wrong with the test program)


Also, to get dblib.pp to compile on current FPC 2.7.1, I had to add {$mode objfpc}, otherwise the Result:= assignments wouldn't work (don't know if it's better to do mode delphi).
Fixed some typos, added info on TDS 7.2 also being used for MSSQL 2008.
Please find attached patch dblib.pp.diff

2011-09-06 17:17

 

mssqltest.pas (4,858 bytes)
program mssqltest;

{Test program for Lacak2's mssqlconn
Microsoft SQL Server connection.
Defaults are set up for SQL Express database on local machine.

Required:
Windows (or fixed source code for Linux/OSX)
FreeTDS dblib.dll
freetds.conf (see mssqlconn.pas)
Microsoft SQL Server database (e.g. SQL Express)
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  Classes,
  SysUtils,
  sqldb,
  mssqlconn;

const
  Database = 'master'; //always present on an MS SQL system.
var
  FConnection: TMSSQLConnection;
  FQuery: TSQLQuery;
  FTransaction: TSQLTransaction;
  FServer: string;
  FInstance: string;
  FTrustedAuth: boolean;
  //Trusted authentication/SSPI. If on, no username/password required
  FUsername: string;
  FPassword: string;

procedure GetUserInfo;
var
  Response: string;
  Scroll: integer;
begin
  writeln('MSSQL Test program');
  writeln('******************');
  writeln('Please enter/confirm your connection settings for this test:');
  writeln('');
  Response := '';
  writeln('Enter server name or IP for SQL server or ' + LineEnding +
    'nothing to keep current setting: ' + FServer);
  readln(Response);
  if Response <> '' then
  begin
    FServer := Response;
  end;

  Response := '';
  writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
    'nothing to keep current setting: ' + FInstance);
  readln(Response);
  if Response <> '' then
  begin
    FInstance := Response;
  end;

  Response := '';
  writeln('Authenticate with your current Windows (trusted authentication/SSPI)?' +
    LineEnding + 'Enter nothing to keep current setting: Y');
  readln(Response);
  Response := AnsiUpperCase(Response);
  if Response = 'N' then
  begin
    FTrustedAuth := False;
  end
  else
  begin
    FTrustedAuth := True;
  end;

  if FTrustedAuth = False then
  begin
    Response := '';
    writeln('Enter SQL Server username or ' + LineEnding +
      'nothing to keep current setting: ' + FUsername);
    readln(Response);
    if Response <> '' then
    begin
      FUsername := Response;
    end;

    Response := '';
    writeln('Enter password ' + LineEnding +
      '(NOTE NOT HIDDEN ON SCREEN): ';
    readln(Response);
    if Response <> '' then
    begin
      FPassword := Response;
    end;
  end;
  //scroll some, the lazy way
  for Scroll := 0 to 200 do
  begin
    writeln('');
  end;
end;

procedure ShowUserInfo;
begin
  writeln('Current connection settings:');
  writeln('Server/Instance:' + FServer + '/' + FInstance);
  if FTrustedAuth = True then
  begin
    writeln('Trusted authentication/SSPI is on.');
  end
  else
  begin
    writeln('Trusted authentication/SSPI is off.');
    writeln('Username: ' + FUsername);
    writeln('Password not shown.');
  end;
end;

procedure GetDatabases;
const
  SQL = 'select name,database_id,create_date from master.sys.databases;';
begin
  FQuery.SQL.Text:=SQL;
  writeln('Going to run: ' + LineEnding +
  SQL);
  FQuery.Open;
  while not FQuery.EOF do
  begin
    writeln(
    FQuery.Fields[0].AsString, ',',
    FQuery.Fields[1].AsString, ',',
    FQuery.Fields[2].AsString, ','
    );
    FQuery.Next;
  end;
end;

{
//to do.
function TestStoredProcedure: boolean;
const
  SQL = 'execute master.sys.sp_who;';
  //won't return results...
begin
end;
}

procedure Connect;
begin
  FConnection:=TMSSQLConnection.Create(nil);
  FConnection.HostName:=FServer;
  FConnection.DatabaseName:=Database;
  if FTrustedAuth=true then
  begin
    //do nothing for now, don't know how to handle!
    writeln('don''t know how to handle trusted auth!');
  end
  else
  begin
    FConnection.UserName:=FUsername;
    FConnection.Password:=FPassword;
  end;
  FConnection.CharSet:='UTF-8';
  try
    FConnection.Connected:=true;
  except
    on E: exception do
    begin
      writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
      raise; //stop program
    end;
  end;

  FTransaction:=TSQLTransaction.Create(nil);
  FConnection.Transaction:=FTransaction;

  FQuery:=TSQLQuery.Create(nil);
  FQuery.Database:=FConnection;
end;

procedure Disconnect;
begin
  FTransaction.Active:=false;
  FQuery.Free;
  FConnection.Close;
  FConnection.Free;
end;

begin
  FTrustedAuth := True;
  FServer := '.'; //current host
  FInstance := '.'; //default FInstance
  FUsername := 'sa'; //default administrator account
  FPassword := ''; //default FPassword on older versions
  GetUserInfo; //ask user for connection settings and...
  ShowUserInfo; //...repeat it back to him
  { Now try a connect to the master database, and run a simple query }
  Connect;
  GetDatabases; //Show query results;
  Disconnect;
end.

mssqltest.pas (4,858 bytes)

2011-09-06 17:17

 

dblib.pp.diff (1,202 bytes)
--- dblib.pp.ori	Tue Sep 14 10:56:14 2010
+++ dblib.pp	Tue Sep 06 15:38:59 2011
@@ -19,11 +19,13 @@
     FreeTDS:
       tds version = 7.0 - MS SQL Server 7
                     7.1 - MS SQL Server 2000 (*default*)
-                    7.2 - MS SQL Server 2005
+                    7.2 - MS SQL Server 2005/2008
       tds version can be set using env.var. TDSVER or in freetds.conf or .freetds.conf
 }
 unit dblib;
 
+{$mode objfpc}
+
 //{$DEFINE ntwdblib} //if you are using MS SQL Server Client Library (ntwdblib.dll)
 {$DEFINE freetds} //if you are using db-lib from FreeTDS project (Microsoft+Sybase support)
 
@@ -156,9 +158,9 @@
      month: INT;       // 1 - 12
      {$IFDEF freetds}
      day: INT;         // 1 - 31
-     dayofyear: INT;   // 1 - 366 (in sybdb.h are dayofyear and day echanged!)
+     dayofyear: INT;   // 1 - 366 (in sybdb.h dayofyear and day are changed around!)
      {$ELSE}
-     dayofyear: INT;   // 1 - 366 (in sybdb.h are dayofyear and day echanged!)
+     dayofyear: INT;   // 1 - 366 (in sybdb.h dayofyear and day are changed around!)
      day: INT;         // 1 - 31
      {$ENDIF}
      week: INT;        // 1 - 54 (for leap years)
dblib.pp.diff (1,202 bytes)

LacaK

2011-09-07 08:50

developer   ~0051544

@Marco: we do not need bundle any third party-library. I added it only for user conformance. Anybody can build it from FreeTDS (open-source project) sources for any supported platform.

@BigChimp:
1. freetds.conf is not required (IIRC), but when supplied it can look like you wrote
2. and 3. please look at http://www.freetds.org/userguide/freetdsconf.htm and http://www.freetds.org/userguide/domains.htm

dblib.pp patch is ok, I will merge it and upload new version (I plan do some changes)

2011-09-07 09:56

 

mssqltest2.pas (7,178 bytes)
program mssqltest;

{Test program for Lacak2's mssqlconn
Microsoft SQL Server connection.
Defaults are set up for SQL Express database on local machine.

Required:
Windows (or fixed source code for Linux/OSX)
FreeTDS dblib.dll

Microsoft SQL Server database (e.g. SQL Express)
(Note: you could try with Sybase ASE as well, as FreeTDS should support this)

Optional
freetds.conf; see mssqlconn.pas and
http://www.freetds.org/userguide/freetdsconf.htm
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  Classes,
  SysUtils,
  sqldb,
  mssqlconn;

const
  Database = 'master'; //always present on an MS SQL system.
var
  FConnection: TMSSQLConnection;
  FQuery: TSQLQuery;
  FTransaction: TSQLTransaction;
  FServer: string;
  FInstance: string;
  FPort: integer;
  FTrustedAuth: boolean;  
  //Trusted authentication/SSPI. If on, no username/password required
  FUseInstance: boolean; //whether to use instance or port when connecting
  FUsername: string;
  FPassword: string;

procedure GetUserInfo;
var
  Response: string;
  Scroll: integer;
begin
  // Defaults
  FTrustedAuth := True;
  FServer := '127.0.0.1'; {current host;
  using '.' might only work for named pipes connection, 
  or when udp 1434 service runs, don't know}
  FInstance := '.'; //default FInstance
  FPort := 1433; //default port for MSSQL default instance, if the port is fixed, not dynamic
  FUseInstance := true; //use instance instead of port
  FUsername := 'sa'; //default administrator account
  FPassword := ''; //default FPassword on older versions

  writeln('MSSQL Test program');
  writeln('******************');
  writeln('Please enter/confirm your connection settings for this test:');
  writeln('');
  Response := '';
  writeln('Enter server name or IP for SQL server.' + LineEnding +
    'or enter nothing to keep current setting: ' + FServer);
  readln(Response);
  if Response <> '' then
  begin
    FServer := Response;
  end;

  Response := '';
  FUseInstance:=true;
  writeln('You can connect to an MS SQL Server database by specifyin either a port or an instance. ' + LineEnding +
    'Port (default 1433 for MSSQL, 5000 for Sybase ASE): the port on which the instance is listening.' + LineEnding +
    'Instance: for this, MS SQL needs to run the relevant service on UDP port 1434.' + LineEnding +
    'For default modern MS SQL Server installations, using instance would be easiest.' + LineEnding + 
    '' + LineEnding +
    'Press I or enter if you want to specify instance, or press P to specify port: I');
  readln(Response);
  Response:=AnsiUpperCase(Response);
  if Response = 'P' then
  begin
    // Use port when explicitly specified:
    FUseInstance:=false;  
  end
  else
  begin
    // Use instance by default:
    FUseInstance:=true;
  end;

  if FUseInstance=true then
  begin  
    // Get instance info
    Response := '';
    writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
      'nothing to keep current setting: ' + FInstance);
    readln(Response);
    if Response <> '' then
    begin
      FInstance := Response;
    end;
  end
  else
  begin
    // Get port info
    Response := '';
    writeln('Enter port number where the server is listening on or ' + LineEnding +
      'nothing to keep current setting: ' + IntToStr(FPort));
    readln(Response);
    if Response <> '' then
    begin
      FPort := StrToInt(Response);
    end;    
  end;
 

  Response := '';
  writeln('Authenticate with your current Windows user (trusted authentication/SSPI)?' +
    LineEnding + 'Enter nothing to keep current setting: Y');
  readln(Response);
  Response := AnsiUpperCase(Response);
  if Response = 'N' then
  begin
    FTrustedAuth := False;
  end
  else
  begin
    FTrustedAuth := True;
  end;

  if FTrustedAuth = False then
  begin
    Response := '';
    //see 
    //http://www.freetds.org/userguide/domains.htm
    //for domain logon/SSPI/trusted auth details
    //Domain login apparently can be done with username
    //and password, using presumably NTLM
    writeln('Enter SQL Server username. ' + LineEnding +
      '(or Windows username: DOMAIN\username)' + LineEnding +
      'Enter nothing to keep current setting: ' + FUsername);
    readln(Response);
    if Response <> '' then
    begin
      FUsername := Response;
    end;

    Response := '';
    writeln('Enter password ' + LineEnding +
      '(NOTE NOT HIDDEN ON SCREEN): ');
    readln(Response);
    if Response <> '' then
    begin
      FPassword := Response;
    end;
  end;
  //scroll some, the lazy way
  for Scroll := 0 to 200 do
  begin
    writeln('');
  end;
end;

procedure ShowUserInfo;
begin
  writeln('Current connection settings:');
  writeln('Server: ' + FServer);
  if FUseInstance=true then
  begin
    writeln('Instance: ' + FInstance);
  end
  else
  begin
    writeln('Port: ' + IntToStr(FPort));
  end;

  if FTrustedAuth = True then
  begin
    writeln('Trusted authentication/SSPI is on.');
  end
  else
  begin
    writeln('Trusted authentication/SSPI is off.');
    writeln('Username: ' + FUsername);
    writeln('Password not shown.');
  end;
end;

procedure GetDatabases;
const
  SQL = 'select name,database_id,create_date from master.sys.databases;';
begin
  FQuery.SQL.Text:=SQL;
  writeln('Going to run: ' + LineEnding +
  SQL);  
  FQuery.Open;
  writeln('==============================================================');
  while not FQuery.EOF do
  begin
    writeln(
    Trim(FQuery.Fields[0].AsString) , ',' , 
    Trim(FQuery.Fields[1].AsString) , ',' ,
    Trim(FQuery.Fields[2].AsString)
    );
    FQuery.Next;
  end;
  writeln('==============================================================');
end;

{
//to do.
function TestStoredProcedure: boolean;
const
  SQL = 'execute master.sys.sp_who;';
  //won't return results...
begin
end;
}

procedure Connect;
begin
  FConnection:=TMSSQLConnection.Create(nil);
  FConnection.HostName:=FServer;
  FConnection.DatabaseName:=Database;
  if FTrustedAuth=true then
  begin
    // this works automatically??!?
  end
  else
  begin
    FConnection.UserName:=FUsername;
    FConnection.Password:=FPassword;
  end;
  FConnection.CharSet:='UTF-8';
  try
    FConnection.Connected:=true;
  except
    on E: exception do
    begin
      writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
      raise; //stop program
    end;
  end;

  FTransaction:=TSQLTransaction.Create(nil);
  FConnection.Transaction:=FTransaction;

  FQuery:=TSQLQuery.Create(nil);
  FQuery.Database:=FConnection;
end;

procedure Disconnect;
begin
  FTransaction.Active:=false;
  FQuery.Free;
  FConnection.Close;
  FConnection.Free;
end;

begin
  GetUserInfo; //ask user for connection settings and...
  ShowUserInfo; //...repeat it back to him
  { Now try a connect to the master database, and run a simple query }
  Connect;
  GetDatabases; //Show query results;
  Disconnect;
end.

mssqltest2.pas (7,178 bytes)

Reinier Olislagers

2011-09-07 09:59

developer   ~0051547

Last edited: 2011-09-07 12:00

Thanks, fixed test/demo: mssqltest3.pas (sorry version 2 only worked because I have some MSSQL settings set to defaults)
- Lets user specify either port or instance:
-- Tested using default port 1433, works. However, didn't find any way to specify port in your connection component.
-- Haven't found a way to specify instance with your connection component (actually,you might want to make a note/check in the connection component that you need to either specify port or instance)

- Lets user specify either trusted auth or choose username/password auth:
-- SSPI/Trusted auth works (you might want to make a note in the connection component that not specifying username/password will lead to an SSPI logon)
-- Specifying username and password also works

- Freetds.conf is indeed not necessary, as you mentioned
(tested on MS SQL Server 2008; R2, I believe)

2011-09-07 11:59

 

mssqltest3.pas (7,622 bytes)
program mssqltest;

{Test program for Lacak2's mssqlconn
Microsoft SQL Server connection.
Defaults are set up for SQL Express database on local machine.

Required:
Windows (or fixed source code for Linux/OSX)
FreeTDS dblib.dll

Microsoft SQL Server database (e.g. SQL Express)
(Note: you could try with Sybase ASE as well, as FreeTDS should support this)

Optional
freetds.conf; see mssqlconn.pas and
http://www.freetds.org/userguide/freetdsconf.htm
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  Classes,
  SysUtils,
  sqldb,
  mssqlconn;

const
  Database = 'master'; //always present on an MS SQL system.
var
  FConnection: TMSSQLConnection;
  FQuery: TSQLQuery;
  FTransaction: TSQLTransaction;
  FServer: string;
  FInstance: string;
  FPort: integer;
  FTrustedAuth: boolean;  
  //Trusted authentication/SSPI. If on, no username/password required
  FUseInstance: boolean; //whether to use instance or port when connecting
  FUsername: string;
  FPassword: string;

procedure GetUserInfo;
var
  Response: string;
  Scroll: integer;
begin
  // Defaults
  FTrustedAuth := True;
  FServer := '127.0.0.1'; {current host;
  using '.' might only work for named pipes connection, 
  or when udp 1434 service runs, don't know}
  FInstance := '.'; //default FInstance
  FPort := 1433; //default port for MSSQL default instance, if the port is fixed, not dynamic
  FUseInstance := true; //use instance instead of port
  FUsername := 'sa'; //default administrator account
  FPassword := ''; //default FPassword on older versions

  writeln('MSSQL Test program');
  writeln('******************');
  writeln('Please enter/confirm your connection settings for this test:');
  writeln('');
  Response := '';
  writeln('Enter server name or IP for SQL server.' + LineEnding +
    'or enter nothing to keep current setting: ' + FServer);
  readln(Response);
  if Response <> '' then
  begin
    FServer := Response;
  end;

  Response := '';
  FUseInstance:=true;
  writeln('You can connect to an MS SQL Server database by specifyin either a port or an instance. ' + LineEnding +
    'Port (default 1433 for MSSQL, 5000 for Sybase ASE): the port on which the instance is listening.' + LineEnding +
    'Instance: for this, MS SQL needs to run the relevant service on UDP port 1434.' + LineEnding +
    'For default modern MS SQL Server installations, using instance would be easiest.' + LineEnding + 
    '' + LineEnding +
    'Press I or enter if you want to specify instance, or press P to specify port: I');
  readln(Response);
  Response:=AnsiUpperCase(Response);
  if Response = 'P' then
  begin
    // Use port when explicitly specified:
    FUseInstance:=false;  
  end
  else
  begin
    // Use instance by default:
    FUseInstance:=true;
  end;

  if FUseInstance=true then
  begin  
    // Get instance info
    Response := '';
    writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
      'nothing to keep current setting: ' + FInstance);
    readln(Response);
    if Response <> '' then
    begin
      FInstance := Response;
    end;
  end
  else
  begin
    // Get port info
    Response := '';
    writeln('Enter port number where the server is listening on or ' + LineEnding +
      'nothing to keep current setting: ' + IntToStr(FPort));
    readln(Response);
    if Response <> '' then
    begin
      FPort := StrToInt(Response);
    end;    
  end;
 

  Response := '';
  writeln('Authenticate with your current Windows user (trusted authentication/SSPI)?' +
    LineEnding + 'Enter nothing to keep current setting: Y');
  readln(Response);
  Response := AnsiUpperCase(Response);
  if Response = 'N' then
  begin
    FTrustedAuth := False;
  end
  else
  begin
    FTrustedAuth := True;
  end;

  if FTrustedAuth = False then
  begin
    Response := '';
    //see 
    //http://www.freetds.org/userguide/domains.htm
    //for domain logon/SSPI/trusted auth details
    //Domain login apparently can be done with username
    //and password, using presumably NTLM
    writeln('Enter SQL Server username. ' + LineEnding +
      '(or Windows username: DOMAIN\username)' + LineEnding +
      'Enter nothing to keep current setting: ' + FUsername);
    readln(Response);
    if Response <> '' then
    begin
      FUsername := Response;
    end;

    Response := '';
    writeln('Enter password ' + LineEnding +
      '(NOTE NOT HIDDEN ON SCREEN): ');
    readln(Response);
    if Response <> '' then
    begin
      FPassword := Response;
    end;
  end;
  //scroll some, the lazy way
  for Scroll := 0 to 200 do
  begin
    writeln('');
  end;
end;

procedure ShowUserInfo;
begin
  writeln('Current connection settings:');
  writeln('Server: ' + FServer);
  if FUseInstance=true then
  begin
    writeln('Instance: ' + FInstance);
  end
  else
  begin
    writeln('Port: ' + IntToStr(FPort));
  end;

  if FTrustedAuth = True then
  begin
    writeln('Trusted authentication/SSPI is on.');
  end
  else
  begin
    writeln('Trusted authentication/SSPI is off.');
    writeln('Username: ' + FUsername);
    writeln('Password not shown.');
  end;
end;

procedure GetDatabases;
const
  SQL = 'select name,database_id,create_date from master.sys.databases;';
begin
  FQuery.SQL.Text:=SQL;
  writeln('Going to run: ' + LineEnding +
  SQL);  
  FQuery.Open;
  writeln('==============================================================');
  while not FQuery.EOF do
  begin
    writeln(
    Trim(FQuery.Fields[0].AsString) , ',' , 
    Trim(FQuery.Fields[1].AsString) , ',' ,
    Trim(FQuery.Fields[2].AsString)
    );
    FQuery.Next;
  end;
  writeln('==============================================================');
end;

{
//to do.
function TestStoredProcedure: boolean;
const
  SQL = 'execute master.sys.sp_who;';
  //won't return results...
begin
end;
}

procedure Connect;
begin
  FConnection:=TMSSQLConnection.Create(nil);
  FConnection.CharSet:='UTF-8';  
  FConnection.HostName:=FServer;
  FConnection.DatabaseName:=Database;
  
  if FUseInstance=true then
  begin
    //Don't know how to specify instance, so just guessing:
    writeln('Don''t know how to specify instance to connection component, so just guessing:');
    //FConnection.InstanceName:=FInstance;
    FConnection.DatabaseName:=Database+'\'+FInstance;
  end
  else
  begin
    writeln('Don''t know how to specify port to connection component...');
    //FConnection.Port:=FPort;
  end;

  if FTrustedAuth=true then
  begin
    // this works automatically??!?
  end
  else
  begin
    FConnection.UserName:=FUsername;
    FConnection.Password:=FPassword;
  end;

  try
    FConnection.Connected:=true;
  except
    on E: exception do
    begin
      writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
      raise; //stop program
    end;
  end;

  FTransaction:=TSQLTransaction.Create(nil);
  FConnection.Transaction:=FTransaction;

  FQuery:=TSQLQuery.Create(nil);
  FQuery.Database:=FConnection;
end;

procedure Disconnect;
begin
  FTransaction.Active:=false;
  FQuery.Free;
  FConnection.Close;
  FConnection.Free;
end;

begin
  GetUserInfo; //ask user for connection settings and...
  ShowUserInfo; //...repeat it back to him
  { Now try a connect to the master database, and run a simple query }
  Connect;
  GetDatabases; //Show query results;
  Disconnect;
end.

mssqltest3.pas (7,622 bytes)

Marcos Douglas

2011-09-10 17:37

reporter   ~0051704

@BigChimp my fault. I did mean MSSQL, not MYSQL, sorry.

2011-11-02 09:35

 

mssqlconn_rc1.zip (824,868 bytes)

LacaK

2011-11-02 09:41

developer   ~0053735

mssqlconn_rc1 adds:
- dynamic loading of db client library
- support for ftGuid, ftFmtBCD field types
- other fixies and improvements

it also contains for user convenience:
- libiconv2.dll from http://gnuwin32.sourceforge.net/packages/libiconv.htm
- dblib.dll compiled from sources from http://www.freetds.org

Ludo Brands

2011-11-02 17:47

developer   ~0053754

Made a first stab at a port to linux. Set DBLIBDLL ='libsybdb.so' is working. However, the implementation requires a very recent freetds version (>=0.91). Latest binary version released on Debian and Ubuntu is 0.82. dbiscount is missing ,patch from LacaK;), causing a SIGSEGV and DBDATAREC doesn't have the members quarter and week causing date and time conversion exceptions.
Freetds has a dbversion function that returns the cvs version string for dblib.c. No relation to the global freetds version and therefor unusable. I suggest using assigned(dbiscount) to check for the minimum level. Testing the assignment of the different function pointers would be nice in any case and avoid SIGSEGV exeptions.

A problem with freetds in this implementation, both on windows and linux, are the "results pending" exceptions when using datasets. Datasets won't necessarily read all results and issuing a new query when all records aren't retrieved or cancelled isn't working. This even happens when a connection is closed and the transaction is automatically rolled back or committed and the dataset hasn't retrieved all data. Following solved most, not all, of these exceptions:

procedure TMSSQLConnection.UnPrepareStatement(cursor: TSQLCursor);
begin
  if assigned(FDBProc) then
    dbcanquery(FDBProc);
end;

Reinier Olislagers

2011-11-02 21:15

developer   ~0053760

Last edited: 2011-11-02 21:16

Ludo, did you forget to upload something ;)

I've changed my small test program to use instance and port. Have only tested port, seems to work.
Added executing a stored procedure. For this I need Ludo's UnPrepareStatement fix, otherwise I get an
Attempt to initiate a new Adaptive Server operation with results pending
error.

Uploaded updated test file.

2011-11-02 21:15

 

mssqltest4.pas (7,651 bytes)
program mssqltest;

{Test program for Lacak2's mssqlconn
Microsoft SQL Server connection.
Defaults are set up for SQL Express database on local machine.

Required:
Windows (or fixed source code for Linux/OSX)
mssqlcon wrapper for dblib.dll
FreeTDS dblib.dll

Microsoft SQL Server database (e.g. SQL Express)
(Note: you could try with Sybase ASE as well, as FreeTDS should support this)

Optional
freetds.conf; see mssqlconn.pas and
http://www.freetds.org/userguide/freetdsconf.htm
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  Classes,
  SysUtils,
  sqldb,
  mssqlconn;

const
  Database = 'master'; //always present on an MS SQL system.
var
  FConnection: TMSSQLConnection;
  FQuery: TSQLQuery;
  FTransaction: TSQLTransaction;
  FServer: string;
  FInstance: string;
  FPort: integer;
  FTrustedAuth: boolean;  
  //Trusted authentication/SSPI. If on, no username/password required
  FUseInstance: boolean; //whether to use instance or port when connecting
  FUsername: string;
  FPassword: string;

procedure GetUserInfo;
var
  Response: string;
  Scroll: integer;
begin
  // Defaults
  FTrustedAuth := True;
  FServer := '127.0.0.1'; {current host;
  using '.' might only work for named pipes connection, 
  or when udp 1434 service runs, don't know}
  FInstance := '.'; //default FInstance
  FPort := 1433; //default port for MSSQL default instance, if the port is fixed, not dynamic
  FUseInstance := true; //use instance instead of port
  FUsername := 'sa'; //default administrator account
  FPassword := ''; //default FPassword on older versions

  writeln('MSSQL Test program');
  writeln('******************');
  writeln('Please enter/confirm your connection settings for this test:');
  writeln('');
  Response := '';
  writeln('Enter server name or IP for SQL server.' + LineEnding +
    'or enter nothing to keep current setting: ' + FServer);
  readln(Response);
  if Response <> '' then
  begin
    FServer := Response;
  end;

  Response := '';
  FUseInstance:=true;
  writeln('You can connect to an MS SQL Server database by specifyin either a port or an instance. ' + LineEnding +
    'Port (default 1433 for MSSQL, 5000 for Sybase ASE): the port on which the instance is listening.' + LineEnding +
    'Instance: for this, MS SQL needs to run the relevant service on UDP port 1434.' + LineEnding +
    'For default modern MS SQL Server installations, using instance would be easiest.' + LineEnding + 
    '' + LineEnding +
    'Press I or enter if you want to specify instance, or press P to specify port: I');
  readln(Response);
  Response:=AnsiUpperCase(Response);
  if Response = 'P' then
  begin
    // Use port when explicitly specified:
    FUseInstance:=false;  
  end
  else
  begin
    // Use instance by default:
    FUseInstance:=true;
  end;

  if FUseInstance=true then
  begin  
    // Get instance info
    Response := '';
    writeln('Enter instance name (e.g. SQLEXPRESS) or ' + LineEnding +
      'nothing to keep current setting: ' + FInstance);
    readln(Response);
    if Response <> '' then
    begin
      FInstance := Response;
    end;
  end
  else
  begin
    // Get port info
    Response := '';
    writeln('Enter port number where the server is listening on or ' + LineEnding +
      'nothing to keep current setting: ' + IntToStr(FPort));
    readln(Response);
    if Response <> '' then
    begin
      FPort := StrToInt(Response);
    end;    
  end;
 

  Response := '';
  writeln('Authenticate with your current Windows user (trusted authentication/SSPI)?' +
    LineEnding + 'Enter nothing to keep current setting: Y');
  readln(Response);
  Response := AnsiUpperCase(Response);
  if Response = 'N' then
  begin
    FTrustedAuth := False;
  end
  else
  begin
    FTrustedAuth := True;
  end;

  if FTrustedAuth = False then
  begin
    Response := '';
    //see 
    //http://www.freetds.org/userguide/domains.htm
    //for domain logon/SSPI/trusted auth details
    //Domain login apparently can be done with username
    //and password, using presumably NTLM
    writeln('Enter SQL Server username. ' + LineEnding +
      '(or Windows username: DOMAIN\username)' + LineEnding +
      'Enter nothing to keep current setting: ' + FUsername);
    readln(Response);
    if Response <> '' then
    begin
      FUsername := Response;
    end;

    Response := '';
    writeln('Enter password ' + LineEnding +
      '(NOTE NOT HIDDEN ON SCREEN): ');
    readln(Response);
    if Response <> '' then
    begin
      FPassword := Response;
    end;
  end;
  //scroll some, the lazy way
  for Scroll := 0 to 200 do
  begin
    writeln('');
  end;
end;

procedure ShowUserInfo;
begin
  writeln('Current connection settings:');
  writeln('Server: ' + FServer);
  if FUseInstance=true then
  begin
    writeln('Instance: ' + FInstance);
  end
  else
  begin
    writeln('Port: ' + IntToStr(FPort));
  end;

  if FTrustedAuth = True then
  begin
    writeln('Trusted authentication/SSPI is on.');
  end
  else
  begin
    writeln('Trusted authentication/SSPI is off.');
    writeln('Username: ' + FUsername);
    writeln('Password not shown.');
  end;
end;

procedure GetDatabases;
const
  SQL = 'select name,database_id,create_date from master.sys.databases;';
begin
  FQuery.SQL.Text:=SQL;
  writeln('Going to run: ' + LineEnding +
  SQL);  
  FQuery.Open;
  writeln('==============================================================');
  while not FQuery.EOF do
  begin
    writeln(
    Trim(FQuery.Fields[0].AsString) , ',' , 
    Trim(FQuery.Fields[1].AsString) , ',' ,
    Trim(FQuery.Fields[2].AsString)
    );
    FQuery.Next;
  end;
  FQuery.Close;
  writeln('==============================================================');
end;

procedure TestStoredProcedure;
const
  SQL = 'execute master.sys.sp_who;';
  //Can return results, but we don't care...
begin
  FQUery.Close;
  FQuery.SQL.Text:=SQL;
  writeln('Going to execute SP: ' + LineEnding +
  SQL);
  FQuery.ExecSQL;
  writeln('Done executing SP.');
end;


procedure Connect;
begin
  FConnection:=TMSSQLConnection.Create(nil);
  FConnection.CharSet:='UTF-8';    
  FConnection.DatabaseName:=Database;
  
  if FUseInstance=true then
  begin        
    FConnection.HostName:=FServer+'\'+FInstance;
  end
  else
  begin
    if FPort=0 then FPort:=1433; //Default for SQL server
    FConnection.HostName:=FServer+':'+IntToStr(FPort);
  end;

  if FTrustedAuth=true then
  begin
    // this works automatically??!?
  end
  else
  begin
    FConnection.UserName:=FUsername;
    FConnection.Password:=FPassword;
  end;

  try
    FConnection.Connected:=true;
  except
    on E: exception do
    begin
      writeln('Error connecting to server: '+E.ClassName+'/'+E.Message);
      raise; //stop program
    end;
  end;

  FTransaction:=TSQLTransaction.Create(nil);
  FConnection.Transaction:=FTransaction;

  FQuery:=TSQLQuery.Create(nil);
  FQuery.Database:=FConnection;
end;

procedure Disconnect;
begin
  FTransaction.Active:=false;
  FQuery.Free;
  FConnection.Close;
  FConnection.Free;
end;

begin
  GetUserInfo; //ask user for connection settings and...
  ShowUserInfo; //...repeat it back to him
  { Now try a connect to the master database, and run a simple query }
  Connect;
  GetDatabases; //Show query results;
  TestStoredProcedure; //Execute a stored procedure.
  Disconnect;
end.

mssqltest4.pas (7,651 bytes)

Ludo Brands

2011-11-03 08:38

developer   ~0053761

No, I didn't forget ;)
My linux version is currently running with freetds 8.2 and uses the old DBDATAREC version and skips dbiscount. I'll build a recent freetds later. Since this recent version issue is quite annoying for deploying code I'm still looking at a reasonable solution to detect freetds versions and have mssqlconn support older versions.
Regarding "Results pending", as said before, it is only a partial solution. A simple case that still fails is the following: TDBGrid (20 rows) linked to TSQLQUERY that returns 100 rows, modify first line, don't scroll to bottom or last, applyupdates. This will try to insert while not all records have been retrieved. An additional dbcanquery would solve this but there are probably other more complex cases (master-detail?) where dbcanquery is not going to be the solution. Perhaps a single open TSQLQuery per TMSSQLConnection is going to be a requirement. Or storing everything locally.
Cut 'n paste of the 2 extra lines in the now empty TMSSQLConnection.UnPrepareStatement isn't too difficult, is it? ;)

LacaK

2011-11-03 10:44

developer   ~0053763

Last edited: 2011-11-03 11:08

Thanks for comments.
Yes, "Results pending" is known problem, same as in TODBCConnection. Common workaround is set TSQLQuery.PacketRecords=-1 (which will fetch all rows and store it localy).
Of course I can add code provided by Ludo and I will add comment into readme.txt
(Only I am not sure if use "dbcanquery" or more general "dbcancel" and if add there some tests if there are any rows/results pending ... to avoid call dbcanquery when not needed)

About version 0.82 IMO raising exception in InitialiseDBLib() with text, that minimum supported version is 0.91 is sufficient. 0.82 is years old and can have also other bugs, so better is force users move to current stable version.

For discussion we can use http://lazarus.freepascal.org/index.php/topic,15135.0.html

Ludo Brands

2011-11-03 13:56

developer   ~0053773

Last edited: 2011-11-03 13:57

Attached updated version (mssqlconn_RC1_2.zip):
- linux patch, tested on ubuntu 10.04 x64
- detection and support for freetds pre-0.91 DBDATEREC format and conditional use of dbiscount()
- clean-up of DBErrorStr and DBMsgStr in CheckError. Multiple exceptions were accumulating messages.
- dbcanquery in TMSSQLConnection.UnPrepareStatement

2011-11-03 13:56

 

mssqlconn_RC1_2.zip (12,435 bytes)

2011-12-13 07:09

 

mssqlconn_rc2.zip (829,472 bytes)

LacaK

2011-12-13 07:10

developer   ~0055005

mssqlconn_rc2 adds:
- FreeTDS 0.82 support
- Sybase ASE support
- ftVarBytes support
- fcl-db test suite integration

Michael Van Canneyt

2012-03-16 09:37

administrator   ~0057701

* Added the dblib file in a dblib package
* Added connection component under sqldb/mssql

2012-03-22 14:27

 

tests_mssql.patch (11,856 bytes)
Index: database.ini.txt
===================================================================
--- database.ini.txt	(revision 20570)
+++ database.ini.txt	(working copy)
@@ -94,6 +94,15 @@
 connectorparams=sqlite3
 name=test.db
 
+; MS SQL Server database:
+[mssql]
+connector=sql
+connectorparams=mssql
+name=pubs
+user=sa
+password=
+hostname=127.0.0.1
+
 ; TDBf: DBase/FoxPro database:
 [dbf]
 connector=dbf
Index: sqldbtoolsunit.pas
===================================================================
--- sqldbtoolsunit.pas	(revision 20570)
+++ sqldbtoolsunit.pas	(working copy)
@@ -6,14 +6,15 @@
 
 uses
   Classes, SysUtils, toolsunit,
-  db,
-  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
+  db, sqldb,
+  mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn,
+  ibconnection, pqconnection, odbcconn, oracleconnection, sqlite3conn, mssqlconn;
 
-type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3);
+type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3,mssql);
 
 const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
       DBTypesNames : Array [TSQLDBTypes] of String[19] =
-             ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3');
+        ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL');
              
       FieldtypeDefinitionsConst : Array [TFieldType] of String[20] =
         (
@@ -24,25 +25,25 @@
           '',
           'BOOLEAN',
           'FLOAT',
-          '',
-          'DECIMAL(18,4)',
+          '',             // ftCurrency
+          'DECIMAL(18,4)',// ftBCD
           'DATE',
           'TIME',
-          'TIMESTAMP',
+          'TIMESTAMP',    // ftDateTime
           '',
           '',
           '',
-          'BLOB',
-          'BLOB',
-          'BLOB',
+          'BLOB',         // ftBlob
+          'BLOB',         // ftMemo
+          'BLOB',         // ftGraphic
           '',
           '',
           '',
           '',
           '',
-          'CHAR(10)',
+          'CHAR(10)',     // ftFixedChar
           '',
-          'BIGINT',
+          'BIGINT',       // ftLargeInt
           '',
           '',
           '',
@@ -52,10 +53,10 @@
           '',
           '',
           '',
+          '',             // ftGuid
+          'TIMESTAMP',    // ftTimestamp
+          'NUMERIC(18,6)',// ftFmtBCD
           '',
-          'TIMESTAMP',
-          'NUMERIC(18,6)',
-          '',
           ''
         );
              
@@ -156,6 +157,20 @@
     end;
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
+  if SQLDbType = MSSQL then
+    begin
+    Fconnection := TMSSQLConnection.Create(nil);
+    FieldtypeDefinitions[ftBoolean] := 'BIT';
+    FieldtypeDefinitions[ftCurrency]:= 'MONEY';
+    FieldtypeDefinitions[ftDate]    := 'DATETIME';
+    FieldtypeDefinitions[ftTime]    := '';
+    FieldtypeDefinitions[ftDateTime]:= 'DATETIME';
+    FieldtypeDefinitions[ftBytes]   := 'BINARY(5)';
+    FieldtypeDefinitions[ftVarBytes]:= 'VARBINARY(10)';
+    FieldtypeDefinitions[ftBlob]    := 'IMAGE';
+    FieldtypeDefinitions[ftMemo]    := 'TEXT';
+    FieldtypeDefinitions[ftGraphic] := '';
+    end;
 
   if SQLDbType in [mysql40,mysql41,mysql50,mysql51,mysql55,odbc,interbase] then
     begin
@@ -169,7 +184,7 @@
         testValues[ftDateTime,t] := copy(testValues[ftDateTime,t],1,19)+'.000';
       end;
     end;
-  if SQLDbType in [postgresql,interbase] then
+  if SQLDbType in [postgresql,interbase,mssql] then
     begin
     // Some db's do not support times > 24:00:00
     testTimeValues[3]:='13:25:15.000';
@@ -182,11 +197,15 @@
       end;
     end;
 
-  if SQLDbType in [sqlite3] then
-    testValues[ftCurrency]:=testValues[ftBCD]; //decimal separator for currencies must be decimal point
+  // DecimalSeparator must correspond to monetary locale (lc_monetary) set on PostgreSQL server
+  // Here we assume, that locale on client side is same as locale on server
+  if SQLDbType in [postgresql] then
+    for t := 0 to testValuesCount-1 do
+      testValues[ftCurrency,t] := QuotedStr(CurrToStr(testCurrencyValues[t]));
 
   // SQLite does not support fixed length CHAR datatype
   // MySQL by default trimms trailing spaces on retrieval; so set sql-mode="PAD_CHAR_TO_FULL_LENGTH" - supported from MySQL 5.1.20
+  // MSSQL set SET ANSI_PADDING ON
   if SQLDbType in [sqlite3] then
     for t := 0 to testValuesCount-1 do
       testValues[ftFixedChar,t] := PadRight(testValues[ftFixedChar,t], 10);
@@ -291,7 +310,10 @@
           begin
           sql := sql + ',F' + Fieldtypenames[FType];
           if testValues[FType,CountID] <> '' then
-            sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
+            if FType in [ftCurrency] then
+              sql1 := sql1 + ',' + testValues[FType,CountID]
+            else
+              sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
           else
             sql1 := sql1 + ',NULL';
           end;
@@ -303,7 +325,10 @@
 
     Ftransaction.Commit;
   except
-    if Ftransaction.Active then Ftransaction.Rollback
+    on E: Exception do begin
+      //writeln(E.Message);
+      if Ftransaction.Active then Ftransaction.Rollback;
+    end;
   end;
 end;
 
Index: testfieldtypes.pas
===================================================================
--- testfieldtypes.pas	(revision 20570)
+++ testfieldtypes.pas	(working copy)
@@ -778,12 +778,9 @@
 
     end;
   TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
-
-
 end;
 
 procedure TTestFieldTypes.TestIntParamQuery;
-
 begin
   TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
 end;
@@ -793,9 +790,14 @@
   TestXXParamQuery(ftFMTBcd,FieldtypeDefinitionsConst[ftFMTBcd],testValuesCount);
 end;
 
+procedure TTestFieldTypes.TestDateParamQuery;
+begin
+  TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount);
+end;
+
 procedure TTestFieldTypes.TestTimeParamQuery;
 begin
-  TestXXParamQuery(ftTime,FieldtypeDefinitionsConst[ftTime],testValuesCount);
+  TestXXParamQuery(ftTime,FieldtypeDefinitions[ftTime],testValuesCount);
 end;
 
 procedure TTestFieldTypes.TestDateTimeParamQuery;
@@ -821,7 +823,7 @@
 
 procedure TTestFieldTypes.TestVarBytesParamQuery;
 begin
-  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount);
+  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount, SQLDbType<>mssql);
 end;
 
 procedure TTestFieldTypes.TestStringParamQuery;
@@ -835,13 +837,7 @@
   TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
 end;
 
-procedure TTestFieldTypes.TestDateParamQuery;
 
-begin
-  TestXXParamQuery(ftDate,'DATE',testDateValuesCount);
-end;
-
-
 procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
 
 var i : integer;
@@ -885,7 +881,10 @@
                      Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
                    else
                      Params.ParamByName('field1').AsBlob := testBytesValues[i];
-        ftVarBytes:Params.ParamByName('field1').AsString := testBytesValues[i];
+        ftVarBytes:if cross then
+                     Params.ParamByName('field1').AsString := testBytesValues[i]
+                   else
+                     Params.ParamByName('field1').AsBlob := testBytesValues[i];
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -1241,6 +1240,11 @@
       Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
       Query.SQL.Text:='execute procedure FPDEV_PROC';
     end
+    else if SQLDbType = mssql then
+    begin
+      Connection.ExecuteDirect('create procedure FPDEV_PROC as select 1 union select 2;');
+      Query.SQL.Text:='execute FPDEV_PROC';
+    end
     else
     begin
       Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
@@ -1526,10 +1530,11 @@
     begin
     with query do
       begin
-      if (sqlDBtype=interbase) then
-        SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21'''
-      else
-        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
+      case sqlDBtype of
+        interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
+        mssql     : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
+        else        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
+      end;
       Open;
       close;
       ServerFilter:='ID=21';
@@ -1650,7 +1655,7 @@
 procedure TTestFieldTypes.TestBug9744;
 var i : integer;
 begin
-  if SQLDbType in [interbase,postgresql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
+  if SQLDbType in [interbase,postgresql,mssql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
 
   with TSQLDBConnector(DBConnector) do
     begin
@@ -1820,6 +1825,8 @@
   else
   begin
     datatype:=FieldtypeDefinitions[ftTime];
+    if datatype = '' then
+      Ignore(STestNotApplicable);
     if sqlDBType = sqlite3 then
       testIntervalValuesCount := 5
     else if sqlDBType in MySQLdbTypes then
@@ -1847,6 +1854,12 @@
     values:='DEFAULT VALUES';
     fieldtype:=ftInteger;
   end
+  else if sqlDBType = mssql then
+  begin
+    datatype:='INTEGER IDENTITY';
+    values:='DEFAULT VALUES';
+    fieldtype:=ftAutoInc;
+  end
   else
     Ignore(STestNotApplicable);
 
@@ -1919,14 +1932,14 @@
 
 procedure TTestFieldTypes.TestTemporaryTable;
 begin
-  if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t support temporary tables');
+  if SQLDbType in [interbase,mssql] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t support temporary tables');
 
   with TSQLDBConnector(DBConnector).Query do
     begin
     SQL.Clear;
     SQL.Add('CREATE TEMPORARY TABLE TEMP1 (id int)');
     ExecSQL;
-    SQL.Text :=  'INSERT INTO TEMP1(id) values (5)';
+    SQL.Text := 'INSERT INTO TEMP1(id) values (5)';
     ExecSQL;
     SQL.Text := 'SELECT * FROM TEMP1';
     Open;
@@ -2050,4 +2063,3 @@
 initialization
   if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
 end.
-
Index: toolsunit.pas
===================================================================
--- toolsunit.pas	(revision 20570)
+++ toolsunit.pas	(working copy)
@@ -315,10 +315,7 @@
     testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
     testValues[ftInteger,i] := IntToStr(testIntValues[i]);
     testValues[ftLargeint,i] := IntToStr(testLargeIntValues[i]);
-    // The decimalseparator was set to a comma for currencies and to a dot for ftBCD values.
-    // DecimalSeparator for PostgreSQL must correspond to monetary locale set on PostgreSQL server
-    // Here we assume, that locale on client side is same as locale on server
-    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i]);
+    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i],FormatSettings);
     testValues[ftBCD,i] := CurrToStr(testCurrencyValues[i],FormatSettings);
     // For date '0001-01-01' other time-part like '00:00:00' causes "Invalid variant type cast", because of < MinDateTime constant
     if (testDateValues[i]>'0001-01-01') and (testTimeValues[i]>='00:00:01') and (testTimeValues[i]<'24:00:00') then
tests_mssql.patch (11,856 bytes)

LacaK

2012-03-22 14:28

developer   ~0057917

Updated patch for fcl-db test suite

2012-03-23 09:48

 

tests_mssql_date.patch (3,271 bytes)
Index: sqldbtoolsunit.pas
===================================================================
--- sqldbtoolsunit.pas	(revision 20584)
+++ sqldbtoolsunit.pas	(working copy)
@@ -243,6 +243,7 @@
     begin
     database := Fconnection;
     transaction := Ftransaction;
+    PacketRecords := -1;  // To avoid: "Connection is busy with results for another hstmt" (ODBC,MSSQL)
     end;
 end;
 
Index: testfieldtypes.pas
===================================================================
--- testfieldtypes.pas	(revision 20584)
+++ testfieldtypes.pas	(working copy)
@@ -140,16 +140,16 @@
     '1991-03-01',
     '2040-10-16',
     '1977-09-29',
+    '1899-12-29',
+    '1899-12-30',
+    '1899-12-31',
+    '1900-01-01',
     '1800-03-30',
-    '1650-05-10',
     '1754-06-04',
+    '1650-05-10',
     '0904-04-12',
     '0199-07-09',
-    '0001-01-01',
-    '1899-12-29',
-    '1899-12-30',
-    '1899-12-31',
-    '1900-01-01'
+    '0001-01-01'
   );
 
   testBytesValuesCount = 5;
@@ -608,16 +608,7 @@
     '2000-01-01 10:00:00',
     '2000-01-01 23:59:59',
     '1994-03-06 11:54:30',
-    '2040-10-16',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
-    '1400-02-03 12:21:53',
-    '0354-11-20 21:25:15',
-    '1333-02-03 21:44:21',
-    '1800-03-30',
-    '1650-05-10',
-    '1754-06-04',
-    '0904-04-12',
-    '0199-07-09',
-    '0001-01-01',
+    '1754-06-04',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
     '1899-12-29',
     '1899-12-30',
     '1899-12-31',
@@ -628,7 +619,16 @@
     '1899-12-29 18:00:51',
     '1903-04-02 01:04:02',
     '1815-09-24 03:47:22',
-    '2100-01-01 01:01:01'
+    '2040-10-16',
+    '2100-01-01 01:01:01',
+    '1400-02-03 12:21:53',          // MS SQL 2005 doesn't support datetimes before 1753
+    '0354-11-20 21:25:15',
+    '1333-02-03 21:44:21',
+    '1800-03-30',
+    '1650-05-10',
+    '0904-04-12',
+    '0199-07-09',
+    '0001-01-01'
   );
 
 var
@@ -853,7 +853,6 @@
 
   with TSQLDBConnector(DBConnector).Query do
     begin
-    PacketRecords := -1;
     sql.clear;
     sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
 
Index: toolsunit.pas
===================================================================
--- toolsunit.pas	(revision 20584)
+++ toolsunit.pas	(working copy)
@@ -138,25 +138,25 @@
     '2004-03-01',
     '1991-02-28',
     '1991-03-01',
+    '1997-11-29',
     '2040-10-16',
     '1977-09-29',
+    '1977-12-31',
+    '1917-12-29',
+    '1900-01-01',
+    '1899-12-31',
+    '1899-12-30',
+    '1899-12-29',
     '1800-03-30',
+    '1754-06-04',
+    '1753-01-01',
     '1650-05-10',
-    '1754-06-04',
     '0904-04-12',
     '0199-07-09',
-    '0001-01-01',
+    '0079-11-29',
     '0031-11-02',
-    '1899-12-29',
-    '1899-12-30',
-    '1899-12-31',
-    '1977-09-29',
-    '1917-12-29',
-    '0079-11-29',
-    '1997-11-29',
-    '0001-01-01',
-    '1997-11-29',
-    '1900-01-01'
+    '0001-12-31',
+    '0001-01-01'
   );
 
   testTimeValues : Array[0..testValuesCount-1] of string = (
@@ -177,7 +177,7 @@
     '15:35:12.000',
     '16:45:12.010',
     '13:55:12.200',
-    '13:46:12.542',
+    '13:46:12.543',
     '15:35:12.000',
     '17:25:12.530',
     '19:45:12.003',
tests_mssql_date.patch (3,271 bytes)

LacaK

2012-03-23 09:50

developer   ~0057941

Patch for fcl-db test suite, which reorders datetime testing values, so these out-of-range values are coming last.

2012-03-27 08:04

 

dblib.pp.diff2 (596 bytes)

LacaK

2012-03-27 08:06

developer   ~0058097

Patch for dblib.pp:
- C char mapped to shortint instead of char
- added comments to data types to be clear (32 vs. 64 bit env.)

Michael Van Canneyt

2012-03-27 09:18

administrator   ~0058100

I have applied the patch. I am closing this bug.

If you submit more patches, please use separate bugreports;
it makes it easier to follow up on the status for us.

Issue History

Date Modified Username Field Change
2010-08-30 07:34 LacaK New Issue
2010-08-30 07:34 LacaK Status new => assigned
2010-08-30 07:34 LacaK Assigned To => Joost van der Sluis
2010-08-30 07:34 LacaK File Added: mssqlconn_beta1.zip
2010-10-04 12:21 LacaK File Added: mssqlconn_beta2.zip
2010-10-04 12:22 LacaK Note Added: 0041473
2011-09-06 15:12 Marcos Douglas Note Added: 0051510
2011-09-06 15:46 Marco van de Voort Note Added: 0051511
2011-09-06 17:16 Reinier Olislagers Note Added: 0051514
2011-09-06 17:17 Reinier Olislagers File Added: mssqltest.pas
2011-09-06 17:17 Reinier Olislagers File Added: dblib.pp.diff
2011-09-06 17:18 Reinier Olislagers Note Edited: 0051514
2011-09-07 08:50 LacaK Note Added: 0051544
2011-09-07 09:56 Reinier Olislagers File Added: mssqltest2.pas
2011-09-07 09:59 Reinier Olislagers Note Added: 0051547
2011-09-07 10:04 Reinier Olislagers Note Edited: 0051547
2011-09-07 11:58 Reinier Olislagers Note Edited: 0051547
2011-09-07 11:59 Reinier Olislagers File Added: mssqltest3.pas
2011-09-07 12:00 Reinier Olislagers Note Edited: 0051547
2011-09-10 17:37 Marcos Douglas Note Added: 0051704
2011-11-02 09:35 LacaK File Added: mssqlconn_rc1.zip
2011-11-02 09:41 LacaK Note Added: 0053735
2011-11-02 17:47 Ludo Brands Note Added: 0053754
2011-11-02 21:15 Reinier Olislagers Note Added: 0053760
2011-11-02 21:15 Reinier Olislagers File Added: mssqltest4.pas
2011-11-02 21:16 Reinier Olislagers Note Edited: 0053760
2011-11-03 08:38 Ludo Brands Note Added: 0053761
2011-11-03 10:44 LacaK Note Added: 0053763
2011-11-03 11:08 LacaK Note Edited: 0053763
2011-11-03 13:56 Ludo Brands Note Added: 0053773
2011-11-03 13:56 Ludo Brands File Added: mssqlconn_RC1_2.zip
2011-11-03 13:57 Ludo Brands Note Edited: 0053773
2011-12-13 07:09 LacaK File Added: mssqlconn_rc2.zip
2011-12-13 07:10 LacaK Note Added: 0055005
2012-03-16 09:37 Michael Van Canneyt Fixed in Revision => 20522
2012-03-16 09:37 Michael Van Canneyt Status assigned => resolved
2012-03-16 09:37 Michael Van Canneyt Fixed in Version => 2.7.1
2012-03-16 09:37 Michael Van Canneyt Resolution open => fixed
2012-03-16 09:37 Michael Van Canneyt Note Added: 0057701
2012-03-16 09:37 Michael Van Canneyt Target Version => 3.0.0
2012-03-16 09:37 Michael Van Canneyt Status resolved => assigned
2012-03-16 09:37 Michael Van Canneyt Assigned To Joost van der Sluis => Michael Van Canneyt
2012-03-22 14:27 LacaK File Added: tests_mssql.patch
2012-03-22 14:28 LacaK Note Added: 0057917
2012-03-23 09:48 LacaK File Added: tests_mssql_date.patch
2012-03-23 09:50 LacaK Note Added: 0057941
2012-03-27 08:04 LacaK File Added: dblib.pp.diff2
2012-03-27 08:06 LacaK Note Added: 0058097
2012-03-27 09:18 Michael Van Canneyt Status assigned => resolved
2012-03-27 09:18 Michael Van Canneyt Note Added: 0058100
2012-03-27 09:52 LacaK Status resolved => closed