delphi编写sql脚本文件批量执行程序

程序使用DelphiXE11.1开发，用到控件UniDac9.1.1，QDAC里面的Qlog组件。

程序实现了SQL脚本文件批处理执行应用，运行效果图。

 

 文件.pas代码

unit main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, IOUtils, System.Generics.Collections,
  System.Generics.Defaults,Winapi.ShellAPI,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  DBAccess, UniDacVcl,
  OracleUniProvider, SQLServerUniProvider, Data.DB, Uni, Vcl.ComCtrls,
  Vcl.ExtCtrls, Vcl.CheckLst, Vcl.StdCtrls, DAScript, UniScript, DASQLMonitor,
  UniSQLMonitor,qlog, MemDS;

type
  TfrmMain = class(TForm)
    con1: TUniConnection;
    uncnctdlg1: TUniConnectDialog;
    stat1: TStatusBar;
    lst_script: TCheckListBox;
    pnlTop: TPanel;
    btn_Connect: TButton;
    btn_Refresh: TButton;
    mmo1: TMemo;
    spl1: TSplitter;
    btn_Exec: TButton;
    unscrpt1: TUniScript;
    unsqlmntr1: TUniSQLMonitor;
    pgc1: TPageControl;
    ts1: TTabSheet;
    ts2: TTabSheet;
    mmo2: TMemo;
    ts3: TTabSheet;
    mmo_note: TMemo;
    btn_ViewLog: TButton;
    unqry1: TUniQuery;
    procedure btn_ConnectClick(Sender: TObject);
    procedure btn_RefreshClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btn_ExecClick(Sender: TObject);
    procedure unsqlmntr1SQL(Sender: TObject; Text: string; Flag: TDATraceFlag);
    procedure unscrpt1Error(Sender: TObject; E: Exception; SQL: string;
      var Action: TErrorAction);
    procedure unscrpt1AfterExecute(Sender: TObject; SQL: string);
    procedure unscrpt1BeforeExecute(Sender: TObject; var SQL: string;
      var Omit: Boolean);
    procedure btn_ViewLogClick(Sender: TObject);
  private
    sprInfo:string;
    execOK: Boolean;
    execDuration: Cardinal;
    iTotalCount:Integer; //总共运行了多少次脚本
    iErrCount:Integer; //总共运行了多少次脚本
    procedure ExecOneScript(sqlFile: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}


procedure TfrmMain.FormShow(Sender: TObject);
begin
  pgc1.ActivePageIndex := 0;
  btn_Refresh.Click;
end;

procedure TfrmMain.unscrpt1AfterExecute(Sender: TObject; SQL: string);
begin
//  mmo2.Lines.Add('after------'execDuration.ToString);
  if (iTotalCount>0) and execOK then
  begin
    execDuration := (GetTickCount - execDuration);
    sprInfo:= '耗时:' + FloatToStr(execDuration/1000) + '秒,影响行数' + unqry1.RowsAffected.ToString;
    PostLog(llMessage,sprInfo);
    mmo2.Lines.Add(sprInfo);
  end;
end;

procedure TfrmMain.unscrpt1BeforeExecute(Sender: TObject; var SQL: string;
  var Omit: Boolean);
begin
//  mmo2.Lines.Add('before------'GetTickCount.ToString);
  Inc(iTotalCount);
  execDuration := GetTickCount;
end;

procedure TfrmMain.unscrpt1Error(Sender: TObject; E: Exception; SQL: string;
  var Action: TErrorAction);
begin
  Action := eaContinue;
end;

procedure TfrmMain.unsqlmntr1SQL(Sender: TObject; Text: string;
  Flag: TDATraceFlag);
begin
  case Flag of
    tfQExecute:
      begin
        PostLog(llMessage,'SQL>:');
        mmo2.Lines.Add('SQL>:');
        execOK := True;
      end;
    tfError:
      begin
        Inc(iErrCount);
        execOK := False;
      end;
  end;
  PostLog(llMessage,Text);
  mmo2.Lines.Add(Text);
end;

// 连接到数据库
procedure TfrmMain.btn_ConnectClick(Sender: TObject);
begin
  con1.ConnectDialog.Execute;
  if con1.Connected then
    stat1.Panels[0].Text := '数据库连接成功!';
end;

// 执行脚本
procedure TfrmMain.btn_ExecClick(Sender: TObject);
var
  i, iCount: integer;
  sLogPath: string;
