ufrmmain.pas

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

  TaskIDList.Clear;
  SystemTimer.Enabled := True;
  TaskTimer.Enabled := True;
  Caption := '数据自动备份软件--[启动中]';
  btnStart.Enabled := False;
  btnStop.Enabled := True;
  //初始化最近备份的时间
  for I := 0 to LvTaskList.Items.Count - 1 do
  begin
    LvTaskList.Items[I].SubItems[6] := DateTimeToStr(Now);
  end;
end;

procedure TfrmMain.BtnStopClick(Sender: TObject);
begin
  SystemTimer.Enabled := False;
  TaskTimer.Enabled := False;
  Caption := '数据自动备份软件--[停止中]';
  btnStart.Enabled := True;
  btnStop.Enabled := False;
end;

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

procedure TfrmMain.btnSysOptionClick(Sender: TObject);
begin
  DoSaveFTPParams;
end;

procedure TfrmMain.DoLoadFTPParams;
var
  sAppPath: string;
  SysOptionIni: TIniFile;
begin
  sAppPath := ExtractFilePath(Application.ExeName) + '_SysOption.ini';
  SysOptionIni := TIniFile.Create(sAppPath);
  try
    TxtFTPServerIP.Text := SysOptionIni.ReadString('SystemOption', 'FTPServerIP', '');
    TxtFTPServerPort.Text := SysOptionIni.ReadString('SystemOption', 'FTPServerPort', '21');
    TxtFTPUserName.Text := SysOptionIni.ReadString('SystemOption', 'FTPUserName', 'Anonymous');
    TxtFTPPassword.Text := SysOptionIni.ReadString('SystemOption', 'FTPPassword', '');
    TxtFTPFileDir.Text := SysOptionIni.ReadString('SystemOption', 'FTPFileDir', '');
  finally
    SysOptionIni.Free;
  end;   
end;

procedure TfrmMain.DoSaveFTPParams;
var
  sAppPath: string;
  SysOptionIni: TIniFile;
begin
  sAppPath := ExtractFilePath(Application.ExeName) + '_SysOption.ini';
  SysOptionIni := TIniFile.Create(sAppPath);
  try
    SysOptionIni.WriteString('SystemOption', 'FTPServerIP', TxtFTPServerIP.Text);
    SysOptionIni.WriteString('SystemOption', 'FTPServerPort', TxtFTPServerPort.Text);
    SysOptionIni.WriteString('SystemOption', 'FTPUserName', TxtFTPUserName.Text);
    SysOptionIni.WriteString('SystemOption', 'FTPPassword', TxtFTPPassword.Text);
    SysOptionIni.WriteString('SystemOption', 'FTPFileDir', TxtFTPFileDir.Text);
  finally
    SysOptionIni.Free;
  end;   
end;

function TfrmMain.GetFileLastModifyDateTime(sFileName: string): TDateTime;
var
    searchRec:TSearchRec;
    found:Integer;
    sModifyTime: string;
    SysModifyTime: SYSTEMTIME;
    dtModifyTime: TDateTime;
begin
    //在查找文件
    found := FindFirst(sFileName,faAnyFile,searchRec);
    if found = 0 then
    begin
      FileTimeToSystemTime(searchRec.FindData.ftLastWriteTime, SysModifyTime);
      dtModifyTime := SystemTimeToDateTime(SysModifyTime);
    end;
    //释放资源
    FindClose(searchRec);
    Result := dtModifyTime;
end;

function TfrmMain.DoPostFileToFTP(sLocalFileName, sServerFileDir, sBackupWay: string): Boolean;
var
  strCurFTPDir: string;
