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

📄 main.pas

📁 改写的sql2000管理器
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Registry,
  Dialogs, ActnList, RzTray, ExtCtrls, DB, ImgList, ADODB, Menus, StdCtrls, ADOFuncs,
  ComCtrls, RzEdit, GridsEh, DBGridEh, RzButton, Mask, RzCmboBx, RzRadChk, IniFiles,
  RzTabs;

type
  TMainForm = class(TForm)
    Label21: TLabel;
    pgcOper: TRzPageControl;
    tabsService: TRzTabSheet;
    Label10: TLabel;
    Label11: TLabel;
    lblStart: TLabel;
    lblStop: TLabel;
    Image1: TImage;
    chkAuthNT: TRzCheckBox;
    cbbSqlSericve: TRzComboBox;
    chkAutoStartWithOS: TRzCheckBox;
    statStat: TStatusBar;
    ckbNextStartHide: TRzCheckBox;
    chkAutoStart: TRzCheckBox;
    edtSQLRealName: TRzEdit;
    btnStart: TRzBitBtn;
    btnStop: TRzBitBtn;
    ckbService: TRzCheckBox;
    btnRefresh: TRzBitBtn;
    tabsDB: TRzTabSheet;
    Splitter2: TSplitter;
    Grid: TDBGridEh;
    pgcDB: TRzPageControl;
    tabsAssignDB: TRzTabSheet;
    Label14: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    edtMDF: TRzEdit;
    edtLDF: TRzEdit;
    btnOpenDBFile: TRzButton;
    edtDb: TRzEdit;
    ckbPath: TRzCheckBox;
    btnAssignDB: TRzButton;
    btnNewDB: TRzButton;
    tabsPass: TRzTabSheet;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    btnEditPass: TRzButton;
    edtOldPass: TRzEdit;
    edtNewPass1: TRzEdit;
    edtNewPass2: TRzEdit;
    tabsConnStr: TRzTabSheet;
    edtConnStr: TRzEdit;
    btnGetConnStr: TRzButton;
    tabsLog: TRzTabSheet;
    redtLog: TRzRichEdit;
    MainMenu: TMainMenu;
    N1: TMenuItem;
    pmiStart: TMenuItem;
    pmiStop: TMenuItem;
    pmiRefresh: TMenuItem;
    N4: TMenuItem;
    pmiExit: TMenuItem;
    N7: TMenuItem;
    pmiIsqlw: TMenuItem;
    pmiProfiler: TMenuItem;
    pmiManager: TMenuItem;
    N33: TMenuItem;
    pmiBackupSet: TMenuItem;
    N9: TMenuItem;
    pmTray: TPopupMenu;
    piStart: TMenuItem;
    piStop: TMenuItem;
    N14: TMenuItem;
    piExit: TMenuItem;
    aqExec: TADOQuery;
    ADS: TADODataSet;
    ADSDSDesigner: TSmallintField;
    ADSDSDesigner2: TWideStringField;
    ADSDSDesigner3: TWideStringField;
    ADOConn: TADOConnection;
    imgAction: TImageList;
    ds1: TDataSource;
    OpenDlg: TOpenDialog;
    imgTrayOpen: TImageList;
    imgTrayClose: TImageList;
    pmOperDB: TPopupMenu;
    pmiSpliteDB: TMenuItem;
    N19: TMenuItem;
    pmiTestLinkDB: TMenuItem;
    N23: TMenuItem;
    pmiBackupDB: TMenuItem;
    pmiRestoreDB: TMenuItem;
    backup: TTimer;
    Start: TTimer;
    TrayIcon: TRzTrayIcon;
    ActionList: TActionList;
    actStart: TAction;
    actStop: TAction;
    actRefresh: TAction;
    actIsqlw: TAction;
    actProfiler: TAction;
    actManager: TAction;
    actExit: TAction;
    actShow: TAction;
    SaveDlg: TSaveDialog;
    CheckStat: TTimer;
    PROCEDURE FormCloseQuery(Sender:TObject; VAR CanClose:Boolean);
    PROCEDURE FormClose(Sender:TObject; VAR Action:TCloseAction);
    PROCEDURE FormCreate(Sender:TObject);
    PROCEDURE ckbNextStartHideClick(Sender:TObject);
    PROCEDURE chkAutoStartWithOSClick(Sender:TObject);
    PROCEDURE chkAuthNTClick(Sender:TObject);
    PROCEDURE btnAssignDBClick(Sender:TObject);
    PROCEDURE btnGetConnStrClick(Sender:TObject);
    PROCEDURE btnEditPassClick(Sender:TObject);
    PROCEDURE pmiSpliteDBClick(Sender:TObject);
    PROCEDURE btnNewDBClick(Sender:TObject);
    PROCEDURE pmiBackupDBClick(Sender:TObject);
    PROCEDURE pmiRestoreDBClick(Sender:TObject);
    PROCEDURE chkAutoStartClick(Sender:TObject);
    PROCEDURE pmiBackupSetClick(Sender:TObject);
    PROCEDURE backupTimer(Sender:TObject);
    PROCEDURE StartTimer(Sender:TObject);
    PROCEDURE GridExit(Sender:TObject);
    PROCEDURE GridEnter(Sender:TObject);
    PROCEDURE actStartExecute(Sender:TObject);
    PROCEDURE actStopExecute(Sender:TObject);
    PROCEDURE actExitExecute(Sender:TObject);
    PROCEDURE actShowExecute(Sender:TObject);
    PROCEDURE btnOpenDBFileClick(Sender:TObject);
    PROCEDURE ckbServiceClick(Sender:TObject);
    PROCEDURE edtSQLRealNameExit(Sender:TObject);
    PROCEDURE edtConnStrExit(Sender:TObject);
    PROCEDURE pmiTestLinkDBClick(Sender:TObject);
    PROCEDURE actIsqlwExecute(Sender:TObject);
    PROCEDURE actProfilerExecute(Sender:TObject);
    PROCEDURE actManagerExecute(Sender:TObject);
    PROCEDURE actRefreshExecute(Sender:TObject);
    PROCEDURE CheckStatTimer(Sender:TObject);
  PRIVATE
    { Private declarations }
    StartClickTime:TDateTime;
    sSelfPath, sSQLRootPath:STRING;
    sComputerName:STRING;
    GridlayoutFile:STRING;
    Reg:TRegistry;
    bStart:Boolean;
    FUNCTION CheckStat_SQL:Boolean;
  PUBLIC
    BackupType, EveryTime, EveryDay, EveryMonth, EveryWeek:Integer;
    FUNCTION ConnectDB(DBConStr:STRING):Boolean;
    PROCEDURE RegisterNewName;          //注册新的SQL实例名
    PROCEDURE SetButtonStat;
    FUNCTION IsSysDB(ADB:STRING):Boolean;
    PROCEDURE LoadMyVar;
    PROCEDURE SaveMyVar;
    PROCEDURE SetMyVar;
    FUNCTION LoadSqlLog(AList:TStrings):Integer;
    FUNCTION CheckIsStart:Boolean;
  END;

