📄 untmain.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 + -