begin
  Result := False;
  if not FileExists(sLocalFileName) then Exit;
  try
    with UpdateFTP do
    begin
      if Connected then
        Disconnect;
      Passive := True;   //PASV适合大部分有FW的场合
                         //PORT适合对方有FW的场合
      Host := TxtFTPServerIP.Text;
      Port := StrToInt(TxtFTPServerPort.Text);
      Username := TxtFTPUserName.Text;
      Password := TxtFTPPassword.Text;
      Connect;  //连接FTP服务器
      strCurFTPDir := RetrieveCurrentDir + '/' + sServerFileDir;  //RetrieveCurrentDir：得到当前目录
      if not SameText(Trim(sServerFileDir), '') then
      begin
        ChangeDir(strCurFTPDir);                   //切换FTP目录
      end;
      //上传文件
      TransferType := ftBinary;
      Put(sLocalFileName, ExtractFileName(sLocalFileName), False);   //上传
    end;
    DoSystemLog('文件：' + sLocalFileName + ' 上传到FTP成功.');
    Result := True;
  except
    DoSystemLog('文件：' + sLocalFileName + ' 上传到FTP失败.');
  end;
end;

procedure TfrmMain.UpdateFTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
//
end;

procedure TfrmMain.UpdateFTPWorkBegin(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
//
end;

procedure TfrmMain.UpdateFTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
//
end;

procedure TfrmMain.UpdateFTPStatus(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: String);
begin
  DoSystemLog(AStatusText);
end;

procedure TfrmMain.DoModifyTask;
var
  I: Integer;
  strTaskName, strBackupWay, strTaskTime, strTaskTimeType, strTaskType, strTaskSaveType, strTaskBackupDest, strSavePath: string;
  NewItem: TListItem;
begin
  //设置任务信息
  strTaskName := Trim(TxtTaskName.Text);
  GetTaskTimeAndType(strTaskTime, strTaskTimeType);
  strTaskType := Trim(cmbBackupType.Text);
  strTaskSaveType := Trim(cmbSaveType.Text);
  strTaskBackupDest := Trim(TxtBackupDest.Text);
  strSavePath := Trim(TxtSavePath.Text);
  strBackupWay := cmbBackupWay.Text;
  //验证任务信息
  if SameText('', strTaskName) then
  begin
    DoShowErrorMessageDlg('请设置[任务名称]信息！');
    Exit;
  end;
  if SameText('', strTaskType) then
  begin
    DoShowErrorMessageDlg('请设置[备份类型]信息！');
    Exit;
  end;
  if SameText('', strTaskSaveType) then
  begin
    DoShowErrorMessageDlg('请设置[保存方式]信息！');
    Exit;
  end;
  if SameText('', strTaskBackupDest) then
  begin
    DoShowErrorMessageDlg('请设置[备份目标]信息！');
    Exit;
  end;
  if SameText('', strSavePath) then
  begin
    if not SameText(cmbSaveType.Text, '异地备份-FTP') then
    begin
      DoShowErrorMessageDlg('请设置[保存目录]信息！');
      Exit;
    end;
  end;
  if SameText('', strBackupWay) then
  begin
    DoShowErrorMessageDlg('请设置[备份方式]信息！');
    Exit;
  end;
  //修改信息
  NewItem := nil;
  for I := 0 to LvTaskList.Items.Count - 1 do
  begin
    if SameText(UpperCase(LvTaskList.Items[I].Caption), UpperCase(strTaskName)) then
    begin
      NewItem := LvTaskList.Items[I];
      Break;
    end;
  end;
  if NewItem = nil then
  begin
    DoSystemLog('修改[' + strTaskName + ']任务信息失败，可能该任务不存在.');
    Exit;
  end;
  if SameText(strTaskType, '备份文件') or SameText(strTaskType, '备份目录') then NewItem.ImageIndex := 0
  else NewItem.ImageIndex := 1;
  NewItem.Caption := strTaskName;
  NewItem.SubItems.Strings[0] := strTaskTime;
  NewItem.SubItems.Strings[1] := strTaskType;
  NewItem.SubItems.Strings[2] := strTaskSaveType;
  NewItem.SubItems.Strings[3] := strTaskBackupDest;
  NewItem.SubItems.Strings[4] := strSavePath;
  NewItem.SubItems.Strings[5] := strTaskTimeType;
  if SameText(strTaskTimeType, '按天') then
    NewItem.SubItems.Strings[6] := DateTimeToStr(Now);
  if SameText(strTaskTimeType, '按时') then
    NewItem.SubItems.Strings[6] := DateTimeToStr(Now);
  if SameText(strTaskTimeType, '按分') then
    NewItem.SubItems.Strings[6] := DateTimeToStr(Now);
  if SameText(strTaskTimeType, '按秒') then
    NewItem.SubItems.Strings[6] := DateTimeToStr(Now);
  NewItem.SubItems.Strings[7] := strBackupWay;

  DoSystemLog('修改[' + strTaskName + ']任务信息成功.');
  //保存任务列表
  DoSaveTaskList;
end;

procedure TfrmMain.btnModifyTaskClick(Sender: TObject);
begin
  DoModifyTask;
end;

procedure TfrmMain.LvTaskListDblClick(Sender: TObject);
var
  objItem: TListItem;
begin
  if LvTaskList.Items.Count = 0 then Exit;
  objItem := LvTaskList.Selected;
  if objItem = nil then Exit;
  TxtTaskName.Text := objItem.Caption;
  if SameText(objItem.SubItems.Strings[5], '按天') then
  begin
    dtpTaskTimeByDay.Time := StrToTime(objItem.SubItems.Strings[0]);
    rgTaskTime.ItemIndex := 0;
  end;
  if SameText(objItem.SubItems.Strings[5], '按时') then
  begin
    sTxtTaskTimeByHour.Value := StrToInt(objItem.SubItems.Strings[0]);
    rgTaskTime.ItemIndex := 1;
  end;
  if SameText(objItem.SubItems.Strings[5], '按分') then
  begin
    sTxtTaskTimeByMinute.Value := StrToInt(objItem.SubItems.Strings[0]);
    rgTaskTime.ItemIndex := 2;
  end;
  if SameText(objItem.SubItems.Strings[5], '按秒') then
  begin
    sTxtTaskTimeBySecond.Value := StrToInt(objItem.SubItems.Strings[0]);
    rgTaskTime.ItemIndex := 3;
  end;
  cmbBackupType.Text := objItem.SubItems.Strings[1];
  cmbSaveType.Text := objItem.SubItems.Strings[2];
  TxtBackupDest.Text := objItem.SubItems.Strings[3];
  TxtSavePath.Text := objItem.SubItems.Strings[4];
  cmbBackupWay.Text := objItem.SubItems.Strings[7];
end;

procedure TfrmMain.N1Click(Sender: TObject);
begin
  SystemLog.Lines.Clear;
end;

procedure TfrmMain.N2Click(Sender: TObject);
var
  SaveDlg: TSaveDialog;
begin
  SaveDlg := TSaveDialog.Create(nil);
  try
    SaveDlg.Filter := '日志文件(*.log)|*.log|全部文件(*.*)|*.*';
    SaveDlg.DefaultExt := '*.log';
    if SaveDlg.Execute then
    begin
      if Trim(SaveDlg.FileName) <> '' then
      begin
        SystemLog.Lines.SaveToFile(Trim(SaveDlg.FileName));
        Application.MessageBox('成功导出日志信息.', '提示', MB_OK + MB_ICONINFORMATION);
      end;
    end;
  finally
    SaveDlg.Free;
  end;
end;

procedure TfrmMain.cmbSaveTypeChange(Sender: TObject);
begin
  if SameText(cmbSaveType.Text, '异地备份-FTP') then
  begin
    TxtSavePath.Enabled := False;
    TxtSavePath.Color := clBtnFace;
    TxtSavePath.Text := ExtractFilePath(Application.ExeName);
  end
  else
  begin
    TxtSavePath.Enabled := True;
    TxtSavePath.Color := clWindow;
    TxtSavePath.Text := '';
  end;
end;

end.