+ Initial implementation

fcl/db/odbc/Makefile.fpc

@@ -0,0 +1,28 @@
+#
+# Makefile.fpc for fpODBC db units
+#
+
+[package]
+main=fcl
+
+[target]
+units=fpodbc
+examples=testbcon testcon testdrcon testenv testfl testpa testpk\
+         testpr testsql testst testtl
+
+
+[clean]
+units=
+
+[require]
+packages=odbc
+
+[compiler]
+options=-S2 
+targetdir=../../$(OS_TARGET)
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../../..

fcl/db/odbc/README

@@ -0,0 +1,181 @@
+fpODBC - a OOP wrapper around the ODBC driver.
+
+This is a simple OOP wrapper around teh ODBC data calls.
+
+There are basically 3 classes:
+
+TODBCEnvironment
+----------------
+  A global object the contains the connection to the ODBC driver. Each
+  connection should have an environment assigned to it. If not, a
+  default environment will be used.
+
+  It has the following methods:
+  
+  Function GetDriverNames(List : Tstrings) : Integer;
+    Fills list with the available drivers. Returns the number of
+    drivers.
+  
+  Function GetDataSourceNames(List : Tstrings; Types : TDSNTypes;Descriptions : Boolean) : Integer;
+    Fills list with the available datasources.
+    Types is one of
+      dtUser   : Return only user DSNs
+      dtSystem : Return system DSNs
+      dtBoth   : Return both
+    The function returns the number of returned drivers.
+    
+  function GetDriverOptions(Driver: String; Options: TStrings): Integer;
+    Returns a list of options for the driver.
+
+TODBCConnection
+
+  Represents a connection to a ODBC datasource.
+  The connection is established according to the following rules:
+   - If OnBrowseConnection is assigned, SQLBrowseConnect is used. At
+     each browse step, the handler is called with the in and out
+     parameter lists filled.
+     TConnectionBrowseEvent = Procedure (Sender : TObject;InParams,OutParams : Tstrings) of Object;
+
+     This is as yet untested, since I have no driver which supports it.
+
+   - If the DSN property is assigned, this is used. Password and Username are also used.
+
+   - If The drivername is assigned, that is used, together with the
+     DriverParams. This should be a list name=value pairs which will be
+     passed to the driver.
+
+   - If none of the above conditions is fullfilled, an error is raised.
+ 
+   - To connect, set the Active property to 'True' or call connect.
+   
+   - To Disconnect, set the active property to false or call disconnect
+
+   The following methods exist:
+   
+    Procedure Connect;
+      Connects to the DSN/Driver
+      
+    Procedure Disconnect;
+      Disconnects from the DSN/Driver
+      
+    Procedure GetTableNames(S : TStrings; SystemTables : Boolean);
+    
+      returns a list of tables. If systemtables is true, then system
+      table names are also returned.
+      
+    Procedure GetFieldNames(TableName : String; S : TStrings);
+      returns a list of fieldnames for table 'tablename'
+    Procedure GetPrimaryKeyFields(TableName : String; S : TStrings);
+      returns a list of primary key fieldnames for table 'tablename'
+    procedure GetProcedureNames(S : TStrings);
+      returns a list of stored procedure names
+    procedure GetProcedureParams(ProcName : String;ParamTypes : TODBCParamTypes; S : TStrings);
+      returns a list of parameters for the stored procedure. ParamTypes is a set of 
+      ptUnknown,ptInput,ptInputOutput,ptResult,ptOutput,ptRetVal
+      
+
+TODBCStatement / TODBCSQLStatement.
+
+  TODBCStatement is an abstract class which encapsulates an ODBC Statement
+  handle. TODBCSQLStatement accepts an SQL Query which it can execute.
+
+  TODBCStatement has the following methods:
+   
+    Procedure BindFields(RestrictList : TStrings);virtual;
+      Binds fields. If restrictlist is assigned, then only fields whose
+      name appears in the list are bound.
+    Procedure ClearFields;virtual;
+      clears the field definitions.
+    Function Fetch : Boolean;
+      fetches the next row. Is false if there was no more data.
+    Property Connection : TODBCConnection Read FConnection Write SetConnection;
+      The connection object to use.
+    Property BOF : Boolean read FBOF;
+      True if at beginning of data
+    Property EOF : Boolean read FEOF;
+      True if at end of data
+    Property Fields : TODBCFieldList Read FFields;
+      Collection of fields in result set (if any)
+
+  TODBCSQLStatement has the following extra methods/properties:
+  
+    procedure Prepare;
+      prepares the query. After this, Bindfields may be called.
+    procedure Unprepare;
+      unprepares the query. After this, Bindfields nor execute may be called.
+    procedure ExecSQL;
+      executes the SQL query. If it was not prepared it is executed
+      directly.
+    Procedure Open;
+      prepares the query, binds all fields, allocates buffers and
+      fetches the first row of the result set.
+    Procedure Close;
+      Undoes the 'Open'
+    procedure GetFieldList(List: TStrings);
+      Retsurns a list of field names in the result set. Can only be
+      called after Prepare/Open and before close.
+    Property Active : Boolean Read GetActive Write SetActive;
+      Setting Active to true is the same as calling open.
+      Setting it to false is the same as calling close.
+    Property SQL : TStrings
+      The SQL statement to be executed.
+
+
+  A query result is returned in a collection of TODBCField objects:
+
+TODBCField :
+    Property Position : SQLSmallint Read FPosition;
+       (position in the query)
+    Property Name : String read FName;
+       (name of the field)
+    Property DataType : SQLSmallInt read FDatatype;
+       (original SQL data type)
+    Property Size : SQLUinteger read FSize;
+       (Original SQL data size)
+    property DecimalDigits : SQLSmallInt read FDecimalDigits;
+       (Original SQL digits after decimal point)
+    Property Nullable : Boolean Read FNullable;
+       (Field is nullable ?)
+    Property Data : Pchar Read GetData;
+       (pointer to raw data)    
+    Property BufType : SQLSmallInt Read FBufType;
+       (SQL type of the allocated data buffer)
+    Property BufSize : SQLInteger Read FBufSize;
+       (Allocated size of the buffer)
+    Property IsNull : Boolean Read GetIsNull;
+       (Was the returned field value null ?)
+       
+    Property AsString : String Read GetAsString;
+       Field value as string.  
+    Property AsInteger : Integer Read GetAsInteger;
+       Field value as integer.  
+    Property AsBoolean : Boolean Read GetAsBoolean;
+       Field value as boolean.  
+    Property AsDouble : Double Read GetAsDouble;
+       Field value as DOUBLE
+    Property AsDateTime : TDateTime Read GetAsDateTime;
+       Field value as TDateTime
+       
+    The latter properties do some basic conversion i.e. 
+    if the result is an integer, the AsString will return
+    the integer value converted to a string.
+
+    Blob is not yet supported, but should be soon.
+
+List of examples:
+
+Program       test functionality 
+-------       -----------------
+
+testbcon.pp   tests browseconnect.
+testcon.pp    tests DSN connect.
+testdrcon.pp  tests driverconnect. 
+testenv.pp    test ennvironment functions.
+testfl.pp     test fieldlist.
+testodbc.pp   test raw odbc.
+testpa.pp     test procedure arguments.
+testpk.pp     test primary key lists.   
+testpr.pp     test procedure list.
+testsql.pp    test execution of SQL and retrieval of results.
+testst.pp     test preparing of a statement.
+testtl.pp     test table list.

