u_backup.pas

一个简单的学籍管理软件

unit U_Backup;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, Dialogs,
  Buttons, ExtCtrls, ComCtrls, Db, DBTables, Math, ImgList, U_GlobalVar, 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_Backup = class(TForm)
    WizadNotebook: TNotebook;
    Panel1: TPanel;
    Bevel1: TBevel;
    Btn_Next: TButton;
    Btn_Exit: TButton;
    Btn_Help: TButton;
    Memo_Progress: TMemo;
    ImageList1: TImageList;
    ListView_Disk: TListView;
    Btn_CopyAll: TButton;
    Btn_CopySelected: TButton;
    Label3: TLabel;
    CmbBox_OutType: TComboBox;
    Label4: TLabel;
    Edit_OutPath: TEdit;
    SpBtn_SelectPath: TSpeedButton;
    procedure SpBtn_SelectPathClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    function CheckSetItem: Boolean;
    procedure Btn_ExitClick(Sender: TObject);
    procedure Btn_NextClick(Sender: TObject);
    procedure CmbBox_OutTypeChange(Sender: TObject);
    procedure Edit_OutPathChange(Sender: TObject);
    procedure CalPackageHead; //  计算打包文件头
    procedure AddPFileCtrlList(sFileName: string; Order: integer); //  添加包中各个文件头
    function CopyFileToPackage: Boolean; //  拷贝生成打包文件
    procedure CalFloppyHeadList; //  计算磁盘文件头
    function CopyFloppyFile: Boolean;
    procedure SpBto_SelectPathClick(Sender: TObject);
    procedure Btn_CopyAllClick(Sender: TObject);
    procedure Btn_CopySelectedClick(Sender: TObject);
    procedure ListView_DiskSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure FormShow(Sender: TObject); //  计算打包文件头
  private
  public
    DataDir: string; //  数据路径
    LocalDir: string; //  中间数据路径
    TargetType: integer; //  生成标准数据类别
                             //  0 - 1.44 软盘
                             //  1 - 1.2 软盘
                             //  2 - 指定路径
    TargetSize: integer; //  目标最大容量, 当 TargetType 为
                             //  0 - 1456000
                             //  1 - 1212000
                             //  2 - 取目标路径的最大容量
    TargetDir: string; //  拷贝目标路径
    PackageFileName: string; //  打包文件名
    PackageFileNames: TStrings;
    CompPackFileName: string; //  压缩后打包文件名
    FloppyFileName: string; //  磁盘文件名

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

var
  Fm_Backup: TFm_Backup;
procedure Show_Backup;

implementation

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

procedure Show_Backup;
var
  tmpType: integer;
  tmpPath: string;
begin
  Fm_Backup := TFm_Backup.Create(Application);
  with Fm_Backup do
  try
    tmpType := 0;
    tmpPath := 'A:\';
    if U_OutputParam.Show_OutPutParam(tmpType, tmpPath) then
    begin
      CmbBox_OutType.ItemIndex := tmpType;
      CmbBox_OutTypeChange(CmbBox_OutType);
      Edit_OutPath.Text := tmpPath;
      Edit_OutPathChange(Edit_OutPath);
      ShowModal;
    end;
  finally
    Free;
  end;
end;

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

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

  CmbBox_OutType.ItemIndex := 0;
  TargetType := 0; //  生成标准数据类别
  TargetSize := Floppy144Size; //  目标最大容量, 当 TargetType 为
  TargetDir := 'A:\'; //  拷贝目标路径

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

  Edit_OutPath.Text := TargetDir;
  WizadNotebook.PageIndex := 0;
end;

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

function TFm_Backup.CheckSetItem: Boolean;
begin
  Result := False;
  if CmbBox_OutType.ItemIndex = -1 then
  begin
    U_GlobalProc.Show_ErrorMess('输出类型没有定义。');
    Exit;
  end;
  if Trim(Edit_OutPath.Text) = '' then
  begin
    U_GlobalProc.Show_ErrorMess('输出路径没有定义。');
    Exit;
  end;
  Result := True;
end;

procedure TFm_Backup.CmbBox_OutTypeChange(Sender: TObject);
var
  DiskName: Char;
begin
  case (Sender as TComboBox).ItemIndex of
    - 1, 0: // 1.44 MB
      begin
        (Sender as TComboBox).ItemIndex := 0;
        TargetType := 0; //  生成标准数据类别
        TargetSize := Floppy144Size; //  目标最大容量, 当 TargetType 为
      end;
    1: // 1.2 MB
      begin
        TargetType := 1; //  生成标准数据类别
        TargetSize := Floppy120Size; //  目标最大容量, 当 TargetType 为
      end;
    2: // 指定目录
      begin
        TargetType := 2; //  生成标准数据类别
        if TargetDir <> '' then
        begin
          DiskName := TargetDir[1];
          try
            TargetSize := DiskFree(Integer(DiskName) + 1 - Integer('A'));
            if TargetSize = -1 then
              if DiskName in ['A', 'B'] then
                TargetSize := Floppy120Size
              else
                TargetSize := 0;
          except
            TargetSize := 0;
          end;
        end;
        TargetType := 2; //  生成标准数据类别
      end;
  end;
end;

procedure TFm_Backup.Edit_OutPathChange(Sender: TObject);
var
  DiskName: Char;
begin
  TargetDir := Trim(Edit_OutPath.Text);
  if TargetType = 2 then
  begin
    if TargetDir <> '' then
    begin
      DiskName := TargetDir[1];
      try
        TargetSize := DiskFree(Integer(DiskName) + 1 - Integer('A'));
        if TargetSize = -1 then
          if DiskName in ['A', 'B'] then
            TargetSize := Floppy120Size
          else
            TargetSize := 0;
      except
        TargetSize := 0;
      end;
    end;
  end;
end;

procedure TFm_Backup.CalPackageHead; //  计算打包文件头
var
  i: integer;
  DQuery: TQuery;
  tmS: string;
begin
  DQuery := TQuery.Create(Application);
  with DQuery do
  try
    DatabaseName := SysDbase;
    SQL.Text := 'SELECT TableName FROM dict1 WHERE TableType = 1';
    Open;
    PHead.PFileCount := 0;
    while not Eof do
    begin
      PHead.PFileCount := PHead.PFileCount + 1;
      tmS := FieldByName('TableName').AsString + '.DB';
      AddPFileCtrlList(tmS, PHead.PFileCount);
      Next;
    end;
  finally
    Close;
    Free;
  end;
  PHead.PHeadSize := Sizeof(PHead) +
    PHead.PFileCount * Sizeof(TFileCtrlItem);
  PHead.DataOffset := (PHead.PHeadSize + 511) div 512 * 512;
  for i := 0 to 51 do
    PHead.Information[i] := #0;
end;
//  添加包中各个文件头

procedure TFm_Backup.AddPFileCtrlList(sFileName: string; Order: integer);
var
  i: integer;
  FHandle: integer;
  FSizeHigh: Integer;
  tmpS: string;
begin
  SetLength(PFileCtrlList, Order);
  for i := 1 to Min(Length(sFileName), 56) do
    PFileCtrlList[Order - 1].PFileName[i - 1] := sFileName[i];

  tmpS := DataDir + '\' + sFileName;
  FHandle := FileOpen(tmpS, fmOpenRead or fmShareDenyNone);
  PFileCtrlList[Order - 1].PFileSize :=
    Windows.GetFileSize(FHandle, @FSizeHigh);
  FileClose(FHandle);
  if Order = 1 then
    PFileCtrlList[Order - 1].PFileOffset := 0
  else
    PFileCtrlList[Order - 1].PFileOffset :=
      PFileCtrlList[Order - 2].PFileOffset + PFileCtrlList[Order - 2].PFileSize;
end;

function TFm_Backup.CopyFileToPackage: Boolean; //  拷贝生成打包文件
var
  i, j: integer;
  SHandle, THandle: Integer;
  Buffers: array[0..4095] of Char;
  BlockCount: integer;
  LastBlockSize: integer;
  tmpS: string;
begin
  THandle := FileCreate(LocalDir + '\' + PackageFileName);
  if THandle = -1 then
  begin
    Result := False;
    Exit;
  end;

  FileSeek(THandle, 0, 0);
  FileWrite(THandle, PHead, Sizeof(PHead));
  for i := 0 to Length(PFileCtrlList) - 1 do
    FileWrite(THandle, PFileCtrlList[i], Sizeof(PFileCtrlList[i]));

  for i := 0 to Length(PFileCtrlList) - 1 do
  begin
    tmpS := DataDir + '\' + PFileCtrlList[i].PFileName;
    SHandle := FileOpen(tmpS, fmOpenRead or fmShareDenyNone);
    if SHandle = -1 then
    begin
      Result := False;
      FileClose(THandle);
      Exit;
    end;
    BlockCount := PFileCtrlList[i].PFileSize div 4096;
    LastBlockSize := PFileCtrlList[i].PFileSize mod 4096;
    FileSeek(THandle,
      PFileCtrlList[i].PFileOffset + PHead.DataOffset, 0);
    for j := 1 to BlockCount do
    begin
      FileRead(SHandle, Buffers, 4096);
      FileWrite(THandle, Buffers, 4096);