main.pas

导出ORACLE 8/9系列的表空间结构并打印

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SUIImagePanel, Grids, DBGridEh, DB, Ora, MemDS, VirtualTable,
  ExtCtrls, SUIForm, SUIButton, DBAccess, OdacVcl, SUIDlg, ImgList,
  ComCtrls, SUIStatusBar, Menus, SUIPopupMenu, SUIThemes, StdCtrls,
  SUIListBox, DBGrids, SUIDBCtrls, DBGridEhImpExp, FR_DSet, FR_DBSet,
  FR_Class, SUIGroupBox, ToolWin, SUIToolBar, ActnList;

type
  TFrmExportTbl = class(TForm)
    suiForm1: TsuiForm;
    suiMessageDialog1: TsuiMessageDialog;
    ImageList1: TImageList;
    suiStatusBar1: TsuiStatusBar;
    suiPopupMenu1: TsuiPopupMenu;
    Pop_Interface1: TMenuItem;
    Pop_Interface2: TMenuItem;
    Pop_Interface3: TMenuItem;
    Pop_Interface4: TMenuItem;
    Pop_Interface5: TMenuItem;
    frReport1: TfrReport;
    Splitter1: TSplitter;
    suiGroupBox1: TsuiGroupBox;
    DBGridEh1: TDBGridEh;
    suiGroupBox2: TsuiGroupBox;
    DBGridEh2: TDBGridEh;
    frDBDataSet_Table: TfrDBDataSet;
    frDBDataSet_Column: TfrDBDataSet;
    ActionList1: TActionList;
    Connect: TAction;
    DisConnect: TAction;
    GetStruct: TAction;
    PrintStruct: TAction;
    About: TAction;
    MyHelp: TAction;
    suiToolBar1: TsuiToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    Exit: TAction;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure Pop_Interface1Click(Sender: TObject);
    procedure Pop_Interface2Click(Sender: TObject);
    procedure Pop_Interface3Click(Sender: TObject);
    procedure Pop_Interface4Click(Sender: TObject);
    procedure Pop_Interface5Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure frReport1GetValue(const ParName: String;
      var ParValue: Variant);
    procedure ConnectExecute(Sender: TObject);
    procedure DisConnectExecute(Sender: TObject);
    procedure GetStructExecute(Sender: TObject);
    procedure PrintStructExecute(Sender: TObject);
    procedure ExitExecute(Sender: TObject);
    procedure AboutExecute(Sender: TObject);
    procedure MyHelpExecute(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmExportTbl: TFrmExportTbl;

implementation

uses SelectTable, DataModule, PubUnit, Preview, About, Login;

{$R *.dfm}

procedure TFrmExportTbl.FormCreate(Sender: TObject);
begin
  SysPath := ExtractFilePath(Application.ExeName);
  ReadIni();
  ChangeInterFace(Self,suiForm1);
end;

procedure TFrmExportTbl.Pop_Interface1Click(Sender: TObject);
begin
  P_Interface := Ord(BlueGlass);
  ChangeInterface(Self,suiForm1);
end;

procedure TFrmExportTbl.Pop_Interface2Click(Sender: TObject);
begin
  P_Interface := Ord(DeepBlue);
  ChangeInterface(Self,suiForm1);
end;

procedure TFrmExportTbl.Pop_Interface3Click(Sender: TObject);
begin
  P_Interface := Ord(Protein);
  ChangeInterface(Self,suiForm1);
end;

procedure TFrmExportTbl.Pop_Interface4Click(Sender: TObject);
begin
  P_Interface := Ord(MacOS);
  ChangeInterface(Self,suiForm1);
end;

procedure TFrmExportTbl.Pop_Interface5Click(Sender: TObject);
begin
  P_Interface := Ord(WinXP);
  ChangeInterface(Self,suiForm1);
end;

procedure TFrmExportTbl.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  WriteIni();
end;

procedure TFrmExportTbl.frReport1GetValue(const ParName: String;
  var ParValue: Variant);
begin
  if ParName = 'Ver' then
     ParValue := OraVer
  else if ParName = 'ServerName' then
     ParValue := ServerName
  else if ParName = 'DBName' then
     ParValue := DBName
  else if ParName = 'UserName' then
     ParValue := UserName ;
end;

procedure TFrmExportTbl.ConnectExecute(Sender: TObject);
var Str : String;
    iPos : Integer ;
    FrmLogin : TFrmLogin ;
begin
  UserName := DataModule1.OraSession1.Username ;
  Password := DataModule1.OraSession1.Password ;
  Str := DataModule1.oraSession1.Server ;
  iPos := AnsiPos('::',Str);
  if iPos > 0 then
  begin
    ServerName := Copy(Str,1,iPos-1);
    DBName := Copy(Str,iPos+2,Length(Str)-iPos-1);
  end
  else
  begin
    ServerName := '';
    DBName := '';
  end;
  LoginModalResult := mrCancel ;
  FrmLogin := TFrmLogin.Create(self);
  FrmLogin.ShowModal ;
  FrmLogin.Free ;
  if LoginModalResult = mrCancel then Abort ;
  DataModule1.OraSession1.Username := UserName;
  DataModule1.OraSession1.Password := Password;
  DataModule1.OraSession1.Server := ServerName+'::'+DBName ;
  try
    DataModule1.oraSession1.Connected := true ;
    OraVer := DataModule1.OraSession1.OracleVersion ;
    UserName := DataModule1.oraSession1.Username ;
    suiStatusBar1.Panels[0].Text := 'ORACLE版本：'+OraVer ;
    suiStatusBar1.Panels[1].Text := '服务器：'+ServerName;
    suiStatusBar1.Panels[2].Text := '数据库：'+DBName;
    suiStatusBar1.Panels[3].Text := '登录用户：'+UserName ;
    with DataModule1.VirtualTable1 do
    begin
      Active := true ;
      while RecordCount > 0 do Delete ;
    end;    // while
    GetStruct.Enabled := true ;
    PrintStruct.Enabled := true ;
    DisConnect.Enabled := true ;
    Connect.Enabled := false ;
  except
    on E : Exception do
      with suiMessageDialog1 do
      begin
        ButtonCount := 1;
        Button1Caption := '确定';
        IconType := suiStop ;
        Caption := '数据库连接错误';
        Text := '错误信息：'+E.Message ;
      end;
  end;
end;

procedure TFrmExportTbl.DisConnectExecute(Sender: TObject);
begin
    DataModule1.oraSession1.Disconnect ;
    suiStatusBar1.Panels[0].Text := 'ORACLE版本：' ;
    suiStatusBar1.Panels[1].Text := '服务器：' ;
    suiStatusBar1.Panels[2].Text := '数据库：' ;
    suiStatusBar1.Panels[3].Text := '登录用户：' ;
    DataModule1.VirtualTable1.Active := false ;
    GetStruct.Enabled := false ;
    PrintStruct.Enabled := false ;
    DisConnect.Enabled := false ;
    Connect.Enabled := true ;
end;

procedure TFrmExportTbl.GetStructExecute(Sender: TObject);
var FrmSelTbl : TFrmSelTbl ;
begin
  FrmSelTbl := TFrmSelTbl.Create(self);
  FrmSelTbl.ShowModal ;
  FrmSelTbl.Free ;
end;

procedure TFrmExportTbl.PrintStructExecute(Sender: TObject);
var
  Report: TfrReport;
  FrmPreview : TFrmPreview;
begin
  Report := frReport1;
  Report.LoadFromFile(SysPath + 'prt\TblStruct.frf');
  FrmPreview := TFrmPreview.Create(self);
  Report.Preview := FrmPreview.frPreview1;
  if Report.PrepareReport then
  begin
    Report.ShowPreparedReport;
    FrmPreview.ShowModal;
  end;
  FrmPreview.Free ;
end;

procedure TFrmExportTbl.ExitExecute(Sender: TObject);
begin
  Close ;
end;

procedure TFrmExportTbl.AboutExecute(Sender: TObject);
var FrmAbout : TFrmAbout ;
begin
  FrmAbout := TFrmAbout.Create(self);
  FrmAbout.ShowModal ;
  FrmAbout.Free ; 
end;

procedure TFrmExportTbl.MyHelpExecute(Sender: TObject);
begin
  suiMessageDialog1.ButtonCount := 1;
  suiMessageDialog1.Button1Caption := '确定';
  suiMessageDialog1.IconType := suiWarning ;
  suiMessageDialog1.Caption := '未找到';
  suiMessageDialog1.Text := '系统未找到相关的帮助主题！';
  suiMessageDialog1.ShowModal ;
end;

end.