u_backup.pas

一个简单的学籍管理软件

    end;
    FileRead(SHandle, Buffers, LastBlockSize);
    FileWrite(THandle, Buffers, LastBlockSize);
    FileClose(SHandle);
  end;
  FileClose(THandle);

  Result := True;
end;

procedure TFm_Backup.CalFloppyHeadList; //  计算打包文件头
var
  i: integer;
  CompPackSize, LastFloppySize: integer;
  FHandle: Integer;
  FileMaxSize: integer;
  SerialNos: Double;
begin
  if TargetSize = 0 then
    Exit;
  FHandle := FileOpen(LocalDir + '\' + CompPackFileName,
    fmOpenRead or fmShareDenyNone);

  CompPackSize := Windows.GetFileSize(FHandle, @LastFloppySize);
  FileClose(FHandle);
  FileMaxSize := TargetSize - Sizeof(TFloppyFileHead);

  i := (CompPackSize + FileMaxSize - 1) div FileMaxSize;
  SetLength(FFileHeadList, i);
  LastFloppySize := CompPackSize mod FileMaxSize;

  SerialNos := Now;
  for i := 0 to Length(FFileHeadList) - 2 do
  begin
    with FFileHeadList[i] do
    begin
      ID[0] := 'F';
      ID[1] := 'B';
      ID[2] := 'Z';
      ID[3] := 'G';
      SerialNo := SerialNos;
      FloppyCount := Length(FFileHeadList);
      CurFloppyNo := i + 1;
      FileSize := TargetSize;
    end;
  end;
  i := Length(FFileHeadList) - 1;
  with FFileHeadList[i] do
  begin
    ID[0] := 'F';
    ID[1] := 'B';
    ID[2] := 'Z';
    ID[3] := 'G';
    SerialNo := SerialNos;
    FloppyCount := Length(FFileHeadList);
    CurFloppyNo := i + 1;
    if LastFloppySize = 0 then
      FileSize := TargetSize
    else
      FileSize := LastFloppySize + Sizeof(TFloppyFileHead);
  end;
end;

procedure TFm_Backup.Btn_NextClick(Sender: TObject);
var
  tmpItem: TListItem;
  i: integer;
  tmpS: string;