VAR
  MainForm:TMainForm;

IMPLEMENTATION

USES GlobalPara, RunDosThrd, UnitFrmSetupTime, xfuncs, XFunc, PublicFunction;

{$R *.dfm}

VAR MyVar:TMyVar;

FUNCTION TMainForm.ConnectDB(DBConStr:STRING):Boolean;
BEGIN
  TRY
    ADOConn.Connected:=False;
    ADOConn.ConnectionString:=DBConStr;
    ADOConn.Connected:=True;
    Result:=True;
    ADOConn.Connected:=False;
  EXCEPT
    Result:=False;
    ADOConn.Connected:=False;
  END;
END;

PROCEDURE TMainForm.FormCloseQuery(Sender:TObject; VAR CanClose:Boolean);
BEGIN
  CanClose:=NOT bStart;
END;

PROCEDURE TMainForm.FormClose(Sender:TObject; VAR Action:TCloseAction);
BEGIN
  Reg.Free;

  EndProcessSA;
  ExitProcess(0);

  Self.SaveMyVar;
  GridExit(NIL);
  Action:=caFree;
END;

PROCEDURE TMainForm.FormCreate(Sender:TObject);
VAR
  myreg, myreg2, myreg3:STRING;
  f, m:textfile;
BEGIN
  Reg:=TRegistry.Create;
  pgcOper.ActivePageIndex:=0;

  sSelfPath:=ExtractFilePath(ParamStr(0));
  sSQLRootPath:=StringReplace(sSelfPath, 'binn\', '', [rfReplaceAll, rfIgnoreCase]);
  GridlayoutFile:=sSelfPath+'GridLayout.ini';
  sComputerName:=Computername;

  Self.LoadMyVar;
  Self.SetMyVar;

  bStart:=False;
  Self.SetButtonStat;

  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  myreg:='SOFTWARE\Microsoft\Microsoft SQL Server\'+MyVar.SysDB.RealName;
  myreg2:='Software\Microsoft\Windows\CurrentVersion\Run';
  myreg3:='SOFTWARE\Microsoft\MSSQLServer\MSSQLServer';

  Reg.OpenKey(myreg2, False);

  IF (NOT Reg.KeyExists(myreg3))OR(NOT Reg.KeyExists(myreg)) THEN
  BEGIN
    RegisterNewName;
  END;

  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  myreg:='SOFTWARE\Microsoft\Microsoft SQL Server\'+MyVar.SysDB.RealName+'\Setup';
  Reg.OpenKey(myreg, True);
  Reg.WriteString('SQLDataRoot', sSQLRootPath);
  Reg.WriteString('SQLPath', sSQLRootPath);
  Reg.CloseKey;
  myreg:='SOFTWARE\Microsoft\Microsoft SQL Server\'+MyVar.SysDB.RealName+'\MSSQLServer\SuperSocketNetLib\Tcp';
  Reg.OpenKey(myreg, True);
  Reg.WriteString('TcpDynamicPorts', MyVar.SysDB.port);
  Reg.WriteString('TcpPort', MyVar.SysDB.port);
  Reg.CloseKey;

  EndProcessSA;
END;

PROCEDURE TMainForm.ckbNextStartHideClick(Sender:TObject);
BEGIN
  MyVar.UserDB.NextHide:=ckbNextStartHide.Checked;
END;

PROCEDURE TMainForm.chkAutoStartWithOSClick(Sender:TObject);
BEGIN
  MyVar.UserDB.Starup:=chkAutoStartWithOS.Checked;

  IF MyVar.UserDB.Starup THEN
  BEGIN
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
    IF NOT Reg.KeyExists('PM6SERVER') THEN
      Reg.CreateKey('PM6SERVER');

    Reg.WriteString('PM6SERVER', Application.ExeName);
    Reg.CloseKey;
  END
  ELSE
  BEGIN
    Reg.RootKey:=HKEY_LOCAL_MACHINE;
    Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
    Reg.DeleteKey('PM6SERVER');
    Reg.CloseKey;
  END;
END;

PROCEDURE TMainForm.chkAuthNTClick(Sender:TObject);
BEGIN
  MyVar.UserDB.LoginMode:=chkAuthNT.Checked;
END;

PROCEDURE TMainForm.btnAssignDBClick(Sender:TObject);
VAR
  sp:STRING;
  sDmdf, sDldf:STRING;
  mysql:STRING;
BEGIN
  sDmdf:='';
  sDldf:='';

  IF ckbPath.Checked THEN
  BEGIN
    sp:=pchar(sSQLRootPath+'MYDB\');
    IF sp[length(sp)]<>'\' THEN
      sp:=sp+'\';
    sDmdf:=sp+ExtractFileName(edtMDF.Text);

    IF NOT CopyFile(pchar(edtMDF.Text), pchar(sDmdf), True) THEN
    BEGIN
      ShowMessage('拷贝文件失败:'+sDmdf);
      exit;
    END;
    IF edtLDF.Text<>'' THEN
    BEGIN
      sDldf:=sp+ExtractFileName(edtLDF.Text);
      IF NOT CopyFile(pchar(edtLDF.Text), pchar(sDldf), True) THEN
      BEGIN
        ShowMessage('拷贝文件失败:'+sDldf);
        exit;
      END;
    END;
  END
  ELSE
  BEGIN
    sDmdf:=edtMDF.Text;
    sDldf:=edtLDF.Text;
  END;

  mysql:=format(sSingl, [edtDb.Text, sDmdf])
    +#13#10+format(sDB, [edtDb.Text, sDmdf, sDldf]);

  ExecSQL(aqExec, mysql);
  TRY
    IF Self.ckbPath.Checked THEN
    BEGIN
      ////////////////////////
      mysql:=pchar(format(' update sysaltfiles set filename=''%s'' where filename=''%s''  ',
        [sSQLRootPath+'MYDB\'+ExtractFileName(edtMDF.Text), sDmdf]));
      ExecSQL(aqExec, mysql);

      mysql:=format(' update sysaltfiles set filename=''%s'' where filename=''%s'' ',
        [sSQLRootPath+'MYDB\'+ExtractFileName(edtLDF.Text), sDldf]);
      ExecSQL(aqExec, mysql);

      mysql:=format('update sysdatabases set filename=''%s'' where name=''%s''',
        [sSQLRootPath+'MYDB\'+ExtractFileName(edtMDF.Text), Trim(edtDb.Text)]);
      ExecSQL(aqExec, mysql);

      Self.ADS.Active:=False;
      Self.ADS.Active:=True;
      ////////////////////////设为相对路径
    END;
    ShowMessage('附加数据库成功!');
  EXCEPT
    ON E:Exception DO
      ShowMessage(E.Message);
  END;
END;


PROCEDURE TMainForm.btnGetConnStrClick(Sender:TObject);
BEGIN
  edtConnStr.Text:=MyVar.UserDB.ConnStr;
END;

PROCEDURE TMainForm.btnEditPassClick(Sender:TObject);
VAR passsql:STRING;
BEGIN
  IF Trim(edtNewPass1.Text)<>Trim(edtNewPass2.Text) THEN
  BEGIN
    MyWarning('您输入的修改密码与确定密码不一致......');
    exit;
  END;

  IF Trim(Self.edtOldPass.Text)='' THEN
    passsql:=format('sp_password null,''%s'',''%s'' ', [Trim(Self.edtNewPass1.Text), 'SA'])
  ELSE
    passsql:=format('sp_password ''%s'',''%s'',''%s'' ', [Trim(Self.edtOldPass.Text),
      Trim(Self.edtNewPass1.Text), 'SA']);

  IF NOT MyConfirmation('真的要修改当前数据库的密码吗?'+#13#10+'本操作将可能会影响到其它和户的操作!')
    THEN
    exit;
  TRY
    Self.ADOConn.Execute(passsql);
    MyInformation('修改密码成功!');
    MyVar.SysDB.pass:=Trim(Self.edtNewPass1.Text);
  EXCEPT
    MyError('修改密码失败!');
  END;
END;

PROCEDURE TMainForm.pmiSpliteDBClick(Sender:TObject);
VAR sql, s:STRING;
BEGIN
  IF NOT Self.ADS.Active THEN exit;
  s:=Self.ADS.FieldByName('名称').AsString;
  IF (s='')OR(IsSysDB(s)) THEN exit;

  IF NOT MyConfirmation('真的要分离当前数据库吗?'+#13#10
    +'本操作将可能会影响到相关程序的数据!') THEN exit;
  sql:=format('exec sp_detach_db ''%s'', ''true''', [s]);
  Self.ADOConn.Execute(sql);
  Self.ADS.Delete;
END;

FUNCTION TMainForm.CheckStat_SQL:Boolean;
VAR FDBName:STRING;
  DBConStr:STRING;
  s:STRING;
BEGIN
  Result:=False;
  IF NOT bStart THEN exit;

  FDBName:='master';

  IF MyVar.SysDB.RealName[length(MyVar.SysDB.RealName)]='\' THEN
    s:=Copy(MyVar.SysDB.RealName, 1, length(MyVar.SysDB.RealName)-1)
  ELSE
    s:=MyVar.SysDB.RealName;

  IF Self.chkAuthNT.Checked=True THEN
    DBConStr:='Provider=SQLOLEDB.1;Integrated Security=SSPI;'+
      'Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source='+s
  ELSE IF MyVar.SysDB.pass='' THEN
    DBConStr:='Provider=SQLOLEDB.1;Persist Security Info=False;'+
      'User ID='+MyVar.SysDB.user+';Initial Catalog=master;Data Source='+s
  ELSE
    DBConStr:='Provider=SQLOLEDB.1;Password='+MyVar.SysDB.pass+';Persist Security Info=True;'+
      'User ID='+MyVar.SysDB.user+';Initial Catalog=master;Data Source='+s;

  Screen.Cursor:=crHourGlass;
  TRY
    Result:=ConnectDB(DBConStr);
    IF Result THEN
    BEGIN
      ShowInfo(statStat, -1, '启动SQL Server 成功!');

      redtLog.Lines.Add('连接成功!');

      edtConnStr.Text:=DBConStr;
      edtConnStrExit(NIL);
      Self.ADS.Active:=False;
      Self.ADS.Active:=True;
    END
    ELSE
    BEGIN
      redtLog.Lines.Add('连接失败!');
    END;
  FINALLY
    Screen.Cursor:=crDefault;
  END;
END;

PROCEDURE TMainForm.btnNewDBClick(Sender:TObject);
VAR datasql, mysql:STRING;
  sDmdf, sDldf, sDB:STRING;
BEGIN
  sDB:=Trim(edtDb.Text);
  IF sDB<>'' THEN
  BEGIN
    TRY
      Self.ADOConn.Execute('use master');
      datasql:=format('create database %s ', [sDB]);
      Self.ADOConn.Execute(datasql);
      sDmdf:=StringReplace(LowerCase(sSelfPath), '\binn\', '\data\',
        [rfReplaceAll])+sDB+'.mdf';
      sDldf:=StringReplace(LowerCase(sSelfPath), '\binn\', '\data\',
        [rfReplaceAll])+sDB+'_log.ldf';

      IF ckbPath.Checked THEN
      BEGIN
        ////////////////////////
        mysql:=pchar(format(' update sysaltfiles set filename=''%s'' where filename=''%s''  ',
          [sSQLRootPath+'data\'+sDB+'.mdf', sDmdf]));

        aqExec.Close;
        aqExec.sql.Text:=mysql;
        aqExec.ExecSQL;

        mysql:=format(' update sysaltfiles set filename=''%s'' where filename=''%s'' ',
          [sSQLRootPath+'data\'+sDB+'_log.ldf', sDldf]);

        aqExec.Close;
        aqExec.sql.Text:=mysql;
        aqExec.ExecSQL;

        mysql:=format('update sysdatabases set filename=''%s'' where name=''%s''',
          [sSQLRootPath+'data\'+sDB+'.mdf', sDB]);

        aqExec.Close;
        aqExec.sql.Text:=mysql;
        aqExec.ExecSQL;
        Self.ADS.Active:=False;
        Self.ADS.Active:=True;
      END;
      ////////////////////////设为相对路径
      MyInformation('创建数据库成功!');
      Self.ADS.Active:=False;
      Self.ADS.Active:=True;
    EXCEPT
      MyInformation('创建数据库失败!');
    END;
  END;
END;

PROCEDURE TMainForm.pmiBackupDBClick(Sender:TObject);
VAR sDbName:STRING;
BEGIN
  IF NOT Self.ADS.Active THEN exit;

⌨️ 快捷键说明

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