* SQL DB loader implemented

git-svn-id: trunk@22163 -

.gitattributes

@@ -1884,6 +1884,8 @@ packages/fcl-db/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
 packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain
+packages/fcl-db/examples/loadlibdemo.lpi svneol=native#text/plain
+packages/fcl-db/examples/loadlibdemo.pp svneol=native#text/plain
 packages/fcl-db/examples/pqeventstest.pp svneol=native#text/plain
 packages/fcl-db/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/Dataset.txt svneol=native#text/plain
@@ -2066,6 +2068,7 @@ packages/fcl-db/src/sqldb/postgres/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/pqconnection.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqldb.pp svneol=native#text/plain
+packages/fcl-db/src/sqldb/sqldblib.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp svneol=native#text/plain

packages/fcl-db/examples/loadlibdemo.lpi

@@ -0,0 +1,79 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="loadlibdemo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="loadlibdemo.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="loadlibdemo"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="../src/sqldb/sqldblib.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="sqldblib"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="loadlibdemo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../units/$(TargetCPU)-$(TargetOS)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Other>
+      <CompilerMessages>
+        <MsgFileName Value=""/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/loadlibdemo.pp

@@ -0,0 +1,86 @@
+program loadlibdemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  sysutils, Classes, sqldb,sqldblib,
+  pqconnection,
+  ibconnection,
+  mysql55conn,
+  mysql51conn,
+  mysql50conn,
+  mysql41conn,
+  mysql40conn;
+
+Procedure List;
+
+Var
+  S : TStringList;
+  I : Integer;
+
+begin
+  S:=TStringList.Create;
+  try
+    getConnectionList(S);
+    Writeln('Available connection types:');
+    For I:=0 to S.Count-1 do
+      Writeln(S[i],', Default library name: ',GetConnectionDef(S[i]).DefaultLibraryName);
+  finally
+    S.free;
+  end;
+end;
+
+Procedure LoadLib(CT,LN : String);
+
+Var
+  D : String;
+
+begin
+  With TSQLDBLibraryLoader.Create(Nil) do
+    try
+      ConnectionType:=CT;
+      D:=LibraryName;
+      if (LN<>'') then
+        LibraryName:=LN;
+      Writeln('Loading library for connector',ct,' (default: ',D,', actual:', LibraryName,')');
+      try
+        LoadLibrary;
+      except
+        On E : Exception do
+          begin
+          Writeln('Error loading library : ',E.Message);
+          Exit;
+          end;
+      end;
+      Writeln('UnLoading library for connector',ct,' (default: ',D,', actual:', LibraryName,')');
+      try
+        UnLoadLibrary;
+      except
+        On E : Exception do
+          Writeln('Error unloading library : ',E.Message);
+      end;
+    finally
+      Free;
+    end;
+end;
+
+begin
+  if (ParamCount<1) or (paramcount>2) then
+    begin
+    Writeln('Usage : ');
+    Writeln('loadlibdemo list');
+    Writeln('  - lists all connection types');
+    Writeln('loadlibdemo conntype');
+    Writeln('  - Load default library for given connection type');
+    Writeln('loadlibdemo conntype libname');
+    Writeln('  - Load alternative library for given connection type');
+    end
+  else if (ParamStr(1)='list') then
+    List
+  else
+    LoadLib(Paramstr(1),ParamStr(2));
+end.
+

packages/fcl-db/fpmake.pp

@@ -690,6 +690,11 @@ begin
           AddUnit('bufdataset');
           AddUnit('dbconst');
         end;
+    T:=P.Targets.AddUnit('sqldblib.pp');
+      with T.Dependencies do
+        begin
+          AddUnit('sqldb');
+        end;
     T:=P.Targets.AddUnit('sqlite3conn.pp', SqldbConnectionOSes);
       with T.Dependencies do
         begin

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -118,6 +118,9 @@ type
     Class Function TypeName : String; override;
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function Description : String; override;
+    Class Function DefaultLibraryName : String; override;
+    Class Function LoadFunction : TLibraryLoadFunction; override;
+    Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
   end;
                   
 implementation