begin
  WizadNotebook.PageIndex := 0;
  if not CheckSetItem then
    Exit;
  Memo_Progress.Lines.Clear;

  WizadNotebook.PageIndex := 1;
  Memo_Progress.Lines.Add('正在创建中间目录...');
  try
    CreateDir(LocalDir);
  except
    ;
  end;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  Memo_Progress.Lines.Add('正在生成打包文件...');

  tmpS := 'GZ' + S_SchoolName + '.GDB';

  {DM.DB_CurGz.Connected := False;}
  CopyFile(PChar(DataDir + '\' + tmpS), PChar(LocalDir + '\' + tmpS), False);

  {DModule.DB_CurGz.Connected := True;}

  CalPackageHead; //  计算打包文件头
  //AddPFileCtrlList; //  计算包内文件控制信息
  if not CopyFileToPackage then //  拷贝生成打包文件
  begin
    U_GlobalProc.Show_ErrorMess('生成打包文件错误。');
    Exit;
  end;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';
  //  压缩打包文件

  Memo_Progress.Lines.Add('正在压缩打包文件...');
  PackageFileNames := TStringList.Create;
  PackageFileNames.Add(LocalDir + '\' + PackageFileName);
  PackageFileNames.Free;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  Memo_Progress.Lines.Add('正在生成磁盘映象文件...');
  if TargetSize = 0 then
  begin
    U_GlobalProc.Show_ErrorMess('目标盘没有空间。');
    Exit;
  end;

  CalFloppyHeadList;
  if not CopyFloppyFile then
  begin
    U_GlobalProc.Show_ErrorMess('生成磁盘文件错误。');
    Exit;
  end;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  ListView_Disk.Items.Clear;
  for i := 0 to Length(FFileHeadList) - 1 do
  begin
    tmpItem := ListView_Disk.Items.Add;
    tmpItem.ImageIndex := 0;
    tmpItem.Caption := IntToStr(i + 1) + ' 号盘';
    tmpItem.StateIndex := -1;
  end;
  WizadNotebook.PageIndex := 2;
end;

function TFm_Backup.CopyFloppyFile: Boolean; //  计算打包文件头
var
  i, j: integer;
  SHandle, THandle: Integer;
  FloppySize: integer;
  Buffers: array[0..4095] of Char;
  BlockCount: integer;
  LastBlockSize: integer;
begin
  if TargetSize = 0 then
  begin
    Result := False;
    Exit;
  end;
  SHandle := FileOpen(LocalDir + '\' + CompPackFileName,
    fmOpenRead or fmShareDenyNone);
  for i := 0 to Length(FFileHeadList) - 1 do
  begin
    THandle := FileCreate(LocalDir + '\' + FloppyFileName +
      IntToStr(i + 1));
    if THandle = -1 then
    begin
      Result := False;
      FileClose(SHandle);
      Exit;
    end;
    FloppySize := FFileHeadList[i].FileSize - Sizeof(TFloppyFileHead);
    BlockCount := FloppySize div 4096;
    LastBlockSize := FloppySize mod 4096;

    FileWrite(THandle, FFileHeadList[i], Sizeof(FFileHeadList[i]));
    for j := 1 to BlockCount do
    begin
      FileRead(SHandle, Buffers, 4096);
      FileWrite(THandle, Buffers, 4096);
    end;
    if LastBlockSize <> 0 then
    begin
      FileRead(SHandle, Buffers, LastBlockSize);
      FileWrite(THandle, Buffers, LastBlockSize);
    end;
    FileClose(THandle);
  end;
  FileClose(SHandle);
  Result := True;
end;

procedure TFm_Backup.SpBto_SelectPathClick(Sender: TObject);
var
  tmpS: string;
begin
  tmpS := U_SelectDir.Show_SelectDir;
  if tmpS <> '' then
    Edit_OutPath.Text := tmpS;
end;

procedure TFm_Backup.Btn_CopyAllClick(Sender: TObject);
var
  i: integer;
  tmpS: string;
  ErrorCodes: DWORD;
  ErrorFlag: Boolean;
begin
  ErrorFlag := False;
  for i := 0 to Length(FFileHeadList) - 1 do
  begin
    while True do
    begin
      tmpS := Copy(TargetDir, 1, 1) + ':\';
      if tmpS[1] in ['A', 'B'] then
        if Application.MessageBox(PChar('请在 ' + tmpS + ' 中放一张空白软盘，然后按确定按钮'),
          PChar('拷贝第 ' + IntToStr(i + 1) + ' 号盘'), mb_OKCANCEL + mb_IconInformation) = mrCancel then
          Exit;
      TargetDir := Trim(TargetDir);
      if TargetDir[Length(TargetDir)] <> '\' then
        TargetDir := TargetDir + '\';

      if not CopyFile(PChar(LocalDir + '\' + FloppyFileName + IntToStr(i + 1)),
        PChar(TargetDir + FloppyFileName + IntToStr(i + 1)), False) then
      begin
        ErrorCodes := GetLastError;
        case ErrorCodes of
          ERROR_CANNOT_MAKE: tmpS := '不能在 ' + tmpS + ' 盘创建文件，';
          ERROR_ACCESS_DENIED, ERROR_READ_FAULT: tmpS := '磁盘写错误，磁盘损坏，';
          ERROR_WRITE_PROTECT: tmpS := tmpS + ' 盘被写保护，';
          ERROR_DISK_CHANGE, ERROR_NOT_READY: tmpS := '未插入磁盘，';
          ERROR_DISK_CORRUPT: tmpS := '磁盘被损坏，';
          ERROR_DISK_FULL, ERROR_HANDLE_DISK_FULL: tmpS := '磁盘空间满，';
          ERROR_FLOPPY_UNKNOWN_ERROR: tmpS := '未知错误，';
          ERROR_GEN_FAILURE: tmpS := '磁盘写错误，';
        else
          tmpS := '其他错误，';
        end;
        Messagebeep(0);
        if Application.MessageBox(PChar('拷贝失败: ' + tmpS + '重新拷贝吗？'),
          '错误', MB_OKCANCEL + MB_ICONWARNING) = mrCancel then
        begin
          ErrorFlag := True;
          Break;
        end;
      end
      else
      begin
        ListView_Disk.Items.Item[i].ImageIndex := 1; ;
        break;
      end;
    end;
    if ErrorFlag then Break;
  end;
  if not ErrorFlag then
    Application.MessageBox(PChar('拷贝成功。'), '成功', MB_OK + MB_ICONINFORMATION);
end;

procedure TFm_Backup.Btn_CopySelectedClick(Sender: TObject);
var
  i: integer;
  tmpS: string;
  ErrorCodes: DWORD;
  ErrorFlag: Boolean;
begin
  ErrorFlag := False;
  for i := 0 to ListView_Disk.Items.Count - 1 do
  begin
    if not ListView_Disk.Items.Item[i].Selected then
      Continue;

    while True do
    begin
      tmpS := Copy(TargetDir, 1, 1) + ':\';
      if tmpS[1] in ['A', 'B'] then
        if Application.MessageBox(PChar('请在 ' + tmpS + ' 中放一张空白软盘，然后按确定按钮'),
          PChar('拷贝第 ' + IntToStr(i + 1) + ' 号盘'), mb_OKCANCEL + mb_IconInformation) = mrCancel then
          Exit;
      TargetDir := Trim(TargetDir);
      if TargetDir[Length(TargetDir)] <> '\' then
        TargetDir := TargetDir + '\';

      if not CopyFile(PChar(LocalDir + '\' + FloppyFileName + IntToStr(i + 1)),
        PChar(TargetDir + FloppyFileName + IntToStr(i + 1)), False) then
      begin
        ErrorCodes := GetLastError;
        case ErrorCodes of
          ERROR_CANNOT_MAKE: tmpS := '不能在 ' + tmpS + ' 盘创建文件。';
          ERROR_ACCESS_DENIED, ERROR_READ_FAULT: tmpS := '磁盘写错误，磁盘损坏。';
          ERROR_WRITE_PROTECT: tmpS := tmpS + ' 盘被写保护。';
          ERROR_DISK_CHANGE, ERROR_NOT_READY: tmpS := '未插入磁盘。';
          ERROR_DISK_CORRUPT: tmpS := '磁盘被损坏。';
          ERROR_DISK_FULL, ERROR_HANDLE_DISK_FULL: tmpS := '磁盘空间满。';
          ERROR_FLOPPY_UNKNOWN_ERROR: tmpS := '未知错误。';
          ERROR_GEN_FAILURE: tmpS := '磁盘写错误。';
        else
          tmpS := '其他错误';
        end;
        Messagebeep(0);
        if Application.MessageBox(PChar('拷贝失败: ' + tmpS + '，重新拷贝吗？'),
          '错误', MB_OKCANCEL + MB_ICONWARNING) = mrCancel then
        begin
          ErrorFlag := True;
          Break;
        end;
      end
      else
      begin
        ListView_Disk.Items.Item[i].ImageIndex := 1; ;
        break;
      end;
    end;
    if ErrorFlag then Break;
  end;
  if not ErrorFlag then
    Application.MessageBox(PChar('拷贝成功。'), '成功', MB_OK + MB_ICONINFORMATION);
end;

procedure TFm_Backup.ListView_DiskSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if (Sender as TListView).Selected <> nil then
    Btn_CopySelected.Enabled := True
  else
    Btn_CopySelected.Enabled := False;
end;

procedure TFm_Backup.FormShow(Sender: TObject);
begin
  Btn_Next.Click;
end;

end.