unit U_servmod;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
   DB,   OracleUniProvider, Uni, DBAccess, MemDS, SQLServerUniProvider,
  UniProvider, MySQLUniProvider;  

type
  TDM_Main = class(TDataModule)
    Database1: TUniConnection;
    Query1: TUniQuery;
    MySQLUniProvider1: TMySQLUniProvider;
    OracleUniProvider1: TOracleUniProvider;
    SQLServerUniProvider1: TSQLServerUniProvider;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure FreeDadaBaseMem;
    function GetADOConnectString(user, pass, serv: String): String;
    procedure QueryClose(dataset: TDataset);
    procedure setDatabaseParam(u, p, s: String;dbtype:Integer=0);
  end;

const
  //xxy 2021-12-29 增加缺省端口和客户端程序,并移植为公共常量
  Database_Types:Array[0..2,0..2] Of String= (('1521','1433','3306'),('Oracle','SQL Server','MySQL'),('oci.dll','SQLCMD.EXE','libmysql.dll'));
var
  DM_Main: TDM_Main;

implementation

uses StrUtils;

{$R *.DFM}

procedure TDM_Main.setDatabaseParam(u, p, s: String;dbtype:Integer=0);
var
  i:Integer;
  s1:String;
begin
    Database1.Connected:=false;
    s1 := GetEnvironmentVariable('IsUseOCI');
    i := StrToIntDef(s1,0);
    //Database1.SpecificOptions.Values['Direct'] := IfThen(i <> 1,'true','false');
  Database1.ProviderName := Database_Types[1,dbtype mod length(Database_Types)];
  //i := pos(':',s);
  //设置直接连接
  if dbtype = 1 then
  begin
    Database1.SpecificOptions.Values['Provider'] := IfThen(i>0,'prDirect','prAuto');
  end else begin
    Database1.SpecificOptions.Values['Direct'] := IfThen(i>0,'true','false');
    if dbtype = 0 then  //xxy 2020-02-03 oracle 字符集
    begin
      //Database1.SpecificOptions.Values['UseUnicode'] := 'False';//'True';
      //Database1.SpecificOptions.Values['CharSet'] := 'ZHS16GBK';
    end;
  end;
  //xxy 增加处理端口,否则,sql server 和 mysql带特殊端口的服务器都不能练级
  if dbtype > 0 then
  begin
    s := StringReplace(s,':',',',[rfReplaceAll]);
    i := pos(',',s);
    if i > 0 then
    begin
      s1 := copy(s,i + 1,length(s) - i);
      s := copy(s,1,i - 1);
      i := pos(',',s1);
      if i > 0 then
        s1 := copy(s1,1,i - 1);
    end else
      s1 := Database_Types[0,dbtype];
    //sql server必须采用设置端口的方式,用逗号分隔时,直连方式也不能正常连接
    Database1.Port := StrToIntDef(s1,0); 
  end;

    Database1.Username := u;
    Database1.Password := p;
    Database1.Server := s;

    Database1.Connected:=false;

end;

procedure TDM_Main.QueryClose(dataset: TDataset);
begin
    if not dataset.Active then exit;
    try
      dataset.Close;
    except end;
end;

function TDM_Main.GetADOConnectString(user,pass,serv:String):String;
begin
  Result:='Provider=MSDAORA.1;Persist Security Info=True;'
         +'User ID='+user+';Password='+pass+';Data Source='+serv;
end;

procedure TDM_Main.FreeDadaBaseMem;
begin
  try
  QueryClose(Query1);
  Database1.Connected:=false;
  except end;
end;


procedure TDM_Main.DataModuleCreate(Sender: TObject);
begin
   DM_Main:=self;
end;

end.