@@ -1433,6 +1436,24 @@ begin
   Result:='Connect to Firebird/Interbase directly via the client library';
 end;
 
+class function TIBConnectionDef.DefaultLibraryName: String;
+begin
+  If UseEmbeddedFirebird then
+    Result:=fbembedlib
+  else
+    Result:=fbclib
+end;
+
+class function TIBConnectionDef.LoadFunction: TLibraryLoadFunction;
+begin
+  Result:=@InitialiseIBase60;
+end;
+
+class function TIBConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
+begin
+  Result:=@ReleaseIBase60
+end;
+
 initialization
   RegisterConnection(TIBConnectionDef);
 

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -143,6 +143,9 @@ Type
     Class Function TypeName : String; override;
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function Description : String; override;
+    Class Function DefaultLibraryName : String; override;
+    Class Function LoadFunction : TLibraryLoadFunction; override;
+    Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
   end;
 
 
@@ -1180,6 +1183,21 @@ begin
   Result:='Connect to a MySQL '+MySQLVersion+'database directly via the client library';
 end;
 
+class function TMySQLConnectionDef.DefaultLibraryName: String;
+begin
+  Result:=mysqlvlib;
+end;
+
+class function TMySQLConnectionDef.LoadFunction: TLibraryLoadFunction;
+begin
+  Result:=@initialisemysql;
+end;
+
+class function TMySQLConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
+begin
+  Result:=@ReleaseMySQL;
+end;
+
 {$IfDef mysql55}
   initialization
     RegisterConnection(TMySQL55ConnectionDef);

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -85,6 +85,9 @@ type
     Class Function TypeName : String; override;
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function Description : String; override;
+    Class Function DefaultLibraryName : String; override;
+    Class Function LoadFunction : TLibraryLoadFunction; override;
+    Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
   end;
 
   EPQDatabaseError = class(EDatabaseError)
@@ -1075,6 +1078,33 @@ begin
   Result:='Connect to a PostGreSQL database directly via the client library';
 end;
 
+class function TPQConnectionDef.DefaultLibraryName: String;
+begin
+  {$IfDef LinkDynamically}
+  Result:=pqlib;
+  {$else}
+  result:='';
+  {$endif}
+end;
+
+class function TPQConnectionDef.LoadFunction: TLibraryLoadFunction;
+begin
+  {$IfDef LinkDynamically}
+  Result:=@InitialisePostgres3;
+  {$else}
+  result:=Nil;
+  {$endif}
+end;
+
+class function TPQConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
+begin
+  {$IfDef LinkDynamically}
+  Result:=@ReleasePostgres3;
+  {$else}
+  result:=Nil;
+  {$endif}
+end;
+
 initialization
   RegisterConnection(TPQConnectionDef);
 finalization

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

@@ -474,11 +474,15 @@ type
   TSQLConnectionClass = Class of TSQLConnection;
 
   { TConnectionDef }
-
+  TLibraryLoadFunction = Function (Const S : ShortString) : Integer;
+  TLibraryUnLoadFunction = Procedure;
   TConnectionDef = Class(TPersistent)
     Class Function TypeName : String; virtual;
     Class Function ConnectionClass : TSQLConnectionClass; virtual;
     Class Function Description : String; virtual;
+    Class Function DefaultLibraryName : String; virtual;
+    Class Function LoadFunction : TLibraryLoadFunction; virtual;
+    Class Function UnLoadFunction : TLibraryUnLoadFunction; virtual;
     Procedure ApplyParams(Params : TStrings; AConnection : TSQLConnection); virtual;
   end;
   TConnectionDefClass = class of TConnectionDef;
@@ -2223,6 +2227,21 @@ begin
   Result:='';
 end;
 
