批量清除SQL Server日志（Delphi版）

unit CLRLOGF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, DscEdit, Buttons, Db, ADODB, Math, ShellAPI;

type
  TfrmCLRLOG = class(TForm)
    pnl01: TPanel;
    grp03: TGroupBox;
    cbo04: TComboBox;
    lbl04: TLabel;
    btn05: TBitBtn;
    btn06: TBitBtn;
    pb07: TProgressBar;
    con08: TADOConnection;
    qry09: TADOQuery;
    qry10: TADOQuery;
    qry11: TADOQuery;
    pnl02: TPanel;
    lbl12: TLabel;
    procedure FormShow(Sender: TObject);
    procedure btn05Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btn06Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCLRLOG: TfrmCLRLOG;

implementation

{$R *.DFM}
procedure TfrmCLRLOG.FormCreate(Sender: TObject);
begin
  //在当前目录新建DB.udl
  if not FileExists('DB.udl') then
  begin
    FileCreate('DB.udl');
  end;
end;

procedure TfrmCLRLOG.FormShow(Sender: TObject);
begin
  //连接数据库并取数据库名称赋给combox
  try
    cbo04.Items.Add('全部');
    cbo04.ItemIndex := 0;
    
    con08.ConnectionString := 'FILE NAME='+ExtractFilePath(Application.ExeName)+'DB.udl';
    con08.Connected;
    
    with qry09 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('SELECT name FROM master..sysdatabases WHERE name not in (''master'', ''model'', ''msdb'', ''tempdb'', ''DCMSMOD'')');
      Prepared;
      Open;
      First;
      
      while not Eof do
      begin
        cbo04.Items.Add(FieldByName('name').AsString);
        
        Next;
      end;      
    end;
  except
    //请配置DB.udl
    ShowMessage('数据库连接失败, 请配置DB.udl');

    //打开配置DB.udl
    //if FileExists('DB.udl') then
    //  ShellExecute(Handle, 'open', PChar(ExtractFilePath(Application.ExeName)+'DB.udl') ,'','',SW_SHOWNORMAL);
    
    //终止程序
    Application.Terminate;
  end;
end;

procedure TfrmCLRLOG.btn05Click(Sender: TObject);
var
  mI: Double;
  mJ: Integer;
begin
  mJ := 0;
  pb07.Position := 0;
  
  //处理指定数据库, 若选择全部则处理所有数据库
  try
    try
      btn05.Enabled := False;
      
      if (cbo04.Text = '全部') then
      begin
        with qry09 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('SELECT name FROM master..sysdatabases WHERE name not in (''master'', ''model'', ''msdb'', ''tempdb'', ''DCMSMOD'') ORDER BY name');
          Prepared;
          Open;
          First;
          
          if (qry09.RecordCount <> 0) then
          begin
            mI := qry09.RecordCount;
            mI := 1000/mI;
            mJ := Ceil(mI);
          end;
          
          while not Eof do
          begin
            lbl12.Caption := '正在处理 '+Trim(qry09.FieldByName('name').AsString);
            Self.Refresh;

            with qry10 do
            begin
              Close;
              SQL.Clear;
              SQL.Add('BACKUP LOG '+Trim(qry09.FieldByName('name').AsString)+' WITH truncate_only');
              SQL.Add('DBCC shrinkdatabase ('+qry09.FieldByName('name').AsString+')');
              Prepared;
              ExecSQL;
            end;

            pb07.Position := pb07.Position + mJ;

            Next;
          end;
        end;
      end
      else
      begin
        lbl12.Caption := '正在处理 '+Trim(cbo04.Text);
        Self.Refresh;

        with qry10 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('BACKUP LOG '+Trim(cbo04.Text)+' WITH truncate_only');
          SQL.Add('DBCC shrinkdatabase ('+Trim(cbo04.Text)+')');
          Prepared;
          ExecSQL;
        end;
      end;
    except
    
    end;
  finally
    btn05.Enabled := True;
    pb07.Position := 1000;
    lbl12.Caption := '处理完成!';
    ShowMessage('日志清除成功!');
  end;

end;

procedure TfrmCLRLOG.btn06Click(Sender: TObject);
begin
  //close
  con08.Connected := False;
end;

end.