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

📄 ufrmbfmysql.pas

📁 数据库通用工具
💻 PAS
字号:
unit UfrmBFMySQL;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UfrmModel, StdCtrls, Buttons, ExtCtrls, ActnList, ShlObj, Registry,
  StrUtils, DB, DBTables;

type
  TfrmBFMySQL = class(TfrmModel)
    Panel1: TPanel;
    Panel2: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label1: TLabel;
    edtPath: TEdit;
    bbtSelPath: TBitBtn;
    mo: TMemo;
    GroupBox1: TGroupBox;
    Label5: TLabel;
    edtFile: TEdit;
    BitBtn4: TBitBtn;
    OpenDialog1: TOpenDialog;
    BitBtn5: TBitBtn;
    Label6: TLabel;
    mo1: TMemo;
    qryPub: TQuery;
    qryPub2: TQuery;
    Label7: TLabel;
    edtDB: TEdit;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    edtToPath: TEdit;
    bbtSel2: TBitBtn;
    edtDBName: TEdit;
    Label4: TLabel;
    BitBtn3: TBitBtn;
    Label3: TLabel;
    procedure bbtSelPathClick(Sender: TObject);
    procedure bbtSel2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    function testDBExist( dbName : string ) : Boolean;
    procedure moAdd( str : string );
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmBFMySQL: TfrmBFMySQL;

implementation

uses Udbm;

{$R *.dfm}

procedure TfrmBFMySQL.bbtSelPathClick(Sender: TObject);
var
  BrowseInfo  : TBrowseInfo;//ShlObj
  PIDL        : PItemIDList;
  DisplayName : array[0..MAX_PATH] of Char;