begin
//日志准备,创建日志输出,10M后自动压缩
  sLogPath := ExtractFilePath(ParamStr(0))+'Logs\'; // 结尾有斜杠
  SetDefaultLogFile(sLogPath + FormatDateTime('yyyymmdd_hhnnss',Now) +'execute.log', 10242880);
//开始执行
  iCount := 0;
  mmo2.Lines.Clear;
  iCount := 0;
  for i := 0 to lst_script.Items.Count - 1 do
    begin
      if lst_script.Checked[i] then
        Inc(iCount);
    end;
  if iCount = 0 then
    begin
      Application.MessageBox('请选择要执行的脚本', '提示', MB_ICONSTOP);
      Exit;
    end;
  if not con1.Connected then
    begin
      Application.MessageBox('请先连接数据库', '提示', MB_ICONSTOP);
      Exit;
    end;
  i := Application.MessageBox(PWideChar('共选中【' + iCount.ToString + '】脚本个,确定执行吗?'), '提示', MB_YESNO);
  if (i <> ID_YES) then
    Exit;
  // 逐个执行脚本
  for i := 0 to lst_script.Items.Count - 1 do
    begin
      if lst_script.Checked[i] then
        ExecOneScript(lst_script.Items[i]);
    end;
  mmo1.Text := '执行已完成.运行次数'+iTotalCount.ToString+',忽略错误次数'+iErrCount.ToString;
end;

// 刷新脚本文件
procedure TfrmMain.btn_RefreshClick(Sender: TObject);
var
  files: TArray<string>;
  path: string;
  str: string;
  iChk: integer;
begin
  path := ExtractFilePath(ParamStr(0));
  files := TDirectory.GetFiles(path, '*.sql', TSearchOption.soAllDirectories);
  TArray.Sort<string>(files);
  lst_script.Items.BeginUpdate;
  try
    lst_script.Items.Clear;
    for str in files do
      lst_script.Items.Add(str);
  finally
    lst_script.Items.EndUpdate;
  end;
  lst_script.CheckAll(cbChecked, False, False);
end;

//查看日志文件
procedure TfrmMain.btn_ViewLogClick(Sender: TObject);
var
  sPath:string;
begin
  sPath:=ExtractFilePath(ParamStr(0))+'Logs';
  ShellExecute(Handle,'open','Explorer.exe',PChar(sPath),nil,1);
end;

// 执行一个脚本文件
procedure TfrmMain.ExecOneScript(sqlFile: string);
var
  i: integer;
  sCaption:string;
begin
  stat1.Panels[0].Text := sqlFile;
  sCaption:='------------>>>>>>'+sqlFile;
  mmo2.Lines.Add(sCaption);
  PostLog(llMessage,sCaption);
  unscrpt1.SQL.LoadFromFile(sqlFile, TEncoding.UTF8);
  for i := 0 to unscrpt1.Statements.Count - 1 do
    begin
      mmo1.Text := unscrpt1.Statements[i].SQL;
      Application.ProcessMessages;
      unscrpt1.ExecuteNext;
    end;
end;

end.

From表单文件代码

