delphi編寫sql指令碼檔案批量執行程式
阿新 • • 發佈：2022-12-12
程式使用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'[email protected]') 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