ufrmmain.pas

来自「数据自动备份系统的简易实现,DELPHI实现.」· PAS 代码 · 共 1,273 行 · 第 1/4 页

                begin
                  Continue;
                end;
              end;

              if FileExists(strCurFile) then
              begin
                if (iSaveType = 0) or (iSaveType = 1) then  //本地备份 或者 异地备份-局域网
                begin
                  if Copy(sSavePath, Length(sSavePath), 1) = '\' then
                  begin
                    strCprBackupFile := sSavePath + GetNameByFileName(strCurFile);
                    if FileExists(strCprBackupFile) then
                    begin
                      if SameText(sBackupWay, '增量备份') then
                      begin
                        if DirectoryExists(sSavePath + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)') then
                        begin
                          strMoveSrc := sSavePath + '(' + GetFileNameByDateTime + ')' + GetNameByFileName(strCurFile);
                          strMoveDest := sSavePath  + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)' + '\' + GetNameByFileName(strMoveSrc);
                          RenameFile(strCprBackupFile, strMoveSrc);
                          MoveFile(PChar(strMoveSrc), PChar(strMoveDest));
                        end
                        else
                        begin
                          if CreateDir(sSavePath + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)') then
                          begin
                            strMoveSrc := sSavePath + '(' + GetFileNameByDateTime + ')' + GetNameByFileName(strCurFile);
                            strMoveDest := sSavePath  + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)' + '\' + GetNameByFileName(strMoveSrc);
                            RenameFile(strCprBackupFile, strMoveSrc);
                            MoveFile(PChar(strMoveSrc), PChar(strMoveDest));
                          end;
                        end;
                      end;
                    end;

                    //拷贝源文件到目标路径下
                    if CopyFile(PChar(strCurFile), PChar(sSavePath + GetNameByFileName(strCurFile)), False) then
                      DoSystemLog('备份文件:（ ' + strCurFile + ' ）成功.')
                    else
                      DoSystemLog('备份文件:（ ' + strCurFile + ' ）失败.');
                  end
                  else
                  begin
                    strCprBackupFile := sSavePath + '\' + GetNameByFileName(strCurFile);
                    if FileExists(strCprBackupFile) then
                    begin
                      if SameText(sBackupWay, '增量备份') then
                      begin
                        if DirectoryExists(sSavePath + '\' + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)') then
                        begin
                          strMoveSrc := sSavePath + '\' + '(' + GetFileNameByDateTime + ')' + GetNameByFileName(strCurFile);
                          strMoveDest := sSavePath + '\' + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)' + '\' + GetNameByFileName(strMoveSrc);
                          RenameFile(strCprBackupFile, strMoveSrc);
                          MoveFile(PChar(strMoveSrc), PChar(strMoveDest));
                        end
                        else
                        begin
                          if CreateDir(sSavePath + '\' + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)') then
                          begin
                            strMoveSrc := sSavePath + '\' + '(' + GetFileNameByDateTime + ')' + GetNameByFileName(strCurFile);
                            strMoveDest := sSavePath + '\' + GetNameByFileNameWithOutExt(strCurFile) + '(以往备份)' + '\' + GetNameByFileName(strMoveSrc);
                            RenameFile(strCprBackupFile, strMoveSrc);
                            MoveFile(PChar(strMoveSrc), PChar(strMoveDest));
                          end;
                        end;
                      end;
                    end;

                    if CopyFile(PChar(strCurFile), PChar(sSavePath + '\' + GetNameByFileName(strCurFile)), False) then
                      DoSystemLog('备份文件:（ ' + strCurFile + ' ）成功.')
                    else
                      DoSystemLog('备份文件:（ ' + strCurFile + ' ）失败.');
                  end;
                end
                else //异地备份-FTP
                begin
                   //拷贝源文件到程序所在目录下
                   if CopyFile(PChar(strCurFile), PChar(ExtractFilePath(Application.ExeName) + GetNameByFileName(strCurFile)), False) then
                   begin
                     //启动FTP连接，并将文件传到FTP服务器上
                    if DoPostFileToFTP(ExtractFilePath(Application.ExeName) + GetNameByFileName(strCurFile), TxtFTPFileDir.Text, sBackupWay) then
                    begin
                      DoSystemLog('备份文件:（ ' + strCurFile + ' ）成功.');
                    end
                    else DoSystemLog('备份文件:（ ' + strCurFile + ' ）失败.');
                   end;
                end;
              end;
            end;
          except
            DoSystemLog('备份文件/目录:（ ' + sBackupDest + ' ）失败.');
          end;
        finally
          ObjectList.Free;
        end;
      end;
    1: //备份数据库
      begin
        try
          if DoBackupDB(sBackupDest, sSavePath, TxtFTPFileDir.Text, sBackupWay, iSaveType) then
            DoSystemLog('备份数据库:（ ' + sBackupDest + ' ）成功.')
          else
            DoSystemLog('备份数据库:（ ' + sBackupDest + ' ）失败.');
        except
          DoSystemLog('备份数据库:（ ' + sBackupDest + ' ）失败.');
        end;
      end;
  end;
end;

procedure TfrmMain.DoSystemLog(sLogMsg: string);
begin
  sLogMsg := '-> ' + DateTimeToStr(Now) + ' ' + sLogMsg;
  SystemLog.Lines.Insert(0, sLogMsg);    //添加日志信息到日志列表
  Application.ProcessMessages;
end;

procedure TfrmMain.btnBrowerOptionClick(Sender: TObject);
var
  OpenDlg: TOpenDialog;
  strDir: string;
begin
  if SameText(cmbBackupType.Text, '备份文件') then
  begin
    OpenDlg := TOpenDialog.Create(nil);
    try
      OpenDlg.Filter := '全部文件(*.*)|*.*';    //指定文件类型
      if OpenDlg.Execute then
      begin
        if OpenDlg.FileName <> '' then
        begin
          TxtBackupDest.Text := OpenDlg.FileName;
        end;
      end;
    finally
      OpenDlg.Free;
    end;
  end
  else if SameText(cmbBackupType.Text, '备份目录') then
  begin
    if SelectDirectory('选择备份目录', 'Root', strDir) then
    begin
      TxtBackupDest.Text := strDir;
    end;
  end
  else    //选择数据库
  begin
    if EditConnectionString(ADOConn) then
    begin
      TxtBackupDest.Text := ADOConn.ConnectionString;
    end;
  end;
end;

procedure TfrmMain.btnBrowerPathClick(Sender: TObject);
var
  strDir: string;
begin
  if SelectDirectory('选择保存目录', 'Root', strDir) then  //选择保存目录
  begin
    TxtSavePath.Text := strDir;
  end;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  StatusBar1.Panels[1].Text := DateTimeToStr(Now);   //显示系统时间
end;

function TfrmMain.DoBackupDB(sConnectionString, sSavePath, sFTPServerPath, sBackupWay: string; iSaveType: Integer): Boolean;
const
  DataBaseNameChar = 'Initial Catalog=';
  ProviderChar = 'Provider=';
  EndChar = ';';
var
  strSrcDBName, strDestDBName: string;
  function SplitConnectionString: Boolean;          //分解数据库连接字符串
  var
    iPos: Integer;
    sProvider, strConnectionString: string;
  begin
    Result := False;
    strConnectionString := sConnectionString;
    iPos := Pos(ProviderChar, strConnectionString);
    if iPos > 0 then
    begin
      Delete(strConnectionString, 1, iPos + Length(ProviderChar) - 1);
      iPos := Pos(EndChar, strConnectionString);
      sProvider := Copy(strConnectionString, 1, iPos - 1);
      if SameText(LowerCase('SQLOLEDB.1'), LowerCase(sProvider)) then    //判断是否是SQL SERVER 数据库
      begin
        iPos := Pos(DataBaseNameChar, strConnectionString);
        Delete(strConnectionString, 1, iPos + Length(DataBaseNameChar) - 1);
        iPos := Pos(EndChar, strConnectionString);
        strSrcDBName := Copy(strConnectionString, 1, iPos - 1);
        Result := True;
      end;
    end;
  end;
begin
  //backup   database   name   to   disk='c:\mssql7\backup\name.bak'   with   init           //备份
  //restore   database   name   from   disk='c:\mssql7\backup\name.bak'   with   replace.    //还原
  Result := False;
  if not SplitConnectionString then
  begin
    DoSystemLog('数据库连接出现问题，请重新配置！');
    Exit;
  end;
  //数据库备份的目标文件名
  if SameText(sBackupWay, '增量备份') then
  begin
    strDestDBName := strSrcDBName + '_Bak(' + DateToStr(Date) + ')' + IntToStr(GetTickCount) + '.bak';
  end
  else strDestDBName := strSrcDBName + '.bak';
  try
    ADOConn.Close;
    ADOConn.ConnectionString := sConnectionString;
    ADOConn.Open;
    qryCommand.Close;
    qryCommand.Connection := ADOConn;
    qryCommand.SQL.Clear;
    if Copy(sSavePath, Length(sSavePath), 1) = '\' then
    begin
      //备份数据库的SQL语句
      qryCommand.SQL.Text := 'backup database ' + strSrcDBName + ' to disk=' + QuotedStr(sSavePath + strDestDBName) + ' with init';
    end
    else
    begin
      //备份数据库的SQL语句
      qryCommand.SQL.Text := 'backup database ' + strSrcDBName + ' to disk=' + QuotedStr(sSavePath + '\' + strDestDBName) + ' with init';
    end;
    qryCommand.ExecSQL;
    qryCommand.Close;
    ADOConn.Close;
    if iSaveType = 2 then  //异地备份-FTP
    begin
      DoPostFileToFTP(sSavePath + '\' + strDestDBName, sFTPServerPath, sBackupWay);
      //删除缓存文件
      DeleteFile(sSavePath + '\' + strDestDBName);
    end;
    Result := True;
  except
    on E: Exception do
    begin
      DoSystemLog(E.Message);
    end;  
  end;
end;

procedure TfrmMain.N4Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.rgTaskTimeClick(Sender: TObject);
begin
  case rgTaskTime.ItemIndex of
    0:      //按天
      begin
        dtpTaskTimeByDay.Enabled := True;
        sTxtTaskTimeByHour.Enabled := False;
        sTxtTaskTimeByMinute.Enabled := False;
        sTxtTaskTimeBySecond.Enabled := False;
      end;
    1:      //按时
      begin
        dtpTaskTimeByDay.Enabled := False;
        sTxtTaskTimeByHour.Enabled := True;
        sTxtTaskTimeByMinute.Enabled := False;
        sTxtTaskTimeBySecond.Enabled := False;
      end;
    2:      //按分
      begin
        dtpTaskTimeByDay.Enabled := False;
        sTxtTaskTimeByHour.Enabled := False;
        sTxtTaskTimeByMinute.Enabled := True;
        sTxtTaskTimeBySecond.Enabled := False;
      end;
    3:      //按秒
      begin
        dtpTaskTimeByDay.Enabled := False;
        sTxtTaskTimeByHour.Enabled := False;
        sTxtTaskTimeByMinute.Enabled := False;
        sTxtTaskTimeBySecond.Enabled := True;
      end;
  end;
end;

procedure TfrmMain.GetTaskTimeAndType(out TaskTimeValue, TaskType: string);
begin
  case rgTaskTime.ItemIndex of
    0:
      begin
        TaskTimeValue := TimeToStr(dtpTaskTimeByDay.Time);
        TaskType := '按天';
      end;
    1:
      begin
        TaskTimeValue := IntToStr(sTxtTaskTimeByHour.Value);
        TaskType := '按时';
      end;
    2:
      begin
        TaskTimeValue := IntToStr(sTxtTaskTimeByMinute.Value);
        TaskType := '按分';
      end;
    3:
      begin
        TaskTimeValue := IntToStr(sTxtTaskTimeBySecond.Value);
        TaskType := '按秒';
      end;
  end;
end;

procedure TfrmMain.BtnStartClick(Sender: TObject);
var
  I: Integer;
begin