object frmMain: TfrmMain
  Left = 0
  Top = 0
  BorderStyle = bsSingle
  Caption = 'SQL'#33050#26412#25191#34892#21161#25163'V1.0(20221212)'
  ClientHeight = 730
  ClientWidth = 1181
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -15
  Font.Name = #24494#36719#38597#40657
  Font.Style = []
  Position = poScreenCenter
  OnShow = FormShow
  TextHeight = 20
  object stat1: TStatusBar
    Left = 0
    Top = 703
    Width = 1181
    Height = 27
    Panels = <
      item
        Width = 50
      end>
    ParentFont = True
    UseSystemFont = False
  end
  object pnlTop: TPanel
    Left = 0
    Top = 0
    Width = 1181
    Height = 52
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 0
    object btn_Connect: TButton
      Left = 131
      Top = 5
      Width = 103
      Height = 41
      Caption = #36830#25509#25968#25454#24211
      TabOrder = 1
      OnClick = btn_ConnectClick
    end
    object btn_Refresh: TButton
      Left = 12
      Top = 5
      Width = 109
      Height = 41
      Caption = #21047#26032#33050#26412#30446#24405
      TabOrder = 0
      OnClick = btn_RefreshClick
    end
    object btn_Exec: TButton
      Left = 239
      Top = 5
      Width = 103
      Height = 41
      Caption = #24320#22987#25191#34892
      TabOrder = 2
      OnClick = btn_ExecClick
    end
    object btn_ViewLog: TButton
      Left = 367
      Top = 5
      Width = 103
      Height = 41
      Caption = #26597#30475#26085#24535#25991#20214
      TabOrder = 3
      OnClick = btn_ViewLogClick
    end
  end
  object pgc1: TPageControl
    Left = 0
    Top = 52
    Width = 1181
    Height = 651
    ActivePage = ts1
    Align = alClient
    TabOrder = 2
    object ts1: TTabSheet
      Caption = #25191#34892#33050#26412
      object spl1: TSplitter
        Left = 0
        Top = 413
        Width = 1173
        Height = 5
        Cursor = crVSplit
        Align = alBottom
        ExplicitTop = 412
      end
      object lst_script: TCheckListBox
        Left = 0
        Top = 0
        Width = 1173
        Height = 413
        Align = alClient
        ItemHeight = 20
        TabOrder = 0
      end
      object mmo1: TMemo
        Left = 0
        Top = 418
        Width = 1173
        Height = 198
        Align = alBottom
        ReadOnly = True
        TabOrder = 1
      end
    end
    object ts2: TTabSheet
      Caption = #26085#24535#36755#20986
      ImageIndex = 1
      object mmo2: TMemo
        Left = 0
        Top = 0
        Width = 1173
        Height = 616
        Align = alClient
        ReadOnly = True
        ScrollBars = ssBoth
        TabOrder = 0
      end
    end
    object ts3: TTabSheet
      Caption = #20351#29992#35828#26126
      ImageIndex = 2
      object mmo_note: TMemo
        Left = 0
        Top = 0
        Width = 1173
        Height = 616
        Align = alClient
        Lines.Strings = (
          '1'#12289'SQL'#33050#26412#38656#20026'UTF-8'#25991#20214#32534#30721#26684#24335#65292#23558#24453#25191#34892#33050#26412#25918#21040#31243#24207#21516#30446#24405#20013#65292#24182#25353#29031#25191#34892#39034#24207#21629#21517#12290
          '2'#12289'create,declare'#31561#27492#31867#35821#21477#22359#20195#30721#27573','#26411#34892#38656#29992'/'#32467#26463#12290
          '3'#12289#25191#34892#36807#31243#26377#26085#24535#36755#20986#65292#22914#26377#38169#35823#21457#29983#20250#34987#24573#30053#32487#32493#25191#34892#21518#38754#35821#21477#12290
          '4'#12289#31243#24207#20026#21333#32447#31243#25191#34892#65292#25191#34892#32791#26102#38271#30340#33050#26412#20250#20986#29616#30028#38754#21345#30340#24773#20917#65292#31561#24453#33050#26412#25191#34892#32467#26463#12290
          ''
          #38382#39064#21453#39304#65306'lybingyu@qq.com')
        ReadOnly = True
        ScrollBars = ssBoth
        TabOrder = 0
      end
    end
  end
  object con1: TUniConnection
    ProviderName = 'Oracle'
    SpecificOptions.Strings = (
      'Oracle.Direct=True')
    Server = '127.0.0.1:1521:orcl'
    ConnectDialog = uncnctdlg1
    LoginPrompt = False
    Left = 62
    Top = 112
  end
  object uncnctdlg1: TUniConnectDialog
    DatabaseLabel = #25968#25454#24211
    PortLabel = #31471#21475
    ProviderLabel = #25968#25454#24211#21378#21830
    Caption = #36830#25509#21040#25968#25454#24211'...'
    UsernameLabel = #29992#25143#21517
    PasswordLabel = #23494#30721
    ServerLabel = #26381#21153#22120
    ConnectButton = #36830#25509
    CancelButton = #21462#28040
    LabelSet = lsCustom
    Left = 155
    Top = 143
  end
  object unscrpt1: TUniScript
    BeforeExecute = unscrpt1BeforeExecute
    AfterExecute = unscrpt1AfterExecute
    OnError = unscrpt1Error
    AutoCommit = True
    Connection = con1
    DataSet = unqry1
    Left = 272
    Top = 136
  end
  object unsqlmntr1: TUniSQLMonitor
    OnSQL = unsqlmntr1SQL
    Left = 444
    Top = 173
  end
  object unqry1: TUniQuery
    Connection = con1
    Left = 340
    Top = 259
  end
end