begin
  inherited;
  FillChar(BrowseInfo,SizeOf(BrowseInfo),#0);
  BrowseInfo.hwndOwner      := Handle;
  BrowseInfo.pszDisplayName := @DisplayName[0];
  BrowseInfo.lpszTitle      := 'MySQL Path';//'选择路径';
  BrowseInfo.ulFlags        := BIF_RETURNONLYFSDIRS;
  PIDL := SHBrowseForFolder(BrowseInfo);
  if Assigned(PIDL) then
    if SHGetPathFromIDList(PIDL, DisplayName) then
      edtPath.Text := DisplayName;
      //ShowMessage(DisplayName);
end;

procedure TfrmBFMySQL.bbtSel2Click(Sender: TObject);
var
  BrowseInfo  : TBrowseInfo;//ShlObj
  PIDL        : PItemIDList;
  DisplayName : array[0..MAX_PATH] of Char;
begin
  inherited;
  FillChar(BrowseInfo,SizeOf(BrowseInfo),#0);
  BrowseInfo.hwndOwner      := Handle;
  BrowseInfo.pszDisplayName := @DisplayName[0];
  BrowseInfo.lpszTitle      := 'MySQL Path';//'选择路径';
  BrowseInfo.ulFlags        := BIF_RETURNONLYFSDIRS;
  PIDL := SHBrowseForFolder(BrowseInfo);
  if Assigned(PIDL) then
    if SHGetPathFromIDList(PIDL, DisplayName) then
      edtToPath.Text := DisplayName;
      //ShowMessage(DisplayName);
      
end;

procedure TfrmBFMySQL.FormShow(Sender: TObject);
var
  ss,sIniPath : string;
  regf : TRegistry;
begin
  inherited;
//  bbtSelPath.Visible := False;
  try
    regf := TRegistry.create;
    regf.RootKey := HKEY_LOCAL_MACHINE;
    regf.OpenKey('SOFTWARE\MySQL AB\MySQL Server 5.2',true);
    ss := regf.ReadString('Location');
    regf.CloseKey;
    regf.free;

    if Trim(ss)='' then//需要手工指定
    begin
      bbtSelPath.Visible := True;
    end
    else//<>''
    begin
      edtPath.Text := ss;
    end;
    
  except
  end;

  databaseParam := getDatabaseParam('DBMySQL');
  edtDBName.Text := databaseParam.DatabaseName;
  
end;

procedure TfrmBFMySQL.BitBtn3Click(Sender: TObject);
var
  ss,sto,sbin : string;
begin
  inherited;
  if not dbm.testDBMySQLLink() then Exit;

  //'mysqldump.exe'
  ss := Trim(edtPath.Text);
  if RightStr(ss,1)<>'\' then
  begin
    ss := ss+'\';
  end;
  
  sbin := ss+'bin\mysqldump.exe';

  if not FileExists(sbin) then
  begin
    ShowMSG('MySQL 路径无效!');
    Exit;
  end;

  sto := Trim(edtToPath.Text);
  if RightStr(sto,1)<>'\' then
  begin
    sto := sto+'\';
  end;
  
  if not DirectoryExists(sto) then
  begin
    ForceDirectories( sto );
//    ShowMSG('备份路径无效!');
//    Exit;
  end;
    
  {
  cd C:\Program Files\MySQL\MySQL Server 5.2\bin
  mysqldump -uroot -psa --opt cygl > e:\cygl_0423.sql
  mysqldump -uroot -psa --opt cygl < e:\cygl_0423.sql
  }
  mo.Lines.Clear;
  mo.Lines.Add('@echo off');
  //mo.Lines.Add('md D:\DB_Backup');
  //mo.Lines.Add('md '+sto);  
  mo.Lines.Add( LeftStr(ss,2) );//D:
  mo.Lines.Add('cd '+ss+'bin\');
  mo.Lines.Add('mysqldump -u'
    + databaseParam.UserName
    + ' -p'
    + databaseParam.Password
    + ' --opt '
    + edtDBName.Text //databaseParam.DatabaseName
    + ' > '
    + sto //D:\DB_Backup
    + edtDBName.Text+'_'  //cygl_
    + FormatDateTime('yymmdd_hhmmss',Now) +'.sql' );

//  mo.Lines.Add('mysqldump -uroot -psa --opt cygl < D:\DB_Backup\cygl_0423.sql' );
  //mo.Lines.Add('@del %0');

  if FileExists( appPath+'\temp.bat' )  then
  begin
    DeleteFile( appPath+'\temp.bat' );
  end;

  mo.Lines.SaveToFile( appPath+'\temp.bat' );

  if ShowMSG( '请终止一切操作,等待备份完成!','提示',1 ) <> ID_OK then
  begin
    exit;
  end;

  URLink( appPath+'\temp.bat' );
  sleep(4000);
  ShowMSG('备份成功。');

end;

procedure TfrmBFMySQL.BitBtn4Click(Sender: TObject);
begin
  inherited;
  if OpenDialog1.Execute then
  begin
    edtFile.Text := OpenDialog1.FileName;
  end;
end;

function TfrmBFMySQL.testDBExist( dbName : string ) : Boolean;
var
  bExist : Boolean;
  ss : string;
begin
  Result := True;

  if dbm.dbODBCMySQL.Connected then
  begin
    with qryPub2 do
    begin
      Close;
      SQL.Text := 'show databases';

      try
        open;
      except
        Exit;
      end;

      ss := '';
      bExist := False;
      while not Eof do
      begin
        ss := FieldByName('database').AsString;
        if SameText(ss,dbName) then
        begin
          bExist := True;
          Break;
        end;
        Next;
      end;
      
      Result := bExist;
    end;
  end;
  
end;

procedure TfrmBFMySQL.moAdd( str : string );
begin
  mo1.Lines.Add( str );
end;

procedure Delay(Msecs: Integer);
var
   FirstTickCount : real;
begin  
   FirstTickCount := GetTickCount;
   Repeat
      Application.ProcessMessages;
   Until ((GetTickCount - FirstTickCount) >= LongInt (Msecs));
end;

procedure TfrmBFMySQL.BitBtn5Click(Sender: TObject);
var
  ss,sfrom,sto,sbin,sDB,sPath : string;
  i,fHandle : Integer;
  pc : char;
begin
  inherited;
  ss := Trim(edtPath.Text);
  if RightStr(ss,1)<>'\' then
  begin
    ss := ss+'\';
  end;

  sPath := ss;
  sbin := ss+'bin\mysqldump.exe';

  if not FileExists(sbin) then
  begin
    ShowMSG('MySQL 路径无效!');
    Exit;
  end;
  
  sDB := Trim(edtDB.Text);
  if sDB='' then
  begin
    if edtDB.CanFocus then edtDB.SetFocus;
    Exit;
  end;

  //还原
  sfrom := Trim(edtFile.Text);
  if not FileExists(sfrom) then
  begin
    ShowMSG('备份文件不存在!');
    Exit;
  end;

  if ShowMSG( '您确定该备份文件有效吗!','提示',1 ) <> ID_OK then
  begin
    exit;
  end;

  if not dbm.testDBMySQLLink() then Exit;
  
  ss := Copy( sys32Path,1,3 )+'creatDatabase.sql';//'C:\creatDatabase.sql';
  try
    if FileExists(ss) then
    begin
      DeleteFile( ss );
    end;

    CopyFile( PChar( sfrom ),PChar(ss), True);
    FileSetAttr( ss, 0);//faArchive
  except
  end;
  //}

  sto := StringReplace(ss,'\','/',[rfReplaceAll]);

  if testDBExist( sDB ) then
  begin
    moAdd( '数据库 '+sDB+' 已存在!');
  end
  else
  begin
    with qryPub do
    begin
      Close;
      SQL.Text := 'create database '+sDB;//sDB;

      try
        ExecSQL;
        moAdd( '新建数据库 '+sDB+' 成功。');
      except
        moAdd( '新建数据库失败!');
        Exit;
      end;
    end;
  end;                                           

  if dbm.dbODBCMySQL.Connected then
    dbm.dbODBCMySQL.Connected := False;
    
  mo.Lines.Clear;
  mo.Lines.Add('@echo off');
  mo.Lines.Add( Copy(sbin,1,2 ) );//D:
  mo.Lines.Add('cd '+sPath+'bin\');
  mo.Lines.Add('mysql -u'+databaseParam.UserName+ ' -p'+databaseParam.Password);
  mo.Lines.Add('use '+sDB);
//  mo.Lines.Add('@del %0');

  if FileExists( appPath+'\temp.bat' )  then
  begin
    DeleteFile( appPath+'\temp.bat' );
  end;

  mo.Lines.SaveToFile( appPath+'\temp.bat' );

  if ShowMSG( '请终止一切操作,等待恢复完成!','提示',1 ) <> ID_OK then
  begin
    exit;
  end;

  URLink( appPath+'\temp.bat' );
  sleep(1000);
  i := 0;
  while i<3 do
  begin
    ss := sys32Path+'\cmd.exe';//'C:\WINNT\system32\cmd.exe';
    fHandle := FindWindow(nil, PChar(ss) );
    if fHandle>0 then
    begin
      ss := 'use '+sDB;//cygl
      for i := 1 to Length(ss) do
      begin
        pc := ss[i];
        postmessage(fHandle,wm_char,ord(pc),0);
      end;

      postmessage(fHandle,wm_char,13,0);
      //---------------------------------
      //source d:/creatDatabase.sql
      ss := 'source '+sto;
      for i := 1 to Length(ss) do
      begin
        pc := ss[i];
        postmessage(fHandle,wm_char,ord(pc),0);
      end;

      postmessage(fHandle,wm_char,13,0);
      //---------------------------------
      ss := 'exit;';
      for i := 1 to Length(ss) do
      begin
        pc := ss[i];
        postmessage(fHandle,wm_char,ord(pc),0);
      end;

      postmessage(fHandle,wm_char,13,0);
      
      break;
    end
    else
    begin
      inc(i);
      Delay(500);
    end;
  end;
  
  moAdd( '还原完毕。');
  ShowMSG('还原完毕。');

end;

end.

⌨️ 快捷键说明

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