+class function TConnectionDef.DefaultLibraryName: String;
+begin
+  Result:='';
+end;
+
+class function TConnectionDef.LoadFunction: TLibraryLoadFunction;
+begin
+  Result:=Nil;
+end;
+
+class function TConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
+begin
+  Result:=Nil;
+end;
+
 procedure TConnectionDef.ApplyParams(Params: TStrings;
   AConnection: TSQLConnection);
 begin

packages/fcl-db/src/sqldb/sqldblib.pp

@@ -0,0 +1,129 @@
+unit sqldblib;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, sqldb;
+
+Type
+
+  { TSQLDBLibraryLoader }
+
+  TSQLDBLibraryLoader = Class(TComponent)
+  private
+    FCtype: String;
+    FEnabled: Boolean;
+    FLibraryName: String;
+    procedure CheckDisabled;
+    procedure SetCype(AValue: String);
+    procedure SetEnabled(AValue: Boolean);
+    procedure SetLibraryName(AValue: String);
+  Protected
+    Function GetConnectionDef : TConnectionDef;
+    Procedure Loaded; override;
+    Procedure SetDefaultLibraryName; virtual;
+  Public
+    Procedure LoadLibrary;
+    Procedure UnloadLibrary;
+  Published
+    Property Enabled : Boolean Read FEnabled Write SetEnabled;
+    Property ConnectionType : String Read FCtype Write SetCype;
+    Property LibraryName : String Read FLibraryName Write SetLibraryName;
+  end;
+
+implementation
+
+Resourcestring
+   SErrConnnected = 'This operation is not allowed while the datatabase is loaded';
+   SErrInvalidConnectionType = 'Invalid connection type : "%s"';
+{ TSQLDBLibraryLoader }
+
+procedure TSQLDBLibraryLoader.CheckDisabled;
+
+begin
+  If Enabled then
+    DatabaseError(SErrConnnected,Self);
+end;
+
+procedure TSQLDBLibraryLoader.SetCype(AValue: String);
+begin
+  if FCtype=AValue then Exit;
+  CheckDisabled;
+  FCtype:=AValue;
+  if (FCType<>'') then
+    SetDefaultLibraryName;
+end;
+
+procedure TSQLDBLibraryLoader.SetEnabled(AValue: Boolean);
+begin
+  if FEnabled=AValue then Exit;
+  if (csLoading in ComponentState) then
+    FEnabled:=AValue
+  else
+    If AValue then
+      LoadLibrary
+    else
+      UnloadLibrary;
+end;
+
+procedure TSQLDBLibraryLoader.SetLibraryName(AValue: String);
+begin
+  if FLibraryName=AValue then Exit;
+  CheckDisabled;
+  FLibraryName:=AValue;
+end;
+
+function TSQLDBLibraryLoader.GetConnectionDef: TConnectionDef;
+begin
+  Result:=sqldb.GetConnectionDef(ConnectionType);
+  if (Result=Nil) then
+    DatabaseErrorFmt(SErrInvalidConnectionType,[FCTYpe],Self)
+end;
+
+procedure TSQLDBLibraryLoader.Loaded;
+begin
+  inherited;
+  If FEnabled and (FCType<>'') and (FLibraryName<>'') then
+    LoadLibrary;
+end;
+
+procedure TSQLDBLibraryLoader.SetDefaultLibraryName;
+Var
+  D : TConnectionDef;
+begin
+  D:=GetConnectionDef;
+  LibraryName:=D.DefaultLibraryName;
+end;
+
+procedure TSQLDBLibraryLoader.LoadLibrary;
+
+Var
+  D : TConnectionDef;
+  l : TLibraryLoadFunction;
+
+begin
+  D:=GetConnectionDef;
+  L:=D.LoadFunction();
+  if (L<>Nil) then
+    L(LibraryName);
+  FEnabled:=True;
+end;
+
+procedure TSQLDBLibraryLoader.UnloadLibrary;
+
+Var
+  D : TConnectionDef;
+  l : TLibraryUnLoadFunction;
+
+begin
+  D:=GetConnectionDef;
+  L:=D.UnLoadFunction;
+  if L<>Nil then
+    L;
+  FEnabled:=False;
+end;
+
+end.
+