⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 untmain.pas

📁 SQL Server数据库日志清理工具 SQL Server数据库日志清理工具
💻 PAS
字号:
unit UntMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComObj, ADODB;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    BtnOk: TButton;
    BtnExit: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Chk: TCheckBox;
    CmbServer: TComboBox;
    EdtUid: TEdit;
    EdtPwd: TEdit;
    CmbDb: TComboBox;
    CmbLog: TComboBox;
    EdtLogPath: TEdit;
    EdtLogSize: TEdit;
    Label11: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label1: TLabel;
    procedure BtnExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CmbServerClick(Sender: TObject);
    Function ConnSql(Var adoConn : TadoConnection;Server,Db,Uid,Pwd : string) : Boolean;
    procedure FormDestroy(Sender: TObject);
    procedure CmbDbDropDown(Sender: TObject);
    procedure CmbDbClick(Sender: TObject);
    procedure CmbLogChange(Sender: TObject);
    procedure BtnOkClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation
Var
    Cn : TadoConnection;

{$R *.dfm}

Function TFrmMain.ConnSql(Var adoConn : TadoConnection;Server,Db,Uid,Pwd : string) : Boolean;
begin
    if adoConn.Connected then
        adoConn.Close;
    adoConn.ConnectionString := 'provider=sqloledb;Server='+Server+';DataBase='+Db+';Uid='+Uid+';Pwd='+Pwd;
    Try
        adoConn.Open;
        if adoConn.Connected then
            Result := True
        Else
            Result := False;
    Except
        Result := False;
    End;
End;

procedure TFrmMain.BtnExitClick(Sender: TObject);
begin
    Close;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
    SQLServer:Variant;
    ServerList:Variant;
    i,nServers:integer;
begin
    Cn := TadoConnection.Create(Self);
    Try
        begin
            SQLServer := CreateOleObject('SQLDMO.Application');
            ServerList:= SQLServer.ListAvailableSQLServers;
            nServers:=ServerList.Count;
            for i := 1 to nservers do
                CmbServer.Items.Add(ServerList.Item(i));
            if CmbServer.Items.Count <> 0 then
                CmbServer.ItemIndex := 0;
        end
    Except

    End;
end;

procedure TFrmMain.CmbServerClick(Sender: TObject);
begin
    EdtPwd.Text := '';
    CmbDb.Items.Clear;
    CmbDb.ItemIndex := -1;
    CmbLog.Items.Clear;
    CmbLog.ItemIndex := -1;
    EdtLogPath.Text := '';
    EdtLogSize.Text := '';
    Cn.Close;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
    Cn.Close;
    Cn.Free;
end;

procedure TFrmMain.CmbDbDropDown(Sender: TObject);
Var
    Ds : TadoDataSet;
    i : Integer;
begin
    CmbDB.Items.Clear;
    if ConnSql(Cn,CmbServer.Text,'master',EdtUid.Text,EdtPwd.Text) then
    Begin
        Ds := TadoDataSet.Create(Self);
        Try
            Ds.Connection := Cn;
            Ds.CursorLocation := clUseClient;
            Ds.CommandText := 'Select * From sysdatabases order by [DbId]';
            Ds.Open;
            For i :=1 to Ds.RecordCount do
            begin
                CmbDb.Items.Add(Ds.FieldValues['name']);
                Ds.Next;
            end;
            if CmbDb.Items.Count >0 then
                CmbDb.ItemIndex := 0;
        Finally
            Ds.Close;
            Ds.Free;
        End;
    End
    Else
    begin
        MessageBox(Self.Handle,'数据库连接失败!','提示',MB_ICONINFORMATION);
        CmbDb.Items.Clear;
        CmbDb.ItemIndex := -1;
        CmbLog.Items.Clear;
        CmbLog.ItemIndex := -1;
        EdtLogPath.Text := '';
        EdtLogSize.Text := '';
    End;
end;

procedure TFrmMain.CmbDbClick(Sender: TObject);
Var
    Ds : TadoDataSet;
    i : Integer;
begin
    if Not Cn.Connected then
    begin
        CmbDb.Items.Clear;
        CmbDb.ItemIndex := -1;
        CmbLog.Items.Clear;
        CmbLog.ItemIndex := -1;
        EdtLogPath.Text := '';
        EdtLogSize.Text := '';
    End
    Else
    Begin
        Cn.Execute('Use '+CmbDb.Text);
        Ds := TadoDataSet.Create(Self);
        Try
            Ds.Connection := Cn;
            Ds.CommandText := 'select * from sysfiles where fileid>1 order By fileid';
            Ds.Open;
            CmbLog.Clear;
            CmbLog.ItemIndex := -1;
            For i:=1 to ds.RecordCount do
            Begin
                CmbLog.Items.Add(Ds.FieldValues['Name']);
                Ds.Next;
            End;
            if CmbLog.Items.Count <>0 then
                CmbLog.ItemIndex := 0;
        Finally
            Ds.Close;
            Ds.Free;
        End;
        CmbLogChange(Sender);
    End;
end;

procedure TFrmMain.CmbLogChange(Sender: TObject);
Var
    Ds : TadoDataSet;
begin
    if Not Cn.Connected then
    begin
        CmbDb.Items.Clear;
        CmbDb.ItemIndex := -1;
        CmbLog.Items.Clear;
        CmbLog.ItemIndex := -1;
        EdtLogPath.Text := '';
        EdtLogSize.Text := '';
    End
    Else
    Begin
        Cn.Execute('Use '+CmbDb.Text);
        Ds := TadoDataSet.Create(Self);
        Try
            Ds.Connection := Cn;
            Ds.CommandText := 'select * from sysfiles where [name]='''+CmbLog.Text+'''';
            Ds.Open;
            if Ds.RecordCount<>0 then
            Begin
                EdtLogPath.Text := Trim(Ds.FieldValues['FileName']);
                EdtLogSize.Text := Trim(Ds.FieldValues['Size']);
            End;
        Finally
            Ds.Close;
            Ds.Free;
        End;
    End;
end;

procedure TFrmMain.BtnOkClick(Sender: TObject);
begin
    if Not Cn.Connected then
    Begin
        MessageBox(Self.Handle,'数据库连接失败!','提示',MB_ICONINFORMATION);
    End
    Else
    Begin
        if Chk.Checked then
            Cn.Execute('exec sp_dboption '''+CmbDB.Text+''', ''trunc. log on chkpt.'', ''True''')
        Else
            Cn.Execute('exec sp_dboption '''+CmbDB.Text+''', ''trunc. log on chkpt.'', ''False''');
        Cn.BeginTrans;
        Try
            Cn.Execute('BACKUP LOG '+CmbDB.Text+' WITH TRUNCATE_ONLY DBCC SHRINKFILE ('+CmbLog.Text+', 10)');
            Cn.CommitTrans;
            MessageBox(Self.Handle,'数据库清理成功!','提示',MB_ICONINFORMATION);
        Except
            Cn.RollbackTrans;
            MessageBox(Self.Handle,'数据库清理失败!','提示',MB_ICONINFORMATION);
        End;
        CmbLogChange(Sender);        
    End;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -