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

📄 u_restore.pas

📁 一个简单的学籍管理软件
💻 PAS
字号:
unit U_Restore;
                    
interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, Dialogs,
  Buttons, ExtCtrls, U_GlobalVar, ComCtrls, Db, DBTables, Math, ImgList,
  backup;

type
 { //  打包文件头定义, 共64个字节
  TPackAgeHead = Record
    PHeadSize:   integer;      //  文件头总长度
    PFileCount:  integer;      //  包含文件总数
    DataOffset:  integer;      //  打包文件数据偏移量
    Information: Array[0..51] of char;  //  附加信息
  end;

  //  打包文件控制项定义, 共32个字节
  TFileCtrlItem = Record
    PFileName:   Array[0..55] of char;  //  文件名
    PFileSize:   Integer;      //  文件大小
    PFileOffset: Integer;      //  文件数据相对偏移量
  end;

  //  磁盘文件头
  TFloppyFileHead = Record
    ID:          Array[0..3] of char;    //  文件标志, 正常为 ZHCS 四个字符
    SerialNo:    Double;      //  序列号
    FloppyCount: Smallint;     //  磁盘总数
    CurFloppyNo: Smallint;     //  当前磁盘号
    FileSize:    integer;      //  文件大小
    Information: Array[0..43] of char;  //  附加信息
  end;  }

  TFm_Restore = class(TForm)
    WizadNotebook: TNotebook;
    Panel1: TPanel;
    Bevel1: TBevel;
    Btn_ReCopy: TButton;
    Btn_BeginDraw: TButton;
    Btn_Exit: TButton;
    Btn_Help: TButton;
    Memo_Progress: TMemo;
    ImageList1: TImageList;
    Memo_TableList: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Btn_ExitClick(Sender: TObject);
    procedure Btn_ReCopyClick(Sender: TObject);
    function CopyFloppy: Boolean;
    function LinkFloppy: Boolean;
    function DePackage: Boolean;
    function SetRestoreFiles: Boolean;
    procedure Btn_BeginDrawClick(Sender: TObject);
    procedure Memo_TableListKeyPress(Sender: TObject; var Key: Char);
    procedure Memo_TableListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
  public
    DataDir: string; //  数据路径
    LocalDir: string; //  中间数据路径
    SourceSize: integer; //  目标最大容量, 当 TargetType 为
                             //  0 - 1457664
                             //  1 - 1213952
                             //  2 - 取目标路径的最大容量
    SourceDir: string; //  拷贝目标路径
    PackageFileName: string; //  打包文件名, 缺省为 'BZSJ'+s_g_ztdm
    CompPackFileName: string; //  压缩后打包文件名, 缺省为 'BZSJ'+s_g_ztdm + '.pck'
    FloppyFileName: string; //  磁盘文件名, 为 'BZSJFLOPPY'+盘号

    PHead: TPackAgeHead; //  打包文件头
    PFileCtrlList: array of TFileCtrlItem; //  包含文件控制列表
    FFileHeadList: array of TFloppyFileHead; //  磁盘文件头列表
    ErrorFlag: Boolean;
  end;

//  function LZWUnCompress( SourceFileName: PChar; TargetFileName: PChar ): integer; stdcall;
//  function LZWCompress( SourceFileName: PChar; TargetFileName: PChar ): integer; stdcall;

var
  Fm_Restore: TFm_Restore;
procedure Show_Restore;

implementation

uses U_GlobalProc, U_SelectDir, U_DM, U_CopyFloppy, U_Main;
{$R *.DFM}

procedure Show_Restore;
var
  i: integer;
begin
  for i := Fm_Main.MDIChildCount - 1 downto 0 do
    Fm_Main.MDIChildren[i].Close;

  Fm_Restore := TFm_Restore.Create(Application);
  with Fm_Restore do
  try
    Btn_ReCopy.Click;
    if not ErrorFlag then
      ShowModal;
  finally
    Free;
  end;
end;