fcl/db/odbc/testbcon.pp

@@ -0,0 +1,63 @@
+program testbcon;
+{
+  Test browsingconnection
+  - I don't have a driver which supports it though :/
+}
+{$mode objfpc}
+uses fpodbc,Classes;
+
+Type
+  TApp = Class (TObject)
+    Conn : TODBCConnection;
+    Procedure GetParams (Sender : TObject; ListIn,ListOut : TStrings);
+    Procedure Run;
+  end;
+
+
+{ TApp }
+
+procedure TApp.GetParams(Sender: TObject; ListIn, ListOut: TStrings);
+
+Var
+  S : String;
+  i : integer;
+  
+begin
+  Writeln('Input parameters were :');
+  With ListIN do
+    For I:=0 to Count-1 do
+      Writeln(Strings[i]);
+  Writeln('Output parameters were :');
+  With Listout do
+    For I:=0 to Count-1 do
+      Writeln(Strings[i]);
+  Repeat
+    Writeln('Parameter to add to input (empty to quit):');
+    Readln(S);
+    If S<>'' then
+      ListIn.Add(S)
+  Until S='';
+end;
+
+procedure TApp.Run;
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='FPC';
+    Conn.OnBrowseConnection:=@Self.GetParams;
+    Conn.Active:=True;
+    Writeln('Connected !!');
+    Conn.Active:=False;
+  Finally
+    Conn.free;
+  end;
+end;
+
+begin
+  With Tapp.Create do
+    Try
+      Run;
+    Finally
+      Free;
+    end;
+end.

