{* <PRE>
================================================================================
* Unit Name：UFrmDBInfo
* Version：1.00
* Description：
* Author：LHQ
* Create Date：2006-9-8
* Modified User：
* Modified Date：
* Modified Desc：  Database Information
2008-05-03 LHQ 增加了Oracle数据库下编辑TNSName文件的功能
================================================================================
|</PRE>}
unit UFrmDBInfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls, UDBList, ComCtrls, ShellAPI, Registry,
  Spin, Common, UFoxmailMsgFrm;

type
  TFrmDBInfo = class(TForm)
    bvl: TBevel;
    lblCaption: TLabel;
    lblDesction: TLabel;
    lblDBName: TLabel;
    lblHostName: TLabel;
    lblUserName: TLabel;
    lblPassword: TLabel;
    lblCfgFile: TLabel;
    edtCaption: TEdit;
    edtUserName: TEdit;
    edtPassword: TEdit;
    edtDesction: TEdit;
    edtCfgFile: TEdit;
    btnFind: TBitBtn;
    dlgOpen: TOpenDialog;
    lblPort: TLabel;
    edtConAfterSQL: TEdit;
    edtTimeOut: TEdit;
    lblTimeOut: TLabel;
    btnSave: TBitBtn;
    BitBtn1: TBitBtn;
    btnEdtTNSName: TBitBtn;
    lbl1: TLabel;
    seaPort: TSpinEdit;
    cmbDBName: TComboBox;
    lbl2: TLabel;
    edtSchema: TEdit;
    cbbHost: TComboBox;
    btnClear: TBitBtn;
    procedure btnFindClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure btnCancelClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure btnEdtTNSNameClick(Sender: TObject);
    procedure cmbDBNameDropDown(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
  private
    function ConnectTest: Boolean;
    procedure GetDbList(DBType: TDBType);
    { Private declarations }
  public
    aDBItem: TDBItem;
  end;

implementation

uses UDM;

{$R *.dfm}

procedure TFrmDBInfo.btnFindClick(Sender: TObject);
var
  sList: TStringList;
begin
  if edtCfgFile.Text <> '' then
    dlgOpen.FileName := edtCfgFile.Text
  else
    dlgOpen.FileName := aDBItem.DBName + '.ini';
  dlgOpen.InitialDir := ExtractFileDir(Application.ExeName);
  if dlgOpen.Execute then
  begin
    if not FileExists(dlgOpen.FileName) then
    begin
      edtCfgFile.Text := dlgOpen.FileName;
      sList := TStringList.Create;
      try
        sList.SaveToFile(dlgOpen.FileName);
      finally
        sList.Free;
      end;
    end;
  end;
end;

procedure TFrmDBInfo.btnSaveClick(Sender: TObject);
begin
  if Trim(edtCaption.Text) = '' then
  begin
    ShowMessage('Please Enter Caption Text');
    Exit;
  end;
  aDBItem.Caption := edtCaption.Text;
  aDBItem.HostName := cbbHost.Text;
  try
    if cbbHost.Items.IndexOf(cbbHost.Text) < 0 then
      cbbHost.Items.Add(cbbHost.Text);
    cbbHost.Items.SaveToFile(AppPath + 'HostList.txt');
  except
    SaveLocalLog('保存数据库服务器地址列表出错')
  end;
  aDBItem.DBName := cmbDBName.Text;
  aDBItem.UserName := edtUserName.Text;
  aDBItem.ConAfterSQL := edtConAfterSQL.Text;
  aDBItem.Password := edtPassword.Text;
  aDBItem.Description := edtDesction.Text;
  aDBItem.CfgFile := edtCfgFile.Text;
  aDBItem.HostPort := seaPort.Value;
  aDBItem.SchemaName := edtSchema.Text;
  if (aDBItem.CfgFile <> '') and (not FileExists(aDBItem.CfgFile)) then
  begin //创建这个文件
    with TStringList.Create do
    begin
      try
        SaveToFile(aDBItem.CfgFile);
      finally
        Free;
      end;
    end;
  end;
  ModalResult := mrOK;
end;

procedure TFrmDBInfo.GetDbList(DBType: TDBType);
var
  StrSQL: string;
begin
  if DBType = dbUnknown then
    Exit;
  if DBType = dbPostGreSQL then
    StrSQL := 'select  datname from pg_database';
  if (DBType in [dbSQLSERVER2000, dbSybase]) then
    StrSQL := 'select name from sysdatabases';
  if DBType = dbMySQL then
    StrSQL := 'SELECT SCHEMA_NAME FROM `SCHEMATA`';
  if DBType = dbOracle then
    StrSQL := 'select   name   from   v$database';
  with dmSQL.GetDataSet(StrSQL) do
  begin
    while not eof do
    begin
      cmbDBName.Items.Add(Fields[0].AsString);
      Next;
    end;
    Free;
  end;
end;

function TFrmDBInfo.ConnectTest: Boolean;
var
  CurItem: TDBItem;
begin
  Result := False;
  CurItem := TDBItem.Create(nil);
  try
    CurItem.Driver := LowerCase(aDBItem.Driver);
    CurItem.HostName := Trim(cbbHost.Text);
    CurItem.UserName := Trim(edtUserName.Text);
    CurItem.HostPort := seaPort.Value;
    CurItem.Password := Trim(edtPassword.Text);
    if CurItem.DBType = dbPostGreSQL then
    begin
      if Trim(cmbDBName.Text) = '' then
        CurItem.DBName := 'postgres'
      else
        CurItem.DBName := Trim(cmbDBName.Text);
    end else if CurItem.DBType = dbSQLSERVER2000 then
      CurItem.DBName := 'master'
    else if CurItem.DBType = dbSybase then
      CurItem.DBName := 'master'
    else if CurItem.DBType = dbMySQL then
      CurItem.DBName := 'information_schema'
    else if CurItem.DBType = dbSqlite3 then
      CurItem.DBName := cmbDBName.Items[cmbDBName.ItemIndex]
    else if CurItem.DBType = dbACCESS2000 then
      CurItem.DBName := cmbDBName.Items[cmbDBName.ItemIndex]
    else if CurItem.DBType = dbDB2 then
    begin
      CurItem.DBName := cmbDBName.Text;
    end;
    if dmSQL.ConnectTest(CurItem) then
    begin
      if cmbDBName.Style <> csSimple then
        GetDbList(CurItem.DBType);
      Result := True;
    end else
      Dialogs.ShowMessage('连接数据库异常:异常原因' + #13#10);
  finally
    CurItem.Free;
  end;
end;

procedure TFrmDBInfo.cmbDBNameDropDown(Sender: TObject);
begin
  if cmbDBName.Items.Count < 1 then
    if not ConnectTest then
      ShowMessage('连接服务器出现异常');
end;

procedure TFrmDBInfo.FormShow(Sender: TObject);
begin
  edtCaption.Text := aDBItem.Caption;
  if FileExists(AppPath + 'HostList.txt') then
    cbbHost.Items.LoadFromFile(AppPath + 'HostList.txt');
  cbbHost.Text := aDBItem.HostName;
  cmbDBName.Text := aDBItem.DBName;
  edtUserName.Text := aDBItem.UserName;
  edtPassword.Text := aDBItem.Password;
  edtDesction.Text := aDBItem.Description;
  edtCfgFile.Text := aDBItem.CfgFile;
  seaPort.Value := aDBItem.HostPort;
  edtConAfterSQL.Text := aDBItem.ConAfterSQL;
  if aDBItem.DBType = dbOracle then
  begin
    cmbDBName.Style := csSimple;
  end;
end;

procedure TFrmDBInfo.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    Perform(WM_NEXTDLGCTL, 0, 0);
end;

procedure TFrmDBInfo.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmDBInfo.btnEdtTNSNameClick(Sender: TObject);
var
  ini: TRegistry;
  last_Home, ora_Home: string;
begin
  ini := TRegistry.Create;
  try
    ini.RootKey := HKEY_LOCAL_MACHINE;
    ini.OpenKey('SOFTWARE\ORACLE\ALL_HOMES', False);
    last_Home := ini.ReadString('LAST_HOME');
    ini.CloseKey;
    ini.OpenKey('SOFTWARE\ORACLE\HOME' + last_home, False);
    ora_Home := ini.ReadString('ORACLE_HOME');
    ShellExecute(0, 'open', PChar(ora_home + '\NETWORK\ADMIN\tnsnames.ora'), '', '', SW_NORMAL);
  finally
    ini.Free;
  end;
end;

procedure TFrmDBInfo.BitBtn1Click(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TFrmDBInfo.btnClearClick(Sender: TObject);
begin
  if not YesNoMessage('您确定要清除主机IP地址列表吗？') then
    Exit;
  if FileExists(AppPath + 'HostList.txt') then
  begin
    try
      cbbHost.Items.Clear;
      cbbHost.Items.Add(cbbHost.Text);
      cbbHost.Items.SaveToFile(AppPath + 'HostList.txt');
      ShowInfo('清除成功');
    except
      WarnMessage('清除主机IP地址列表出错');
    end;
  end;
end;

end.