procedure TFm_Restore.FormCreate(Sender: TObject);
begin
  DataDir := S_DataPath; //  数据路径
  LocalDir := S_TmpPath; //  中间数据路径

  SourceSize := 0; //  源最大容量
  SourceDir := 'A:\'; //  拷贝源路径

  PackageFileName := 'BFSJ'; // + s_g_ztdm;
                          //  打包文件名, 缺省为 'BZSJ'+s_g_ztdm
  CompPackFileName := PackageFileName + '.pck';
                          //  压缩后的打包文件名, 缺省为 'BZSJ'+s_g_ztdm
  FloppyFileName := 'BFDISK'; //  磁盘文件名, 为 'BZDISK'+盘号

  WizadNotebook.PageIndex := 0;
end;

procedure TFm_Restore.Btn_ExitClick(Sender: TObject);
begin
  Close;
end;

function TFm_Restore.CopyFloppy: Boolean;
var
  FloppyCount, CurFloppy: integer;
  SerialNos: Double;
  SFile: string;
  tmpS: string;
  ErrorFlag: Boolean;
  ErrorCodes: DWord;
  FHandle: Integer;
begin
  FloppyCount := 1;
  CurFloppy := 1;
  SerialNos := -1;
  SetLength(FFileHeadList, 1);
  Result := True;
  ErrorFlag := False;
  SourceDir := 'A:\';

  while True do
  begin
    if (SourceDir = '') or (SourceDir[1] in ['A', 'B']) then
    begin
      if not U_CopyFloppy.Show_CopyFloppy(SourceDir, CurFloppy) then
      begin
        Result := False;
        Exit;
      end;
      ErrorFlag := False;
    end;
    if SourceDir[Length(SourceDir)] <> '\' then
      SourceDir := SourceDir + '\';
    SFile := SourceDir + FloppyFileName + IntToStr(CurFloppy);
    if FileExists(SFile) then
    begin
      FHandle := FileOpen(SFile, fmOpenRead or fmShareDenyNone);
      if FHandle = -1 then
      begin
        tmpS := '读备份数据 ' + IntToStr(CurFloppy) + ' 号盘错误, ';
        ErrorFlag := True;
      end;
      if FileRead(FHandle, FFileHeadList[CurFloppy - 1], Sizeof(FFileHeadList[CurFloppy - 1])) = -1 then
      begin
        tmpS := '读备份数据 ' + IntToStr(CurFloppy) + ' 号盘错误, ';
        ErrorFlag := True;
      end;
      FileClose(FHandle);
      if not ErrorFlag then
      begin
        if (SerialNos <> FFileHeadList[CurFloppy - 1].SerialNo) and
          (SerialNos <> -1) then
        begin
          tmpS := '备份数据 ' + IntToStr(CurFloppy) + ' 号盘序列号错误, ';
          ErrorFlag := True;
        end;
        if not ErrorFlag then
        begin
          if CurFloppy <> FFileHeadList[CurFloppy - 1].CurFloppyNo then
          begin
            tmpS := '不是备份数据 ' + IntToStr(CurFloppy) + ' 号盘, ';
            ErrorFlag := True;
          end
          else
          begin
            FloppyCount := FFileHeadList[CurFloppy - 1].FloppyCount;
            if CurFloppy = 1 then
              SetLength(FFileHeadList, FloppyCount);
            if SerialNos = -1 then
              SerialNos := FFileHeadList[CurFloppy - 1].SerialNo;
          end;
        end;
      end;
    end
    else
    begin
      tmpS := '没有发现备份数据 ' + IntToStr(CurFloppy) + ' 号盘, ';
      ErrorFlag := True;
    end;

    if not ErrorFlag then
    begin
      if not CopyFile(PChar(SFile),
        PChar(LocalDir + '\' + FloppyFileName + IntToStr(CurFloppy)), False) then
      begin
        ErrorFlag := True;
        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;
      end;
    end;
    if ErrorFlag then
    begin
      Messagebeep(0);
      if Application.MessageBox(PChar('拷贝失败: ' + tmpS + '重新拷贝吗?'),
        '错误', MB_OKCANCEL + MB_ICONWARNING) = mrCancel then
        Break
      else
      begin
        ErrorFlag := False;
      end;
    end
    else
    begin
      if CurFloppy = FloppyCount then
        Break;
      Inc(CurFloppy);
    end;
  end;
  if ErrorFlag then
    Result := False;
end;

function TFm_Restore.LinkFloppy: Boolean;
var
  SFile: string;
  tmpS: string;
  ErrorFlag: Boolean;
  SHandle, THandle: Integer;
  i, j: integer;
  BlockCount, LastBlockSize: integer;
  Buffers: array[0..4095] of char;
begin
  ErrorFlag := False;
  Result := True;
  THandle := FileCreate(LocalDir + '\' + CompPackFileName);
  for i := 0 to Length(FFileHeadList) - 1 do
  begin
    SFile := LocalDir + '\' + FloppyFileName + IntToStr(i + 1);

    if FileExists(SFile) then
    begin
      SHandle := FileOpen(SFile, fmOpenRead or fmShareDenyNone);
      if SHandle = -1 then
      begin
        tmpS := '读备份数据 ' + IntToStr(i + 1) + ' 号盘错误, ';
        ErrorFlag := True;
        Break;
      end;
    end
    else
    begin
      tmpS := '没有发现备份数据 ' + IntToStr(i + 1) + ' 号盘, ';
      ErrorFlag := True;
      Break;
    end;
    BlockCount := (FFileHeadList[i].FileSize - Sizeof(TFloppyFileHead)) div 4096;
    LastBlockSize := (FFileHeadList[i].FileSize - Sizeof(TFloppyFileHead)) mod 4096;

    FileSeek(SHandle, Sizeof(TFloppyFileHead), 0);
    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(SHandle);
  end;
  FileClose(THandle);
  if ErrorFlag then
    Result := False;
end;

function TFm_Restore.DePackage: Boolean;
var
  TFile: string;
  tmpS: string;
  //ErrorFlag: Boolean;
  SHandle, THandle: Integer;
  i, j: integer;
  BlockCount, LastBlockSize: integer;
  Buffers: array[0..4095] of char;
begin
  ErrorFlag := False;
  Result := True;
  SHandle := FileOpen(LocalDir + '\' + PackageFileName, fmOpenRead or fmShareDenyNone);
  if SHandle = -1 then
  begin
    Result := False;
    tmpS := '没发现备份数据。';
    ErrorFlag := True;
    Exit;
  end;
  FileRead(SHandle, PHead, Sizeof(TPackAgeHead));
  SetLength(PFileCtrlList, PHead.PFileCount);
  //  读文件控制头
  for i := 0 to PHead.PFileCount - 1 do
    FileRead(SHandle, PFileCtrlList[i], Sizeof(TFileCtrlItem));

  for i := 0 to PHead.PFileCount - 1 do
  begin
    TFile := LocalDir + '\' + PFileCtrlList[i].PFileName;
    THandle := FileCreate(TFile);

    BlockCount := PFileCtrlList[i].PFileSize div 4096;
    LastBlockSize := PFileCtrlList[i].PFileSize mod 4096;
    FileSeek(SHandle,
      PFileCtrlList[i].PFileOffset + PHead.DataOffset, 0);
    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);
  if ErrorFlag then
    Result := False;
end;

procedure TFm_Restore.Btn_ReCopyClick(Sender: TObject);
begin
  ErrorFlag := False;
  Btn_BeginDraw.Enabled := False;
  WizadNotebook.PageIndex := 0;

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

  Memo_Progress.Lines.Add('正在拷贝备份数据盘...');
  if not CopyFloppy then
  begin
    with Memo_Progress.Lines do
      Strings[Count - 1] := Strings[Count - 1] + ' 失败。';
    ErrorFlag := True;
    Exit;
  end;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  Memo_Progress.Lines.Add('正在连接备份数据盘...');
  if not LinkFloppy then
  begin
    with Memo_Progress.Lines do
      Strings[Count - 1] := Strings[Count - 1] + ' 失败。';
    ErrorFlag := True;
    Exit;
  end;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  Memo_Progress.Lines.Add('正在解压缩备份数据盘...');
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  Memo_Progress.Lines.Add('正在分解备份数据...');
  if not DePackage then
  begin
    with Memo_Progress.Lines do
      Strings[Count - 1] := Strings[Count - 1] + ' 失败。';
    ErrorFlag := True;
    Exit;
  end;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  Memo_Progress.Lines.Add('正在查找恢复文件...');
  if not SetRestoreFiles then
  begin
    with Memo_Progress.Lines do
      Strings[Count - 1] := Strings[Count - 1] + ' 失败。';
    ErrorFlag := True;
    Exit;
  end;
  with Memo_Progress.Lines do
    Strings[Count - 1] := Strings[Count - 1] + ' 成功。';

  WizadNotebook.PageIndex := 1;
  Btn_BeginDraw.Enabled := True;
end;

function TFm_Restore.SetRestoreFiles: Boolean;
var
  i: integer;
begin
  Result := True;
  Memo_TableList.Lines.Clear;
  Memo_TableList.Lines.Add('备份数据有以下数据表:');
  for i := 0 to PHead.PFileCount - 1 do
    Memo_TableList.Lines.Add(PFileCtrlList[i].PFileName);
end;

procedure TFm_Restore.Btn_BeginDrawClick(Sender: TObject);
var
  DQuery: TQuery;
  i: integer;
  tmS: string;
begin
  Errorflag := False;

  if not U_GlobalProc.Show_ConfirmMess(
    '恢复将全部覆盖当前数据,继续吗?') then
  begin
    U_GlobalProc.Show_ErrorMess('恢复失败:用户中断。');
    Exit;
  end;
  //  删除旧数据
  Fm_DM.DB_Sys.Connected := False;
  Fm_DM.Db_Data.Connected := False;
  CreateDir(S_DataPath + 'Bck');
  U_GlobalProc.MoveDirFile(S_DataPath, S_DataPath + 'Bck');

  CreateDir(S_DataPath);

  Fm_DM.DB_Sys.Connected := True;
  Fm_DM.Db_Data.Connected := True;

  DQuery := TQuery.Create(Self);
  try
    with DQuery do
    begin
      DatabaseName := DataDBase;
      for i := 0 to PHead.PFileCount - 1 do
      begin
        tmS := PFileCtrlList[i].PFileName;
        tmS := Copy(tmS, 1, Pos('.', tmS) - 1);
        DQuery.SQL.Text := 'INSERT INTO ' + tmS + ' SELECT * FROM ' +
          ' "' + S_TmpPath + '\' + PFileCtrlList[i].PFileName + '" ';
        ExecSQL;
      end;
    end;
    DQuery.Free;
    U_GlobalProc.Show_InfoMess('恢复数据完成,必须重新启动本系统,按确定关闭本系统。');
    Application.Terminate;
  except
    DQuery.Free;
    Fm_DM.DB_Sys.Connected := False;
    Fm_DM.Db_Data.Connected := False;

    U_GlobalProc.DelDirFile(S_DataPath);
    CreateDir(S_DataPath);
    U_GlobalProc.MoveDirFile(S_DataPath + 'Bck', S_DataPath);

    Fm_DM.DB_Sys.Connected := True;
    Fm_DM.Db_Data.Connected := True;
  end;
end;

procedure TFm_Restore.Memo_TableListKeyPress(Sender: TObject;
  var Key: Char);
begin
  Key := #0;
end;

procedure TFm_Restore.Memo_TableListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key in [VK_DELETE, VK_INSERT] then
    Key := 0;
end;

end.

⌨️ 快捷键说明

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