fcl/db/odbc/testcon.pp

@@ -0,0 +1,19 @@
+program testcon;
+{$mode objfpc}
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='FPC';
+    Conn.Active:=True;
+    Writeln('Connected !!');
+    Conn.Active:=False;
+    Writeln('Disconnected again');
+  Finally
+    Conn.free;
+  end;
+end.

fcl/db/odbc/testdrcon.pp

@@ -0,0 +1,20 @@
+program testdrcon;
+{$mode objfpc}
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.drivername:='Microsoft Access Driver (*.mdb)';
+    Conn.DriverParams.Add('DBQ=d:\temp\odbc\testodbc.mdb');
+    Conn.Active:=True;
+    Writeln('Connected !!');
+    Conn.Active:=False;
+    Writeln('Disconnected again.');
+  Finally
+    Conn.free;
+  end;
+end.

fcl/db/odbc/testenv.pp

@@ -0,0 +1,45 @@
+program testenv;
+{$mode objfpc}
+{$h+}
+uses fpodbc,Classes;
+
+Var
+  I,J : Integer;
+  List,Options : TStringList;
+  Env : TODBCEnvironment;
+  UseDefault : Boolean;
+
+begin
+   useDefault:=(ParamCount>0) and (Paramstr(1)='-d');
+   If UseDefault then
+     Env:=DefaultEnvironment
+   else
+     Env:=TODBCEnvironment.Create(Nil);
+  try
+    Writeln('Handle is : ',Env.Handle);
+    List:=TStringlist.Create;
+    Options:=TStringList.Create;
+    Writeln('List of drivers :');
+    Env.GetDriverNames(List);
+    Writeln('Count : ',List.Count);
+    For I:=0 to List.Count-1 do
+       Writeln(i:2,' : ',List[i]);
+    Writeln('List of driver options :');
+    For I:=0 to List.Count-1 do
+      begin
+      Env.GetDriverOptions(List[i],Options);
+      Writeln('Options for driver ',List[i],' : ');
+      For J:=0 to Options.Count-1 do
+        Writeln('  ',Options[j]);
+      end;
+    Env.GetDataSourceNames(List,dtBoth,True);
+    Writeln('List of datasource names : ');
+    For I:=0 to List.Count-1 do
+      writeln(i,' : ',List[i]);
+    List.free;
+    options.Free;
+  finally
+    If not UseDefault then
+      env.free;
+  end;
+end.

fcl/db/odbc/testfl.pp

@@ -0,0 +1,29 @@
+program testfl;
+{$mode objfpc}
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+  FieldNames : TStringList;
+  I : Integer;
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='FPC';
+    Conn.Active:=True;
+    FieldNames:=TStringList.Create;
+    FieldNames.Sorted:=True;
+    Try
+      Conn.GetFieldNames('FPDev',FieldNames);
+      Writeln('Found ',FieldNames.Count,' Fields in table FPDev : ');
+      For I:=0 to FieldNames.Count-1 do
+        Writeln(FieldNames[i]);
+    finally
+      FieldNames.Free;
+    end;
+    Conn.Active:=False;
+  Finally
+    Conn.free;
+  end;
+end.

fcl/db/odbc/testpa.pp

@@ -0,0 +1,33 @@
+program testpa;
+{$mode objfpc}
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+  ProcedureParams : TStringList;
+  I : Integer;
+  PT : TODBCParamType;
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='BUGS';
+    Conn.Active:=True;
+    ProcedureParams:=TStringList.Create;
+    ProcedureParams.Sorted:=True;
+    Try
+      For PT:=ptUnknown to ptRetval do
+        begin
+        Conn.GetProcedureParams('GET_BUGID',[Pt],ProcedureParams);
+        Writeln('Found ',ProcedureParams.Count,' parameters of type ',ODBCParamTypeNames[Pt],' :');
+         For I:=0 to ProcedureParams.Count-1 do
+          Writeln(ProcedureParams[i]);
+        end;  
+    finally
+      ProcedureParams.Free;
+    end;
+    Conn.Active:=False;
+  Finally
+    Conn.free;
+  end;
+end.

fcl/db/odbc/testpk.pp

@@ -0,0 +1,29 @@
+program testpl;
+{$mode objfpc}
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+  PrimaryKeyFields : TStringList;
+  I : Integer;
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='BUGS';
+    Conn.Active:=True;
+    PrimaryKeyFields:=TStringList.Create;
+    PrimaryKeyFields.Sorted:=True;
+    Try
+      Conn.GetPrimaryKeyFields('BUGS',PrimaryKeyFields);
+      Writeln('Found ',PrimaryKeyFields.Count,' primary key fields in table BUGS : ');
+      For I:=0 to PrimaryKeyFields.Count-1 do
+        Writeln(PrimaryKeyFields[i]);
+    finally
+      PrimaryKeyFields.Free;
+    end;
+    Conn.Active:=False;
+  Finally
+    Conn.free;
+  end;
+end.

fcl/db/odbc/testpr.pp

@@ -0,0 +1,29 @@
+program testpr;
+{$mode objfpc}
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+  ProcedureNames : TStringList;
+  I : Integer;
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='BUGS';
+    Conn.Active:=True;
+    ProcedureNames:=TStringList.Create;
+    ProcedureNames.Sorted:=True;
+    Try
+      Conn.GetProcedureNames(ProcedureNames);
+      Writeln('Found ',ProcedureNames.Count,' procedures:');
+      For I:=0 to ProcedureNames.Count-1 do
+        Writeln(ProcedureNames[i]);
+    finally
+      ProcedureNames.Free;
+    end;
+    Conn.Active:=False;
+  Finally
+    Conn.free;
+  end;
+end.

fcl/db/odbc/testsql.pp

@@ -0,0 +1,102 @@
+program testsql;
+{$mode objfpc}
+uses fpodbc,Classes,odbcsql;
+
+var
+  Conn : TODBCConnection;
+  St : TODBCSQLStatement;
+  FieldNames : TStringList;
+  I,Count : Integer;
+
+procedure DumpFielddef(F : TODBCField);
+
+begin
+  Writeln('Field ',F.Position,' : ',F.Name);
+  Writeln('Type : ',F.DataType);
+  Writeln('Size : ',F.Size);
+  Writeln('Decimal digits : ',F.DecimalDigits);
+  Writeln('Nullable : ',F.Nullable);
+end;
+
+procedure DumpField(F : TODBCField);
+
+begin
+  With F do
+    begin
+    Write(Name:12,BufType:5,'  ');
+    If IsNull then  
+      Writeln('(Null)')
+    else
+      Case BufType of
+        SQL_Smallint : Writeln(AsInteger);
+        SQL_Integer  : Writeln(AsInteger);
+        SQL_BIT      : Writeln(AsInteger);
+        SQL_CHAR     : Writeln(AsString);
+        SQL_DOUBLE   : Writeln(AsDouble);
+        SQL_DATE,
+        SQL_TIME,
+        SQL_TIMESTAMP,
+        SQL_TYPE_DATE,
+        SQL_TYPE_TIMESTAMP,
+        SQL_TYPE_TIME : Writeln(AsString);
+      else
+        Writeln('Unknown field type');
+      end;
+    end;
+end;
+
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='FPC';
+    Conn.Active:=True;
+    ST:=TODBCSQLStatement.Create(Conn);
+    Try
+      ST.SQL.Text:='Select * from fpdev order by id';
+      Writeln('Opening');
+      ST.Open;
+      Writeln('Opened');
+      Try
+        FieldNames:=TStringList.Create;
+        Try
+        st.GetFieldList(FieldNames);
+        Writeln('Found ',FieldNames.Count,' Fields in result set :');
+        For I:=0 to FieldNames.Count-1 do
+          Writeln(i+1,': ',FieldNames[i]);
+        Writeln('End of list');
+        Writeln('FieldDefs:');
+        with st.fields do
+          for I:=0 to COunt-1 do
+            DumpFielddef(st.fields.items[i] as TODBCField);
+        Writeln('Data dump:');
+        Count:=0;
+        While not st.eof do
+          begin
+          Inc(Count);
+          Writeln('Record no ',Count,' : ');
+          Writeln('Name':12,'Type':5,'  Value');
+          for I:=0 to st.fields.COunt-1 do
+            DumpField(st.fields.items[i] as TODBCField);
+          st.fetch;
+          end;
+        Writeln('End of data');
+        finally
+          FieldNames.Free;
+          Writeln('Freed list');
+        end;
+      Finally
+        st.Close;
+        Writeln('Closed');
+      end;
+    Finally
+      ST.Free;
+      Writeln('Freed statement');
+    end;
+    Conn.Active:=False;
+    Writeln('Disactivated connection');
+  Finally
+    Conn.free;
+    Writeln('Freed Connection');
+  end;
+end.

fcl/db/odbc/testst.pp

@@ -0,0 +1,62 @@
+program testst;
+{$mode objfpc}
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+  St : TODBCSQLStatement;
+  FieldNames : TStringList;
+  I : Integer;
+  PT : TODBCParamType;
+
+procedure DumpFielddef(F : TODBCField);
+
+begin
+  Writeln('Field ',F.Position,' : ',F.Name);
+  Writeln('Type : ',F.DataType);
+  Writeln('Size : ',F.Size);
+  Writeln('Decimal digits : ',F.DecimalDigits);
+  Writeln('Nullable : ',F.Nullable);
+end;
+
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='FPC';
+    Conn.Active:=True;
+    ST:=TODBCSQLStatement.Create(Conn);
+    Try
+      ST.SQL.Text:='Select * from fpdev';
+      ST.Prepare;
+      Try
+        FieldNames:=TStringList.Create;
+        Try
+          st.GetFieldList(FieldNames);
+          Writeln('Found ',FieldNames.Count,' Fields in result set :');
+          For I:=0 to FieldNames.Count-1 do
+            Writeln(i+1,': ',FieldNames[i]);
+          Writeln('End of list');
+          st.bindfields(nil);
+          with st.fields do
+            for I:=0 to COunt-1 do
+              DumpFielddef(st.fields.items[i] as TODBCField);
+        finally
+          FieldNames.Free;
+          Writeln('Freed list');
+        end;
+      Finally
+        St.Unprepare;
+        Writeln('Unprepared');
+      end;
+    Finally
+      ST.Free;
+      Writeln('Freed statement');
+    end;
+    Conn.Active:=False;
+    Writeln('Disactivated connection');
+  Finally
+    Conn.free;
+    Writeln('Freed Connection');
+  end;
+end.

fcl/db/odbc/testtl.pp

@@ -0,0 +1,31 @@
+program testcon;
+
+{$mode objfpc}
+
+uses fpodbc,Classes;
+
+var
+  Conn : TODBCConnection;
+  TableNames : TStringList;
+  I : Integer;
+
+begin
+  Conn:=TODBCConnection.Create(Nil);
+  Try
+    Conn.DSN:='FPC';
+    Conn.Active:=True;
+    TableNames:=TStringList.Create;
+    TableNames.Sorted:=True;
+    Try
+      Conn.GetTableNames(TableNames,True);
+      Writeln('Found ',TableNames.Count,' tables : ');
+      For I:=0 to TableNames.Count-1 do
+        Writeln(TableNames[i]);
+    finally
+      TableNames.Free;
+    end;
+    Conn.Active:=False;
+  Finally
+    Conn.free;
+  end;
+end.