unit FileArchiver;

interface

uses
  Windows, SysUtils, Classes, Archiver, ADODB, ArchiverRoot, CustExtractor,
  CustArchiver, ScUtils, ScConsts, ScStreamArchiver, Forms;

const
  // 项目文件密码
  P1 = '4鲐;d煬t埏釫`u賌骔??粌胧';
  PA1: array [0..31] of Byte =
    ($34, $F6, $D8, $0C, $3B, $64, $9F, $AC, $AF, $BF, $1A, $14, $04, $74, $DB, $EF,
     $E2, $45, $60, $75, $D9, $5E, $F3, $57, $CC, $3F, $0F, $1A, $BB, $83, $EB, $CA);
  // 定额库文件密码
  P2 = '4鲐;d煬彉感愄蝼鹨蠁?>>';
  PA2: array [0..23] of Byte =
    ($34, $F6, $D8, $0C, $3B, $64, $9F, $AC, $8F, $98, $B8, $D0, $90, $CC, $F2, $F7,
     $F0, $D2, $CF, $86, $DC, $3E, $3E, $10);
  // 费率文件密码
  P3 = '4鲐;d煬1`he椚.苮鷹?	';
  PA3: array [0..23] of Byte =
    ($34, $F6, $D8, $0C, $3B, $64, $9F, $AC, $31, $60, $68, $65, $97, $C8, $2E, $C6,
     $78, $FA, $97, $8D, $1E, $09, $FA, $FD);
  // 单价文件密码
  P4 = '4鲐;d煬P辑 5EＢ?;?<A';
  PA4: array [0..23] of Byte =
    ($34, $F6, $D8, $0C, $3B, $64, $9F, $AC, $50, $BC, $AD, $20, $35, $45, $A3, $C2,
     $11, $CB, $3B, $9D, $3C, $41, $19, $19);
  // 清单参数文件密码
  P5 = '4鲐;d煬鶉$査9擎趢?槤C';
  PA5: array [0..23] of Byte =
    ($34, $F6, $D8, $0C, $3B, $64, $9F, $AC, $F9, $87, $06, $24, $96, $CB, $39, $C7,
     $E6, $DA, $80, $E2, $7F, $98, $9D, $43);
  // 报表模板文件密码
  P6 = '4鲐;d煬0痤踿8镊<x伡垁Zx鷹?	';
  PA6: array [0..31] of Byte =
    ($34, $F6, $D8, $0C, $3B, $64, $9F, $AC, $30, $08, $F0, $EE, $DB, $80, $38, $C4,
     $F7, $3C, $78, $81, $BC, $88, $80, $5A, $78, $FA, $97, $8D, $1E, $09, $FA, $FD);
  // 标准文件密码
  P7 = '4鲐;d煬?漸琕13鴦︷?#Z';
  PA7: array [0..23] of Byte =
    ($34, $F6, $D8, $0C, $3B, $64, $9F, $AC, $B6, $06, $9D, $75, $AC, $56, $31, $33,
     $14, $F8, $84, $A6, $F0, $8E, $23, $5A);

  FakeFileExts: array [0..6] of string = ('.jpg', '.dll', '.exe', '.bpl', '.bmp', '.cnt', '.dde');

  ConstBackupFilePrefix = '【S】';
{
文件版本：
  清单，预算：1.1.0.1：，增加了文件加密。添加了材料计算表，修改了其他一些字段
              1.1.0.2：在MaterialTransPrice和MaterialOrgPrice表中添加了LibID字段

}
  // 文件中的版本相关信息
  ConstProductName = 'SmartCost';
  ConstProduct9Name = 'SmartCost9';
  ConstBillsEditorName = 'BillsEditor';
  ConstProductVersion = '8.0';
  // 增加了Alias
  ConstProductVersion87 = '8.7';

  ConstLineVersion = '8.6.3.0';
{
  ConstBillsFileVersion = '1.2.7.9';
  ConstBudgetFileVersion = '1.2.7.9';
  ConstEstimateFileVersion = '1.2.7.9';
  ConstRationLibFileVersion = '1.2.5.8';
}
  ConstBillsFileVersion = '9.1.0.84';
  ConstBudgetFileVersion = '9.1.0.84';
  ConstEstimateFileVersion = '7.2.0.5';
  ConstRationLibFileVersion = '9.0.0.1';

  ConstFeeRateFileVersion = '8.7.0.0';
  ConstUnitPriceFileVersion = '9.0.0.0';
  ConstBillsFairyFileVersion = '1.0.0.1';
  ConstReportsTemplateFileVersion = '1.0.0.1';
  ConstCommonDataFileVersion = '1.0.0.1';
  ConstCommonStreamFileVersion = '1.0.0.1';

  // 原始MDB文件头
  MDBOrgHead: array [0..15] of Byte =
    ($00, $01, $00, $00, $53, $74, $61, $6E, $64, $61, $72, $64, $20, $4A, $65, $74);
  // 伪装MDB文件头
  MDBNewHead: array [0..15] of Char =
    ('-', 's', 'm', 'a', 'r', 't', ' ', 'f', 'i', 'l', 'e', ' ', 'f', 'r', 'e', 'e');
  MDBNewHeadZero: array [0..60] of Byte =
    ($00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
     $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
     $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
     $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00);

(*{$IFDEF _ScBudget}
  {$IFDEF _ScEstimate}
  var
    ConstProjectFileVersion: string = ConstEstimateFileVersion;
  {$ELSE}
  var
    ConstProjectFileVersion: string = ConstBudgetFileVersion;
  {$ENDIF}
{$ENDIF}
{$IFDEF _ScBills}
var
  ConstProjectFileVersion: string = ConstBillsFileVersion;
{$ENDIF}*)
var
  ConstProjectFileVersion: string = ConstBillsFileVersion;



type
  EScFileSystem = class(Exception);

  // 文件头信息
{1.0.0.1}
{  TScFileHead = packed record
    ProductName: string[20];
    ProductVersion: string[20];
    // 1:ProjectFile; 2:RationLib; 3:FeeRate; 4:UnitPrice
    FileType: Integer;
    FileVersion: string[20];
    Reserve: array [0..2047] of Char;
  end;}

{1.0.1.1}
{  TScFileHead = packed record
    ProductName: string[20];
    ProductVersion: string[20];
    // 1:ProjectFile; 2:RationLib; 3:FeeRate; 4:UnitPrice
    FileType: Integer;
    FileVersion: string[20];
    // 项目文件类型：0：清单项目文件；1：预算项目文件(文件版本1.0.1.1添加)
    ProjectFileType: Integer;
    ReadOnly: Boolean;
    // 系统自带的标准文件
    IsSysFile: Boolean;
    Reserve: array [0..2041] of Char;
  end;}

{1.1.0.1}
{  TScFileHead = packed record
    ProductName: string[20];
    ProductVersion: string[20];
    // 1:ProjectFile; 2:RationLib; 3:FeeRate; 4:UnitPrice
    FileType: Integer;
    FileVersion: string[20];
    // 项目文件类型：0：清单项目文件；1：预算项目文件(文件版本1.0.1.1添加)
    ProjectFileType: Integer;
    ReadOnly: Boolean;
    // 系统自带的标准文件
    IsSysFile: Boolean;
    HasPassword: Boolean;
    Password: string[32];
    Reserve: array [0..2007] of Char;
  end;}

{7.1.6.0以前版本的老文件头}
  TScFile7Head = packed record
    ProductName: string[20];
    ProductVersion: string[20];
    // 1:ProjectFile; 2:RationLib; 3:FeeRate; 4:UnitPrice
    FileType: Integer;
    FileVersion: string[20];
    // 项目文件类型：0：清单项目文件；
    //               1：预算/概算项目文件(文件版本1.0.1.1添加);
    //               2: 可行性估算；
    //               3. 建议估算
    ProjectFileType: Integer;
    ReadOnly: Boolean;
    // 系统自带的标准文件
    IsSysFile: Boolean;
    HasPassword: Boolean;
    Password: string[32];
    // 表示文件是否本地文件的ID
    LocationID: TGUID;
    ReportProperties: array [0..255] of Char;
    // 加密锁类型
    DogType: Byte;
    // 加密锁版本（学习版固定为FF）
    DogEdition: Byte;
    // 加密锁序列号
    SerialNo: array [0..31] of Char;
    Reserve: array [0..1991 - 256 - 34 - 95] of Char;
    RandomData: array [0..94] of Char;
  end;

  PScFile7Head = ^TScFile7Head;

  // [2007-12-11][zhangyin] 8.0新文件头, 最后的Reserve字段长度增加，并且以随机字符填充，扰乱以前的加密
  TScFileHead = packed record
    ProductName: string[20];
    ProductVersion: string[20];
    // 1:ProjectFile; 2:RationLib; 3:FeeRate; 4:UnitPrice
    // 8: 固化清单 7:的固化清单只用在十天高速项目
    FileType: Integer;
    FileVersion: string[20];
    // 项目文件类型：0：清单项目文件；
    //               1：预算/概算项目文件(文件版本1.0.1.1添加);
    //               2: 可行性估算；
    //               3. 建议估算
    ProjectFileType: Integer;
    ReadOnly: Boolean;
    // 系统自带的标准文件
    IsSysFile: Boolean;
    HasPassword: Boolean;
    Password: string[32];
    // 表示文件是否本地文件的ID
    LocationID: TGUID;
    ReportProperties: array [0..255] of Char;
    // 加密锁类型
    DogType: Byte;
    // 加密锁版本（学习版固定为FF）
    DogEdition: Byte;
    // 加密锁序列号
    SerialNo: array [0..31] of Char;
    // ------ 以上属性7.x和8.x一样 ------------
    // 用户编辑版本(8.7以前版本无此属性)
    UserVersion: Integer;
    // 文件别名(8.7以前版本无此属性)
    Alias: string[255];
    // 建设项目名称(8.7以前版本无此属性)
    OwnerAlias: string[255];
    // Exe版本号
    ExeVersion: string[20];
    // 基线版本号，低于此版本号的exe不能打开本文件
    LineVersion: string[20];
    // 固化清单，再添加3个属性。加上上面的FileType=8，那么固化清单文件有4个地方别人不同
    SourceBPName: string[255];    // 源文件所属的建设项目名称
    SourceName: string[255];      // 源文件的别名
    SourceFileName: string[255];  // 源文件的文件名字，是一个GUID MD5加密
    ExportedStaticBills: Integer; // 是否导出过固化清单  1:已经导出过
    OpenFileDogNumber: array [0..15] of Byte; // 记录文件被那些加密狗打开过
    Reserve: array [0..1558] of Char;
    //Reserve: array [0..2346] of Char;
    RandomData: array [0..94] of Char;
  end;

  PScFileHead = ^TScFileHead;

  // 该类设计为必须按照先解压打开，再压缩关闭的顺序执行
  TScFileArchiver = class(TObject)
  private
    FFileName: string;
    FFileOpened: Boolean;
    FFile7Info: TScFile7Head;
    FFileInfo: TScFileHead;
    FIsOldFile: Boolean;
    FOriginalFileVersion: string;
    FOnAliasChanged: TNotifyEvent;
    FNeedCheckExeVersion: Boolean;
    procedure SetFileName(const Value: string);
    function IsArchiveEmpty: Boolean;
    procedure DoOnArchiverNeedKey(Sender: TObject; var Key: string);
    procedure SetIsStdFile(const Value: Boolean);
    procedure SetReadOnly(const Value: Boolean);
    function GetIsStdFile: Boolean;
    function GetReadOnly: Boolean;
    function GetIsLocalFile: Boolean;
    procedure SetIsLocalFile(const Value: Boolean);
    function GetUserVersion: Integer;
    function GetAlias: string;
    function GetOwnerAlias: string;
    procedure SetAlias(const Value: string);
    procedure SetOwnerAlias(const Value: string);
  protected
    FFileIdx: Integer;
    FFileSize: Integer;
    FKey: string;
    FArchiver: TArchiver;
    FExtractFile, FTempFile: string;
    FPrepareFile: string;
    FBackupFile: string;
    FFileAttr: Integer;
    function TempFileName: string; virtual;
    function ExtractFileName: string; virtual;
    function ArchiveFile: Boolean; virtual;
    function ExtractFile: Boolean; virtual;
    procedure CreateBackupFile; virtual;
    procedure DeleteBackupFile; virtual;
    procedure RandomFillHead;virtual;
    procedure ReadAndRemoveHead; virtual;
    procedure WriteAndAddHead; virtual;
    function NeedCheckPassWord: Boolean; virtual;
    procedure InternalSetPassWord(APwd: string); virtual;
    function IsNewerExeFile: Boolean; virtual;
//    property Key: string write FKey;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function OpenFile: Boolean; virtual;
    function CloseFile: Boolean; virtual;
    function Refresh: Boolean; virtual;
    function Save: Boolean; virtual;
    function SaveTo(AFileName: string): Boolean; virtual;
    procedure SaveHead;
    function SetPassWord: Boolean; virtual;
    procedure ClearPassWord; virtual;
    procedure SetFileVer(AVer: string);
    procedure UpdateUserVersion;
    // 固化清单 6-26
    procedure ResetSourceFileName(sGUID: string);
    property FileName: string read FFileName write SetFileName;
    property IsOpened: Boolean read FFileOpened;
    property FileInfo: TScFileHead read FFileInfo;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    property IsStdFile: Boolean read GetIsStdFile write SetIsStdFile;
    property IsLocalFile: Boolean read GetIsLocalFile write SetIsLocalFile;
    property UserVersion: Integer read GetUserVersion;
    property Alias: string read GetAlias write SetAlias;
    property NeedCheckExeVersion: Boolean read FNeedCheckExeVersion write FNeedCheckExeVersion;
    property OwnerAlias: string read GetOwnerAlias write SetOwnerAlias;
    property OriginalFileVersion: string read FOriginalFileVersion;
    // event
    property OnAliasChanged: TNotifyEvent read FOnAliasChanged write FOnAliasChanged; 
  end;

  TScMDBArchiver = class(TScFileArchiver)
  private
    FFakeFiles: TStringList;
    FConnection: TADOConnection;
    FInnerConnection: TADOConnection;
    procedure SetConnection(const Value: TADOConnection);
    procedure EncryptMDB(AFile: string);
    procedure DecryptMDB(AFile: string);
    procedure CreateFakeFiles;
    procedure DeleteFakeFiles;
    function GetConnection: TADOConnection;
    function CompactDatabase(AFileName: string): Boolean;
  protected
    procedure Decrypt; virtual;
    procedure Encrypt; virtual;
    function ArchiveFile: Boolean; override;
    function ExtractFile: Boolean; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    function OpenFile: Boolean; override;
    function CloseFile: Boolean; override;
    function Refresh: Boolean; override;
    property Connection: TADOConnection read GetConnection write SetConnection;
  end;

  TScProjectFileArchiver = class(TScMDBArchiver)
  protected
    function IsNewerExeFile: Boolean; override;
  public
    constructor Create; override;
    procedure SetProjectFileType(AType: Integer);
  end;

  TScRationLibArchiver = class(TScMDBArchiver)
  protected
    function NeedCheckPassWord: Boolean; override;
  public
    constructor Create; override;
  end;

  TScFeeRateFileArchiver = class(TScMDBArchiver)
  protected
    function NeedCheckPassWord: Boolean; override;
  public
    constructor Create; override;
  end;

  TScUnitPriceFileArchiver = class(TScMDBArchiver)
  protected
    function NeedCheckPassWord: Boolean; override;
  public
    constructor Create; override;
  end;

  TBillsFairyExtractor = class(TObject)
  private
    FKey: string;
    FArchiver: TMemStreamExtractor;
    FTempFile: string;
    FFileName: string;
    FFileInfo: TScFile7Head;
    FIsOldFile: Boolean;
    procedure DoOnArchiverNeedKey(Sender: TObject; var Key: string);
    procedure SetFileName(const Value: string);
    procedure ReadAndRemoveHead;
  public
    constructor Create;
    destructor Destroy; override;
    function Extract: TMemoryStream;
    property FileName: string read FFileName write SetFileName;
    property FileInfo: TScFile7Head read FFileInfo;
  end;

  TReportArchiver = class(TObject)
  private
    FKey: string;
    FArchiver: TStreamArchiver;
    FTempFile: string;
    FFileName: string;
    FFileInfo: TScFile7Head;
    FIsOldFile: Boolean;
    procedure DoOnArchiverNeedKey(Sender: TObject; var Key: string);
    procedure SetFileName(const Value: string);
    procedure ReadAndRemoveHead;
    procedure WriteAndAddHead(AStream: TStream);
  public
    constructor Create;
    destructor Destroy; override;
    function Extract: TMemoryStream;
    function Archive(AStream: TStream): Boolean;
    property FileName: string read FFileName write SetFileName;
    property FileInfo: TScFile7Head read FFileInfo;
  end;

  TScCommonStreamArchiver = class(TObject)
  private
    FKey: string;
    FArchiver: TStreamArchiver;
    FTempFile: string;
    FFileName: string;
    FFileInfo: TScFile7Head;
    FIsOldFile: Boolean;
    procedure DoOnArchiverNeedKey(Sender: TObject; var Key: string);
    procedure SetFileName(const Value: string);
    procedure ReadAndRemoveHead;
    procedure WriteAndAddHead(AStream: TStream);
  public
    constructor Create;
    destructor Destroy; override;
    function Open: TMemoryStream; virtual;
    function Save(AStream: TStream): Boolean; virtual;
    function SaveAs(AStream: TStream; AFileName: string): Boolean; virtual;
    procedure SetFileVer(AVer: string);
    property FileName: string read FFileName write SetFileName;
    property FileInfo: TScFile7Head read FFileInfo;
  end;

  TScCommonDataArchiver = class(TScMDBArchiver)
  protected
    function NeedCheckPassWord: Boolean; override;
  public
    constructor Create; override;
  end;

  TScFileArchiverManager = class(TObject)
  private
    FList: TList;
    function AddArchiver(AArchiver: TScFileArchiver): Integer;
    procedure RemoveArchiver(AArchiver: TScFileArchiver);
    function GetAlias(FileName: string): string;
    function GetCount: Integer;
    function GetItems(Index: Integer): TScFileArchiver;
    procedure SetAlias(FileName: string; const Value: string);
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TScFileArchiver read GetItems;
    property Alias[FileName: string]: string read GetAlias write SetAlias;
  end;

  procedure ChangeFileSysFlag(const AFileName: string; AIsSysFile: Boolean);

  function ReadScFileHead(const AFileName: string): TScFileHead;
  // 返回值： 1..6：文件类型，-1：不是SmartCost文件
  function IsSmartCostFile(const AFileName: string): Integer;
  function IsSmartCostProjectFile(const AFileName: string): Boolean;
  function IsSmartCostBillsFile(const AFileName: string): Boolean;
  function IsSmartCostBudgetFile(const AFileName: string): Boolean;
  function IsSmartCostEstimateFile(const AFileName: string): Boolean;
  function IsSmartCostRationLibFile(const AFileName: string): Boolean;
  function IsSmartCostFeeRateFile(const AFileName: string): Boolean;
  function IsSmartCostUnitPriceFile(const AFileName: string): Boolean;
  function IsSmartCostBillsFairyFile(const AFileName: string): Boolean;
  function IsSmartCostReportTemplateFile(const AFileName: string): Boolean;
  function IsSmartCostTBBillsFile(const AFileName: string): Boolean;
  function IsSmartCostStdFile(const AFileName: string): Boolean;
  // 判断是否是清单编制生成的文件 chenshilong, 2011-07-04
  function IsBillsEditorFile(const AFileName: string): Boolean;
  function IsSmartCostProduct(AProductName: string): Boolean;
  // Added by GiLi 判断是否是固化清单项目文件  固化清单
  function IsStaticBillsFile(const AFileName: string): Boolean;
  // Add By GiLi 验证是不是固化清单导出包     固化清单
  function IsStaticBillsPackage(const AFileName: string): Boolean;
  
  function CheckFilePassword(const AFileName: string): Boolean;

  procedure DeleteAllTempFile;
  // 此方法不能直接调用，应该由Manager来处理
  //function GetFileAlias(const AFileName: string): string;
  function GetFileType(const AFileName: string): Integer;
  // 处理老文件的Alias;
  procedure CheckAlias(const AFileName: string; AAlias: string = '');

  function FileArchiverManager: TScFileArchiverManager;

  // 6-15 固化清单 固化清单新版 保存打开过项目的加密狗的号
  function StoreOpenFileDogNumber(const AFileName: string; const iDogNum: Byte): Boolean;

implementation

uses
  Math, ComObj, Variants, ScTypes;

var
  g_FileArchiverManager: TScFileArchiverManager = nil;

procedure SetFileWritable(AFileName: string);
var
  iAttr: Integer;
begin
  iAttr := FileGetAttr(AFileName);
  if (iAttr and faReadOnly) <> 0 then
    FileSetAttr(AFileName, iAttr - faReadOnly);
end;

procedure ChangeFileSysFlag(const AFileName: string; AIsSysFile: Boolean);
var
  SourceFile: TFileStream;
  Head: TScFileHead;
begin
  SourceFile := TFileStream.Create(AFileName, fmOpenReadWrite);
  try
    SourceFile.Read(Head, Sizeof(TScFileHead));
    Head.IsSysFile := AIsSysFile;
    SourceFile.Seek(0, soFromBeginning);
    SourceFile.Write(Head, Sizeof(TScFileHead));
  finally
    SourceFile.Free;
  end;
end;

function ReadScFileHead(const AFileName: string): TScFileHead;
var
  SourceFile: TFileStream;
begin
  SourceFile := TFileStream.Create(AFileName, fmOpenRead);
  try
    SourceFile.Read(Result, Sizeof(TScFileHead));
  finally
    SourceFile.Free;
  end;
end;

function IsSmartCostProduct(AProductName: string): Boolean;
begin
  Result := SameText(ConstProductName, AProductName)
    or SameText(ConstProduct9Name, AProductName)
    or SameText(ConstBillsEditorName, AProductName);
end;

function IsSmartCostFile(const AFileName: string): Integer;
var
  FileHead: TScFileHead;
begin
  Result := -1;
  // 固化清单先验证文件是否存在
  if not FileExists(AFileName) then
    Exit;
  try
    FileHead := ReadScFileHead(AFileName);
    if IsSmartCostProduct(FileHead.ProductName) then
    begin
      if FileHead.FileType = 1 then
      begin
        if FileHead.ProjectFileType in [0..3] then
          Result := FileHead.FileType;
      end
      else
        Result := FileHead.FileType;
    end;
  except

  end;
end;

function IsSmartCostBillsFile(const AFileName: string): Boolean;
var
  FileHead: TScFileHead;
begin
  Result := False;
  try
    FileHead := ReadScFileHead(AFileName);
    if IsSmartCostProduct(FileHead.ProductName) then
    begin
      if FileHead.FileType = 1 then
      begin
        if FileHead.ProjectFileType = 0 then
          Result := True;
      end;
    end;
  except

  end;
end;

function IsSmartCostTBBillsFile(const AFileName: string): Boolean;
var
  FileHead: TScFileHead;
begin
  Result := False;
  try
    FileHead := ReadScFileHead(AFileName);
    if IsSmartCostProduct(FileHead.ProductName) then
    begin
      if FileHead.FileType = 1 then
      begin
        if FileHead.ProjectFileType = 6 then
          Result := True;
      end;
    end;
  except

  end;
end;

function IsSmartCostBudgetFile(const AFileName: string): Boolean;
var
  FileHead: TScFileHead;
begin
  Result := False;
  try
    FileHead := ReadScFileHead(AFileName);
    if IsSmartCostProduct(FileHead.ProductName) then
    begin
      if FileHead.FileType = 1 then
      begin
        if FileHead.ProjectFileType = 1 then
          Result := True;
      end;
    end;
  except

  end;
end;

function IsSmartCostEstimateFile(const AFileName: string): Boolean;
var
  FileHead: TScFileHead;
begin
  Result := False;
  try
    FileHead := ReadScFileHead(AFileName);
    if IsSmartCostProduct(FileHead.ProductName) then
    begin
      if FileHead.FileType = 1 then
      begin
        if FileHead.ProjectFileType in [2, 3] then
          Result := True;
      end;
    end;
  except

  end;
end;

// 这里要加上清单编制生成的项目文件 chenshilong, 2011-07-05
function IsSmartCostProjectFile(const AFileName: string): Boolean;
begin
  Result := IsSmartCostFile(AFileName) = 1;
end;

function IsSmartCostRationLibFile(const AFileName: string): Boolean;
begin
  Result := IsSmartCostFile(AFileName) = 2;
end;

function IsSmartCostFeeRateFile(const AFileName: string): Boolean;
begin
  Result := IsSmartCostFile(AFileName) = 3;
end;

function IsSmartCostUnitPriceFile(const AFileName: string): Boolean;
begin
  Result := IsSmartCostFile(AFileName) = 4;
end;

function IsSmartCostBillsFairyFile(const AFileName: string): Boolean;
begin
  Result := IsSmartCostFile(AFileName) = 5;
end;

function IsSmartCostReportTemplateFile(const AFileName: string): Boolean;
begin
  Result := IsSmartCostFile(AFileName) = 6;
end;

function IsStaticBillsFile(const AFileName: string): Boolean;
begin
  // 6-15 固化清单新版
  // 文件类型改为8，7只用在十天高速项目
  // Result := IsSmartCostFile(AFileName) = 7;
  Result := IsSmartCostFile(AFileName) = 8;
end;

function IsStaticBillsPackage(const AFileName: string): Boolean;
var
  stbHead: TStaticBillsHead;
  stbFile: TFileStream;
begin
  Result := False;
  // 固化清单先验证文件是否存在
  if not FileExists(AFileName) then
    Exit;
  stbFile := TFileStream.Create(AFileName, fmOpenRead);
  try
    stbFile.Read(stbHead, SizeOf(stbHead));
    // 6-15  固化清单新版
    // 类型=1的固化清单未见Stb只用在“十天高速”项目，以后不用了
    // 现在统一类型=2，以后类型都=2 （stb）
    //
    // Result := stbHead.IsStaticBillsFile = 1;
    Result := stbHead.IsStaticBillsFile = 2;
  finally
    stbFile.Free;
  end;   
end;

function IsSmartCostStdFile(const AFileName: string): Boolean;
var
  FileHead: TScFileHead;
begin
  Result := False;
  try
    FileHead := ReadScFileHead(AFileName);
    Result := IsSmartCostProduct(FileHead.ProductName) and FileHead.IsSysFile;
  except

  end;
end;

function IsBillsEditorFile(const AFileName: string): Boolean;
var
  FileHead: TScFileHead;
begin
  Result := False;
  FileHead := ReadScFileHead(AFileName);
  if SameText('BillsEditor', FileHead.ProductName) then
    Result := True;
end;


var
  FileList: TStringList = nil;

function CheckFilePassword(const AFileName: string): Boolean;
var
  Rec: TScFileHead;
  strPwd: string;
begin
  Rec := ReadScFileHead(AFileName);
  // 为兼容以前版本，密码为空也认为是无密码
  if (not Rec.HasPassword) or (Rec.Password = '') then
  begin
    Result := True;
    Exit;
  end;

  Result := InputPassWord(strPwd);
  if Result then
  begin
    Result := CompareStr(strPwd, Rec.Password) = 0;
    if not Result then
      MessageError(0, '密码错误！');
  end;
end;

function FileListName: string;
begin
  Result := GetTempFilePath + 'spbkt.bak';
  {$IFDEF _ScBills}
  Result := GetTempFilePath + 'spbkt1.bak';
  {$ENDIF}
  {$IFDEF _ScBudget}
  Result := GetTempFilePath + 'spbkt2.bak';
  {$ENDIF}
  {$IFDEF _ScEstimate}
  Result := GetTempFilePath + 'spbkt3.bak';
  {$ENDIF}
end;

function GetFileList: TStringList;
begin
  if FileList = nil then
  begin
    FileList := TStringList.Create;
    if FileExists(FileListName) then
      FileList.LoadFromFile(FileListName);
  end;
  Result := FileList;
end;

procedure UpdateFileList;
begin
  if FileExists(FileListName) then
    DeleteFile(FileListName);
  GetFileList.SaveToFile(FileListName);
end;

procedure AddToFileList(AFileName: string);
begin
  try
    GetFileList.Add(AFileName);
    UpdateFileList;
  except

  end;
end;

procedure DeleteFromFileList(AFileName: string);
var
  idx: Integer;
begin
  try
    if FileExists(AFileName) then
      DeleteFile(AFileName);
    idx := GetFileList.IndexOf(AFileName);
    if idx > -1 then
    begin
      GetFileList.Delete(idx);
      UpdateFileList;
    end;
  except

  end;
end;

procedure DeleteAllTempFile;
begin
  try
    while GetFileList.Count > 0 do
    begin
      if FileExists(GetFileList[0]) then
      begin
        if DeleteFile(GetFileList[0]) then
          GetFileList.Delete(0);
      end
      else
        GetFileList.Delete(0);
    end;
    UpdateFileList;
  except

  end;
end;

function ByteArrayToStr(AByteArray: array of Byte; ALength: Integer): string;
begin
  SetString(Result, PChar(@AByteArray[0]), ALength);
end;

function GetFileAlias(const AFileName: string): string;
var
  Rec: TScFileHead;
begin
  if IsSmartCostFile(AFileName) < 0 then Exit;
  Result := ExtractFileNameWithoutExt(AFileName);
  if not FileExists(AFileName) then
    Exit;
  Rec := ReadScFileHead(AFileName);
  // 8.0以前版本无法使用此属性
  if ScCompareFileVer(Rec.FileVersion, '8.0.0.0') < 0 then
    Exit;
  // 8.7以前版本无此属性值
  // 8.7前版本才需要处理别名
  if StrToFloat(Rec.ProductVersion) < 8.7 then
    Exit;
  // 这样判断会导致无法显示老版本文件，应先保证文件升级
  {if ScCompareFileVer(Rec.FileVersion, '8.7.0.0') < 0 then
  begin
    Rec.Alias := Result;
    Exit;
  end;}
  // 为空
  if Rec.Alias = '' then
  begin
    Rec.Alias := Result;
    Exit;
  end;
  Result := Rec.Alias;
end;

procedure SetFileAlias(const AFileName, AAlias: string);
var
  Rec: TScFileHead;
  SourceFile: TFileStream;
begin
  if not FileExists(AFileName) then
    Exit;
  if IsSmartCostFile(AFileName) < 0 then Exit;
  SourceFile := TFileStream.Create(AFileName, fmOpenRead);
  try
    SourceFile.Read(Rec, Sizeof(TScFileHead));
  finally
    SourceFile.Free;
  end;
  // 8.0以前版本无法使用此属性
  if ScCompareFileVer(Rec.FileVersion, '8.0.0.0') < 0 then
    Exit;
  // 8.7前版本才需要处理别名
  if True(*StrToFloat(Rec.ProductVersion) < 8.7*) then
  begin
    Rec.ProductVersion := ConstProductVersion87;
    Rec.Alias := AAlias;
    SourceFile := TFileStream.Create(AFileName, fmOpenWrite);
    try
      SourceFile.Position := 0;
      SourceFile.Write(Rec, Sizeof(TScFileHead));
    finally
      SourceFile.Free;
    end;
  end;
end;

// 6-15 固化清单 固化清单新版
function StoreOpenFileDogNumber(const AFileName: string; const iDogNum: Byte): Boolean;
var
  sFileName: string;
  scFileHead: TScFileHead;
  sFile: TFileStream;
  I: Integer;
  bErrorCode, bHasZero: Boolean;
begin
  if iDogNum = 0 then
  begin
    Result := False;
    Exit;
  end;
  bHasZero := False;
  bErrorCode := False;
  sFileName := Trim(AFileName);
  if not FileExists(sFileName) then
  begin
    Result := False;
    Exit;
  end;
  scFileHead := ReadScFileHead(sFileName);
  bErrorCode := scFileHead.OpenFileDogNumber[0] = 255;
  // 如果锁号等于255, 说明锁号错误，先初始化0 
  if bErrorCode then
  begin
    for I := 0 to 15 do
    begin
      scFileHead.OpenFileDogNumber[I] := 0;
    end;
  end;
  for I := 0 to 15 do
  begin
    if scFileHead.OpenFileDogNumber[I] = iDogNum then
    begin
      // 如果存在了锁号，就不添加了
      Result := True;
      Exit;
    end;
    if scFileHead.OpenFileDogNumber[I] = 0 then
    begin
      scFileHead.OpenFileDogNumber[I] := iDogNum;
      bHasZero := True;
      Break;
    end;
  end;
  // 如果16个空都存完了，就把最新的加密锁放在最后一个位置
  if not bHasZero then
    scFileHead.OpenFileDogNumber[15] := iDogNum;
  // 把头写入文件
  sFile := TFileStream.Create(sFileName, fmOpenWrite);
  try
    sFile.Position := 0;
    sFile.Write(scFileHead, SizeOf(scFileHead));
  finally
    sFile.Free;
  end;

  Result := True;
end;

function GetFileType(const AFileName: string): Integer;
var
  Rec: TScFileHead;
begin
  Rec := ReadScFileHead(AFileName);
  Result := Rec.FileType;
  // 文件头中的文件类型是1-4，其他地方是0-3
  if Result > 0 then
    Result := Result - 1;
end;

procedure CheckAlias(const AFileName: string; AAlias: string);
var
  strAlias: string;
  Rec: TScFileHead;
  SourceFile: TFileStream;
begin
  if not FileExists(AFileName) then
    Exit;
  if IsSmartCostFile(AFileName) < 0 then Exit;
  SourceFile := TFileStream.Create(AFileName, fmOpenRead);
  try
    ZeroMemory(@Rec, Sizeof(TScFileHead));
    SourceFile.Read(Rec, Sizeof(TScFileHead));
  finally
    SourceFile.Free;
  end;
  // 8.0以前版本无法使用此属性
  if ScCompareFileVer(Rec.FileVersion, '8.0.0.0') < 0 then
    Exit;
  // 8.7前版本才需要处理别名(注意是产品版本)
  if StrToFloat(Rec.ProductVersion) < StrToFloat(ConstProductVersion87) then
  begin
    if AAlias = '' then
      strAlias := ExtractFileNameWithoutExt(AFileName)
    else
      strAlias := AAlias;
    Rec.ProductVersion := ConstProductVersion87;
    Rec.Alias := strAlias;
    Rec.OwnerAlias := '';
    SourceFile := TFileStream.Create(AFileName, fmOpenWrite);
    try
      SourceFile.Position := 0;
      SourceFile.Write(Rec, Sizeof(TScFileHead));
    finally
      SourceFile.Free;
    end;
  end;
end;

{ TScFileArchiver }

function TScFileArchiver.ArchiveFile: Boolean;
var
  IsFileExists: Boolean;
  Temp: string;
begin
  Result := False;
  if (FKey = '') or (FFileName = '') then
    Exit;
//  BackupFile := '~' + FFileName;
  IsFileExists := False;
  if FileExists(FPrepareFile) then
    DeleteFile(FPrepareFile);
  try
    if FIsOldFile then
    begin
      if (FFile7Info.Password = '') and (FFile7Info.HasPassword) then
        FFile7Info.HasPassword := False;
    end
    else
    begin
      if (FFileInfo.Password = '') and (FFileInfo.HasPassword) then
        FFileInfo.HasPassword := False;
    end;
    Temp := GetTempFileName;
    AddToFileList(Temp);
    CopyFile(PChar(FExtractFile), PChar(Temp), False);
    AddToFileList(FExtractFile);
    FArchiver.FileName := FPrepareFile;
    AddToFileList(FPrepareFile);
    FArchiver.OpenNew;
    try
      FArchiver.AddFile(Temp);
      FArchiver.Close;
      Result := True;
    except
      DeleteFile(FPrepareFile);
      raise EScFileSystem.Create('保存文件出错！');
    end;
  finally
    { TODO : 可以重复关闭吗？ }
    if FArchiver.IsOpen then
      FArchiver.Close;
    DeleteFile(Temp);
  end;
  WriteAndAddHead;
  if not DirectoryExists(ExtractFileDir(FFileName)) then
    CreateFullDir(ExtractFileDir(FFileName));
  Result := Result and CopyFile(PChar(FPrepareFile), PChar(FFileName), False);
  FileSetAttr(FFileName, FFileAttr);
end;

function TScFileArchiver.CloseFile: Boolean;
begin
  Result := True;
  if not FFileOpened then
  begin
    Exit;
  end;
  try
    if FileExists(FExtractFile) then
      DeleteFile(FExtractFile);
    if FileExists(FPrepareFile) then
      DeleteFile(FPrepareFile);
  except
    Result := False;
    MessageError(0, '关闭文件时发生错误！');
  end;
  if Result then
  begin
    DeleteBackupFile;
    FExtractFile := '';
    FPrepareFile := '';
    FFileOpened := False;
    FileArchiverManager.RemoveArchiver(Self);
  end;
end;

constructor TScFileArchiver.Create;
begin
  FKey := '';
  FArchiver := TArchiver.Create(nil);
  FArchiver.OnEnterCryptKey := DoOnArchiverNeedKey;
  FArchiver.OnRequestCryptKey := DoOnArchiverNeedKey;
  FArchiver.ErrorAction := eaContinue;
  FArchiver.RestoreAction := raOverwrite;
  FFileOpened := False;
  FExtractFile := '';
  FTempFile := '';
  FFileIdx := -1;
  FFileSize := 0;
  FIsOldFile := False;
  FNeedCheckExeVersion := False;
  ZeroMemory(@FFileInfo, SizeOf(FFileInfo));
  ZeroMemory(@FFile7Info, SizeOf(FFile7Info));
end;

destructor TScFileArchiver.Destroy;
begin
  if FFileOpened then
    CloseFile;
  FArchiver.Free;
  inherited;
end;

function TScFileArchiver.IsArchiveEmpty : Boolean;
begin
  with FArchiver.Header do
    Result := (ArchiveInfo.FileCount + SegmentInfo.FileCount) = 0;
end;

function TScFileArchiver.ExtractFile: Boolean;
var
  idx: Integer;
begin
  Result := False;
  if FFileOpened then
  begin
    Result := True;
    Exit;
  end;
  if (FKey = '') or (FFileName = '') then
    Exit;
  FFileAttr := FileGetAttr(FFileName);
  FExtractFile := ExtractFileName;
  AddToFileList(FExtractFile);
  // 读出头信息并去掉文件头
  ReadAndRemoveHead;
  // 判断是否能打开的版本
  if IsNewerExeFile then
    raise EScFileSystem.Create(Format('此文件由版本号为%s的SmartCost程序创建，请升级SmartCost到最新版本后再打开该文件', [FFileInfo.ExeVersion]));
  FArchiver.FileName := FPrepareFile;//FFileName;
  AddToFileList(FPrepareFile);
  FArchiver.Options := FArchiver.Options - [oOpenSingleSegment] +
    [oMaintainFileDirectory, oCrypt];
  FArchiver.Open;
  // 遍历压缩文件以保证数据正确性
  FArchiver.EnumerateFiles;
  if FArchiver.FileCount <=0 then
    raise EScFileSystem.Create('读取文件出错！');
  idx := FArchiver.FileCount - 1;//FArchiver.IndexOfFile('项目文件2.mdb');
  FFileIdx := idx;
  if IsArchiveEmpty or (idx <= -1) then
    raise EScFileSystem.Create('文件中没有数据！');
  try
    try
      Result := True;
      with FArchiver.Files[idx].FileEntry do
      begin
        FArchiver.ExtractFileTo(Segment, Offset, ArchiveInfo.CompressedSize, FExtractFile);
        FFileSize := ArchiveInfo.Size;
      end;
    except
      Result := False;
    end;
  finally
    FArchiver.Close;
  end;
  if Result then
    FFileOpened := True;
end;

function TScFileArchiver.ExtractFileName: string;
var
  TempExt: string;
begin
  Result := GetTempFileName;
  TempExt := '.' + GetTempName(3);
  while SameText(TempExt, '.mdb') or SameText(TempExt, '.db') or
      SameText(TempExt, '.ldb') do
    TempExt := '.' + GetTempName(3);
  FixFileExt(Result, TempExt, True);

  while FileExists(Result) do
  begin
    Result := GetTempFileName;
    TempExt := '.' + GetTempName(3);
    while SameText(TempExt, '.mdb') or SameText(TempExt, '.db') or
        SameText(TempExt, '.ldb') do
      TempExt := '.' + GetTempName(3);
    FixFileExt(Result, TempExt, True);
  end;
end;

function TScFileArchiver.OpenFile: Boolean;
begin
  Result := ExtractFile;
  if Result then
  begin
    CreateBackupFile;
    FileArchiverManager.AddArchiver(Self);
  end;
end;

procedure TScFileArchiver.SetFileName(const Value: string);
begin
  if not FileExists(Value) then
    raise EScFileSystem.CreateFmt('文件[%s]不存在！', [Value]);
  SetFileWritable(Value);
  FFileName := Value;
end;

function TScFileArchiver.TempFileName: string;
begin
  Result := GetTempFileName;
end;

procedure TScFileArchiver.DoOnArchiverNeedKey(Sender: TObject;
  var Key: string);
begin
  Key := FKey;
end;

function TScFileArchiver.Save: Boolean;
begin
  Result := False;
  if (FKey = '') or (FFileName = '') then
    Exit;
  Result := ArchiveFile;
end;

function TScFileArchiver.SaveTo(AFileName: string): Boolean;
begin
  Result := False;
  FFileName := AFileName;
  if (FKey = '') or (FFileName = '') then
    Exit;
  Result := ArchiveFile;
end;

procedure TScFileArchiver.ReadAndRemoveHead;
var
  F, FT: TFileStream;
  fVer: Double;
  strAlias: string;
begin
  if FileExists(FPrepareFile) then
    DeleteFile(FPrepareFile);
  F := TFileStream.Create(FFileName, fmOpenRead);
  FPrepareFile := GetTempFileName;
  AddToFileList(FPrepareFile);
  FT := TFileStream.Create(FPrepareFile, fmCreate);
  try
    // 首先判断文件版本是否8.0版本低
    F.Seek($00, soFromBeginning);
    F.Read(FFileInfo, Sizeof(TScFileHead));
    fVer := StrToFloat(Trim(FFileInfo.ProductVersion));
    // 是7.0及以前版本
    if fVer < StrToFloat(ConstProductVersion) then
    begin
      FIsOldFile := True;
      F.Seek($00, soFromBeginning);
      F.Read(FFile7Info, Sizeof(TScFile7Head));
      FT.Seek($00, soFromBeginning);
      FT.CopyFrom(F, F.Size - Sizeof(TScFile7Head));
      FOriginalFileVersion := FFile7Info.FileVersion;
    end
    // 是8.0及以后版本
    else
    begin
      FIsOldFile := False;
      F.Seek($00, soFromBeginning);
      F.Read(FFileInfo, Sizeof(TScFileHead));
      FT.Seek($00, soFromBeginning);
      FT.CopyFrom(F, F.Size - Sizeof(TScFileHead));
      // 处理新属性,8.7.0.0以前版本需清零
      if ScCompareFileVer(FFileInfo.FileVersion, '8.7.0.0') < 0 then
      begin
        FFileInfo.UserVersion := 0;
        FFileInfo.ExeVersion := '';
        FFileInfo.LineVersion := '';
      end;
      // 8.7前版本需要处理别名(注意是产品版本)
      if StrToFloat(FFileInfo.ProductVersion) < StrToFloat(ConstProductVersion87) then
      begin
        strAlias := ExtractFileNameWithoutExt(FFileName);
        FFileInfo.ProductVersion := ConstProductVersion87;
        FFileInfo.Alias := strAlias;
        FFileInfo.OwnerAlias := '';
        //if FFileInfo
      end;
      FOriginalFileVersion := FFileInfo.FileVersion;
    end;
  finally
    FT.Free;
    F.Free;
  end;
end;

procedure TScFileArchiver.WriteAndAddHead;
var
  F, FT: TFileStream;
  Temp: string;
begin
  F := TFileStream.Create(FPrepareFile, fmOpenRead);
  Temp := GetTempFileName;
  AddToFileList(Temp);
  // 随机填写Reverse字段
  RandomFillHead;
  FT := TFileStream.Create(Temp, fmCreate);
  try
    FT.Seek($00, soFromBeginning);
    if FIsOldFile then
      FT.Write(FFile7Info, Sizeof(TScFile7Head))
    else
    begin
      // 将8.x的文件头版本信息改为9，保证8的exe无法打开9的文件
      // 以后不再采用此办法，而是记录下exe版本信息进行对比
      FFileInfo.ProductName := ConstProduct9Name;
      FFileInfo.ExeVersion := ScGetVersion;
      FFileInfo.LineVersion := ConstLineVersion;
      FT.Write(FFileInfo, Sizeof(TScFileHead));
    end;
    FT.CopyFrom(F, F.Size);
  finally
    FT.Free;
    F.Free;
  end;
  CopyFile(PChar(Temp), PChar(FPrepareFile), False);
  DeleteFile(Temp);
end;

procedure TScFileArchiver.RandomFillHead;
var
  I: Integer;
begin
  if FIsOldFile then
  begin
    ZeroMemory(@(FFile7Info.Reserve[0]), Length(FFile7Info.Reserve));
    for I := 0 to Length(FFile7Info.RandomData) - 1 do
      FFile7Info.RandomData[I] := Char(RandomRange(0, 255));
  end
  else
  begin
    ZeroMemory(@(FFileInfo.Reserve[0]), Length(FFileInfo.Reserve));
    for I := 0 to Length(FFileInfo.RandomData) - 1 do
      FFileInfo.RandomData[I] := Char(RandomRange(0, 255));
  end;
end;

function TScFileArchiver.Refresh: Boolean;
var
  idx: Integer;
  Temp: string;
begin
  Result := False;
  if (FKey = '') or (FFileName = '') then
    Exit;
  Temp := GetTempFileName;
  AddToFileList(Temp);
  // 读出头信息并去掉文件头
  ReadAndRemoveHead;
  FArchiver.FileName := FPrepareFile;//FFileName;
  AddToFileList(FPrepareFile);
  FArchiver.Options := FArchiver.Options - [oOpenSingleSegment] +
    [oMaintainFileDirectory, oCrypt];
  FArchiver.Open;
  // 遍历压缩文件以保证数据正确性
  FArchiver.EnumerateFiles;
  if FArchiver.FileCount <=0 then
    raise EScFileSystem.Create('读取文件出错！');
  idx := FArchiver.FileCount - 1;//FArchiver.IndexOfFile('项目文件2.mdb');
  FFileIdx := idx;
  if IsArchiveEmpty or (idx <= -1) then
    raise EScFileSystem.Create('文件中没有数据！');
  try
    try
      Result := True;
      with FArchiver.Files[idx].FileEntry do
      begin
        FArchiver.ExtractFileTo(Segment, Offset, ArchiveInfo.CompressedSize, Temp);
        FFileSize := ArchiveInfo.Size;
      end;
    except
      Result := False;
    end;
  finally
    FArchiver.Close;
  end;
  try
    if not CopyFile(PChar(Temp), PChar(FExtractFile), False) then
      MessageError(0, '刷新文件失败！');
  finally
    DeleteFile(Temp);
  end;
end;

procedure TScFileArchiver.SetIsStdFile(const Value: Boolean);
begin
  if FFileOpened then
  begin
    if FIsOldFile then
      FFile7Info.IsSysFile := Value
    else
      FFileInfo.IsSysFile := Value;
  end;
end;

procedure TScFileArchiver.SetReadOnly(const Value: Boolean);
begin
  if FFileOpened then
  begin
    if FIsOldFile then
      FFile7Info.ReadOnly := Value
    else
      FFileInfo.ReadOnly := Value;
  end;
end;

function TScFileArchiver.GetIsStdFile: Boolean;
begin
  Result := False;
  if FFileOpened then
  begin
    if FIsOldFile then
      Result := FFile7Info.IsSysFile
    else
      Result := FFileInfo.IsSysFile;
  end;
end;

function TScFileArchiver.GetReadOnly: Boolean;
begin
  Result := False;
  if FFileOpened then
  begin
    if FIsOldFile then
      Result := FFile7Info.ReadOnly
    else
      Result := FFileInfo.ReadOnly;
  end;
end;

procedure TScFileArchiver.InternalSetPassWord(APwd: string);
begin
  if FIsOldFile then
  begin
    FFile7Info.HasPassword := APwd <> '';
    FFile7Info.Password := APwd;
  end
  else
  begin
    FFileInfo.HasPassword := APwd <> '';
    FFileInfo.Password := APwd;
  end;
end;

function TScFileArchiver.NeedCheckPassWord: Boolean;
begin
  Result := True;
end;

function TScFileArchiver.SetPassWord: Boolean;
var
  strPwd: string;
begin
  Result := False;
  if not FFileOpened then
    raise EScFileSystem.Create('文件尚未打开，无法设置密码！');

  strPwd := '                    ';
  if SetupPassWord(strPwd) then
  begin
    InternalSetPassWord(strPwd);
    Result := True;
  end;
end;

procedure TScFileArchiver.SetFileVer(AVer: string);
begin
  if FIsOldFile then
    FFile7Info.FileVersion := AVer
  else
    FFileInfo.FileVersion := AVer;
end;

function TScFileArchiver.GetIsLocalFile: Boolean;
begin
  if FIsOldFile then
    Result := IsLocalGUID(FFile7Info.LocationID)
  else
    Result := IsLocalGUID(FFileInfo.LocationID);
end;

procedure TScFileArchiver.SetIsLocalFile(const Value: Boolean);
begin
  if FIsOldFile then
    FFile7Info.LocationID := GetLocalGUID
  else
    FFileInfo.LocationID := GetLocalGUID;
end;

procedure TScFileArchiver.ClearPassWord;
begin
  InternalSetPassWord('');
end;
// 成功打开项目后，才能创建备份文件
procedure TScFileArchiver.CreateBackupFile;
begin
  FBackupFile := ExtractFilePath(FFileName) + ConstBackupFilePrefix + SysUtils.ExtractFileName(FFileName);
  CopyFile(PChar(FFileName), PChar(FBackupFile), False);
  FileSetAttr(FBackupFile, faHidden or faReadOnly);
end;

// 成功关闭项目后，才能删除备份文件
procedure TScFileArchiver.DeleteBackupFile;
begin
  if FileExists(FBackupFile) then
  begin
    FileSetAttr(FBackupFile, 0);
    DeleteFile(FBackupFile);
  end;
end;

function TScFileArchiver.GetUserVersion: Integer;
begin
  Result := 0;
  if not FIsOldFile then
    Result := FFileInfo.UserVersion;
end;

procedure TScFileArchiver.UpdateUserVersion;
begin
  if not FIsOldFile then
    Inc(FFileInfo.UserVersion);
end;

function TScFileArchiver.GetAlias: string;
begin
  Result := '';
  if not FIsOldFile then
    Result := FFileInfo.Alias;
end;

function TScFileArchiver.GetOwnerAlias: string;
begin
  Result := '';
  if not FIsOldFile then
    Result := FFileInfo.OwnerAlias;
end;

procedure TScFileArchiver.SetAlias(const Value: string);
begin
  if (not FIsOldFile) and (not SameText(FFileInfo.Alias, Value)) then
  begin
    FFileInfo.Alias := Value;
    if Assigned(FOnAliasChanged) then
      FOnAliasChanged(Self);
  end;
end;

procedure TScFileArchiver.SetOwnerAlias(const Value: string);
begin
  if not FIsOldFile then
    FFileInfo.OwnerAlias := Value;
end;

function TScFileArchiver.IsNewerExeFile: Boolean;
begin
  Result := False;
  if not FNeedCheckExeVersion then Exit;
  if FileInfo.ExeVersion = '' then Exit;
  // 暂定为：必须升级数据文件才能打开的情况，版本号第二节必须增加
  Result := ScCompareFileVer(FileInfo.ExeVersion, ScGetVersion, 2) > 0
end;

procedure TScFileArchiver.SaveHead;
var
  FT: TFileStream;
begin
  FT := TFileStream.Create(FFileName, fmOpenReadWrite);
  try
    FT.Seek($00, soFromBeginning);
    if FIsOldFile then
      FT.Write(FFile7Info, Sizeof(TScFile7Head))
    else
      FT.Write(FFileInfo, Sizeof(TScFileHead));
  finally
    FT.Free;
  end;
end;

procedure TScFileArchiver.ResetSourceFileName(sGUID: string);
begin
  FFileInfo.SourceFileName := sGUID;
end;

{ TScMDBArchiver }

function TScMDBArchiver.ArchiveFile: Boolean;
var
  IsConnected: Boolean;
begin
  Result := False;
  if Connection = nil then
    raise EScFileSystem.Create('没有可用的文件连接！');
  Encrypt;
  IsConnected := False;
  if Connection.Connected then
    IsConnected := True;
  // 当采用独占模式打开时，必须先关闭连接才能进行文件操作
  if IsConnected and (Connection.Mode in [cmShareExclusive, cmShareDenyRead]) then
    Connection.Connected := False;
  Result := inherited ArchiveFile;
  if IsConnected and (Connection.Mode in [cmShareExclusive, cmShareDenyRead]) then
  begin
    DecryptMDB(FExtractFile);
    Connection.Connected := True;
    EncryptMDB(FExtractFile);
  end;
end;

function TScMDBArchiver.CloseFile: Boolean;
begin
  Result := False;
  if not FFileOpened then Exit;
  if Assigned(Connection) then
    Connection.Connected := False;
  // 每次关闭时压缩数据库
  try
    DecryptMDB(FExtractFile);
//    CompactDatabase(FExtractFile);
  finally
    EncryptMDB(FExtractFile);
  end;
  Result := inherited CloseFile;
  DeleteFakeFiles;
end;

// 压缩与修复数据库,覆盖源文件
function TScMDBArchiver.CompactDatabase(AFileName: string): Boolean;
var
  strTempFileName: string;
  vJE: OleVariant;
const
  // 注意：此处的连接语句没有“;Persist Security Info=True”
  SConnectStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;User ID=%s;Password=%s';
begin
  strTempFileName := GetTempFileName;
  try
    AddToFileList(strTempFileName);
    vJE := CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(Format(SConnectStr, [AFileName, 'Admin', '']),
        Format(SConnectStr, [strTempFileName, 'Admin', '']));
    vJE := Unassigned;
    Result := CopyFile(PChar(strTempFileName), PChar(AFileName), False);
    DeleteFile(strTempFileName);
  except
    vJE := Unassigned;
    Result := False;
  end;
end;

constructor TScMDBArchiver.Create;
begin
  inherited;
  FFakeFiles := TStringList.Create;
  FInnerConnection := TADOConnection.Create(nil);
  FInnerConnection.LoginPrompt := False;
  FConnection := nil;
end;

procedure TScMDBArchiver.CreateFakeFiles;

  function GetFakeTemplateName: string;
  begin
    Result := ExtractFilePath(Application.ExeName) + 'Data\Template.dat';
    if not FileExists(Result) then
      raise EScFileSystem.Create('文件系统故障！');
  end;

  procedure RandomWriteFile(AFileName: string; ASize: Integer);
  var
    FS, SS: TFileStream;
    iPos, iSize: Integer;
  begin
    AddToFileList(AFileName);
    FS := TFileStream.Create(AFileName, fmCreate, fmShareExclusive);
    SS := TFileStream.Create(GetFakeTemplateName, fmOpenRead, fmShareDenyNone);
    try
      Randomize;
      FS.Size := ASize;
      FS.Seek(0, soFromBeginning);
      if Random(1024) > 512 then
      begin
        FS.Write(MDBNewHead, 16);
      end;
      FS.WriteBuffer(MDBNewHeadZero, Length(MDBNewHeadZero));
      repeat
      begin
        Randomize;
        SS.Position := Random(SS.Size);
        if SS.Size - SS.Position > FS.Size - FS.Position then
          FS.CopyFrom(SS, FS.Size - FS.Position)
        else
          FS.CopyFrom(SS, SS.Size - SS.Position);
      end
      until FS.Size >= ASize;
    finally
      FS.Free;
      SS.Free;
    end;
  end;

var
  FakeName: string;
  I, Idx: Integer;
  FileSize: Integer;
begin
  if not FFileOpened then
    Exit;

  FileSize := FFileSize;  
  FakeName := FExtractFile;
  FixFileExt(FakeName, '.mdb', True);
  if FileExists(FakeName) then
    DeleteFile(FakeName);
  RandomWriteFile(FakeName, FileSize);
  DecryptMDB(FakeName);
  FFakeFiles.Add(FakeName);

  FixFileExt(FakeName, '.db', True);
  if FileExists(FakeName) then
    DeleteFile(FakeName);
  RandomWriteFile(FakeName, FileSize);
  FFakeFiles.Add(FakeName);

  FixFileExt(FakeName, '.' + GetTempName(3), True);
  if not FileExists(FakeName) then
  begin
    RandomWriteFile(FakeName, FileSize);
    FFakeFiles.Add(FakeName);
  end;

  (*FixFileExt(FakeName, '.' + GetTempName(3), True);
  if not FileExists(FakeName) then
  begin
    RandomWriteFile(FakeName, FileSize);
    FFakeFiles.Add(FakeName);
  end;*)

  for I := 0 to (*3*)0 do
  begin
    Randomize;
    Idx := Random(Length(FakeFileExts));
    FixFileExt(FakeName, FakeFileExts[Idx], True);
    if not FileExists(FakeName) then
    begin
      RandomWriteFile(FakeName, Random(FileSize));
      FFakeFiles.Add(FakeName);
    end;
  end;
end;

procedure TScMDBArchiver.Decrypt;
var
  ldbName: string;
begin
  FTempFile := TempFileName;
  AddToFileList(FTempFile);
  AddToFileList(FExtractFile);
  ldbName := FExtractFile;
  FixFileExt(ldbName, '.ldb', True);
  AddToFileList(ldbName);
  //还原数据，以便自已使用数据库
  CopyFile(PChar(FExtractFile), PChar(FTempFile), False);
  DecryptMDB(FTempFile);
  CopyFile(PChar(FTempFile),PChar(FExtractFile), False);
  DeleteFile(FTempFile);
  // 在打开数据前精简数据库
  CompactDatabase(FExtractFile);
  Connection.ConnectionString := Format(SAdoConnectStr, [FExtractFile, 'Admin', '']);
  try
    Connection.LoginPrompt := False;
    Connection.Connected := True;
  except
    MessageError(0, Format('无法打开数据文件[%s]！', [FFileName]));
    DeleteFile(FExtractFile);
    Exit;
  end;
  //打开后马上对其加密
  { TODO : 
  当使用独占模式连接的时候，下面的方法根本不起作用，
  因为无法复制和写入数据。 }
  try
    CopyFile(PChar(FExtractFile), PChar(FTempFile), False);
    if FileExists(FTempFile) then
    begin
      EncryptMDB(FTempFile);
      CopyFile(PChar(FTempFile),PChar(FExtractFile), False);
      DeleteFile(FTempFile);
    end;
  except
    // do nothing;
  end;
end;

procedure TScMDBArchiver.DecryptMDB(AFile: string);
var
  F: TFileStream;
begin
  F:=TFileStream.Create(AFile, fmOpenWrite);
  try
    F.seek($00, soFromBeginning);
    F.Write(MDBOrgHead, 16);
  finally
    F.Free;
  end;
end;

procedure TScMDBArchiver.DeleteFakeFiles;
var
  I: Integer;
  FakeFile: string;
begin
  for I := 0 to FFakeFiles.Count - 1 do
  begin
    FakeFile := FFakeFiles[I];
    if FileExists(FakeFile) then
    begin
      try
        DeleteFile(FakeFile);
      except

      end;
    end;
  end;
end;

destructor TScMDBArchiver.Destroy;
begin
  if FFileOpened then
    CloseFile;
  DeleteFakeFiles;
  FFakeFiles.Free;
  FInnerConnection.Free;
  inherited;
end;

procedure TScMDBArchiver.Encrypt;
begin
  // do nothing
end;

procedure TScMDBArchiver.EncryptMDB(AFile: string);
var
  F: TFileStream;
begin
  F := TFileStream.Create(AFile, fmOpenWrite);
  try
    F.Seek($00, soFromBeginning);
    F.Write(MDBNewHead, 16);
  finally
    F.Free;
  end;
end;

function TScMDBArchiver.ExtractFile: Boolean;
begin
  Result := False;
  if Connection = nil then
    raise EScFileSystem.Create('没有可用的文件连接！');
  Result := inherited ExtractFile;
  if Result then
    Decrypt;
end;

function TScMDBArchiver.GetConnection: TADOConnection;
begin
  if FConnection = nil then
    Result := FInnerConnection
  else
    Result := FConnection;
end;

function TScMDBArchiver.OpenFile: Boolean;
begin
  Result := inherited OpenFile;
  if Result then
    CreateFakeFiles;
end;

function TScMDBArchiver.Refresh: Boolean;
var
  IsConnected: Boolean;
  Temp: string;
begin
  Result := False;
  if Connection = nil then
    raise EScFileSystem.Create('没有可用的文件连接！');
  //Encrypt;
  Temp := GetTempFileName;
  AddToFileList(Temp);
  AddToFileList(FExtractFile);
  IsConnected := False;
  if Connection.Connected then
    IsConnected := True;
  // 当采用独占模式打开时，必须先关闭连接才能进行文件操作
  if IsConnected {and (FConnection.Mode in [cmShareExclusive, cmShareDenyRead])} then
    Connection.Connected := False;
  Result := inherited Refresh;
  if IsConnected {and (FConnection.Mode in [cmShareExclusive, cmShareDenyRead])} then
  begin
    CopyFile(PChar(FExtractFile), PChar(Temp), False);
    DecryptMDB(Temp);
    CopyFile(PChar(Temp), PChar(FExtractFile), False);
    DeleteFile(Temp);

    Connection.Connected := True;

    CopyFile(PChar(FExtractFile), PChar(Temp), False);
    EncryptMDB(Temp);
    CopyFile(PChar(Temp), PChar(FExtractFile), False);
    DeleteFile(Temp);
  end;
end;

procedure TScMDBArchiver.SetConnection(const Value: TADOConnection);
begin
  FConnection := Value;
end;

{ TScProjectFileArchiver }

constructor TScProjectFileArchiver.Create;
begin
  inherited;
//  FKey := P1;
  FKey := ByteArrayToStr(PA1, Length(PA1));
  NeedCheckExeVersion := True;
end;

function TScProjectFileArchiver.IsNewerExeFile: Boolean;
var
  strExeVer: string;
begin
  Result := False;
  if not FNeedCheckExeVersion then Exit;
  if FFileInfo.LineVersion = '' then Exit;
  strExeVer := ScGetVersion;
  // Exe版本低于基线，必须升级才能打开文件
  Result := ScCompareFileVer(strExeVer, FFileInfo.LineVersion) < 0;
end;

procedure TScProjectFileArchiver.SetProjectFileType(AType: Integer);
begin
  if FIsOldFile then
    FFile7Info.ProjectFileType := AType
  else
    FFileInfo.ProjectFileType := AType;
end;

{ TScRationLibArchiver }

constructor TScRationLibArchiver.Create;
begin
  inherited;
//  FKey := P2;
  FKey := ByteArrayToStr(PA2, Length(PA2));
end;

function TScRationLibArchiver.NeedCheckPassWord: Boolean;
begin
  Result := False;
end;

{ TScFeeRateFileArchiver }

constructor TScFeeRateFileArchiver.Create;
begin
  inherited;
//  FKey := P3;
  FKey := ByteArrayToStr(PA3, Length(PA3));
end;

function TScFeeRateFileArchiver.NeedCheckPassWord: Boolean;
begin
  Result := False;
end;

{ TScUnitPriceFileArchiver }

constructor TScUnitPriceFileArchiver.Create;
begin
  inherited;
//  FKey := P4;
  FKey := ByteArrayToStr(PA4, Length(PA4));
end;

function TScUnitPriceFileArchiver.NeedCheckPassWord: Boolean;
begin
  Result := False;
end;

{ TBillsFairyExtractor }

constructor TBillsFairyExtractor.Create;
begin
//  FKey := P5;
  FKey := ByteArrayToStr(PA5, Length(PA5));
  FArchiver := TMemStreamExtractor.Create(nil);
  FArchiver.OnRequestCryptKey := DoOnArchiverNeedKey;
  FArchiver.ErrorAction := eaContinue;
  FArchiver.RestoreAction := raOverwrite;
  FArchiver.Options := FArchiver.Options + [oCrypt];
end;

destructor TBillsFairyExtractor.Destroy;
begin
  FArchiver.Free;
  inherited;
end;

procedure TBillsFairyExtractor.DoOnArchiverNeedKey(Sender: TObject;
  var Key: string);
begin
  Key := FKey;
end;

function TBillsFairyExtractor.Extract: TMemoryStream;
begin
  try
    try
      FTempFile := GetTempFileName('.' + GetTempName(3));
      AddToFileList(FTempFile);
      ReadAndRemoveHead;
      Result := TMemoryStream.Create;
      FArchiver.FileName := FTempFile;
      FArchiver.ExtractMemStream(Result);
    except
      Result := nil;
    end;
  finally
    if FileExists(FTempFile) then
      DeleteFile(FTempFile);
  end;
end;

procedure TBillsFairyExtractor.ReadAndRemoveHead;
var
  F, FT: TFileStream;
begin
  AddToFileList(FTempFile);
  F := TFileStream.Create(FFileName, fmOpenRead);
  FT := TFileStream.Create(FTempFile, fmCreate);
  try
    F.Seek($00, soFromBeginning);
    F.Read(FFileInfo, Sizeof(TScFile7Head));
    FT.Seek($00, soFromBeginning);
    FT.CopyFrom(F, F.Size - Sizeof(TScFile7Head));
  finally
    F.Free;
    FT.Free;
  end;
end;

procedure TBillsFairyExtractor.SetFileName(const Value: string);
begin
  FFileName := Value;
  if not FileExists(Value) then
    raise EScFileSystem.CreateFmt('文件[%s]不存在！', [Value]);
  SetFileWritable(Value);
end;

{ TReportExtractor }

function TReportArchiver.Archive(AStream: TStream): Boolean;
var
  TempStream: TFileStream;
begin
  Result := False;
  FTempFile := GetTempFileName('.' + GetTempName(3));
  AddToFileList(FTempFile);
  FArchiver.FileName := FTempFile;
  try
    FArchiver.Open;
    AStream.Seek(0, soFromBeginning);
    Result := FArchiver.AddStream(AStream);
  finally
    FArchiver.Close;
  end;
  if Result then
  begin
    if not FileExists(FTempFile) then
      raise EScFileSystem.Create('保存文件失败！');
    TempStream := TFileStream.Create(FTempFile, fmOpenReadWrite);
    try
      WriteAndAddHead(TempStream);
    finally
      TempStream.Free;
    end;
    if not CopyFile(PChar(FTempFile), PChar(FFileName), False) then
      raise EScFileSystem.Create('保存文件失败！');
  end;
end;

constructor TReportArchiver.Create;
begin
//  FKey := P6;
  FKey := ByteArrayToStr(PA6, Length(PA6));
  FArchiver := TStreamArchiver.Create(nil);
  FArchiver.OnRequestCryptKey := DoOnArchiverNeedKey;
  FArchiver.OnEnterCryptKey := DoOnArchiverNeedKey;
  FArchiver.ErrorAction := eaContinue;
  FArchiver.RestoreAction := raOverwrite;
  FArchiver.Options := FArchiver.Options + [oCrypt];
end;

destructor TReportArchiver.Destroy;
begin
  FArchiver.Free;
  inherited;
end;

procedure TReportArchiver.DoOnArchiverNeedKey(Sender: TObject;
  var Key: string);
begin
  Key := FKey;
end;

function TReportArchiver.Extract: TMemoryStream;
begin
  try
    try
      FTempFile := GetTempFileName('.' + GetTempName(3));
      AddToFileList(FTempFile);
      ReadAndRemoveHead;
      Result := TMemoryStream.Create;
      Result.Size := 0;
      FArchiver.FileName := FTempFile;
      FArchiver.ExtractMemStream(Result);
      Result.Seek(0, soFromBeginning);
    except
      Result := nil;
    end;
  finally
    if FileExists(FTempFile) then
      DeleteFile(FTempFile);
  end;
end;

procedure TReportArchiver.ReadAndRemoveHead;
var
  F, FT: TFileStream;
begin
  AddToFileList(FTempFile);
  F := TFileStream.Create(FFileName, fmOpenRead);
  FT := TFileStream.Create(FTempFile, fmCreate);
  try
    F.Seek($00, soFromBeginning);
    F.Read(FFileInfo, Sizeof(TScFile7Head));
    FT.Seek($00, soFromBeginning);
    FT.CopyFrom(F, F.Size - Sizeof(TScFile7Head));
  finally
    F.Free;
    FT.Free;
  end;
end;

procedure TReportArchiver.SetFileName(const Value: string);
begin
  if not FileExists(Value) then
    raise EScFileSystem.CreateFmt('文件[%s]不存在！', [Value]);
  SetFileWritable(Value);
  FFileName := Value;
end;

procedure TReportArchiver.WriteAndAddHead(AStream: TStream);
var
  FT: TMemoryStream;
begin
  FT := TMemoryStream.Create;
  try
    FT.Seek($00, soFromBeginning);
    FT.Write(FFileInfo, Sizeof(TScFile7Head));
    AStream.Seek(0,soFromBeginning);
    FT.CopyFrom(AStream, AStream.Size);
    AStream.Size := 0;
    AStream.Seek($00, soFromBeginning);
    FT.Seek($00, soFromBeginning);
    AStream.CopyFrom(FT, FT.Size);
  finally
    FT.Free;
  end;
end;

{ TScCommonDataArchiver }

constructor TScCommonDataArchiver.Create;
begin
  inherited;
  FKey := ByteArrayToStr(PA7, Length(PA7));
end;

function TScCommonDataArchiver.NeedCheckPassWord: Boolean;
begin
  Result := False;
end;

{ TScFileArchiverManager }

function TScFileArchiverManager.AddArchiver(
  AArchiver: TScFileArchiver): Integer;
begin
  Result := FList.Add(AArchiver);
end;

constructor TScFileArchiverManager.Create;
begin
  FList := TList.Create;
end;

destructor TScFileArchiverManager.Destroy;
begin
  FList.Free;
  inherited;
end;

function TScFileArchiverManager.GetAlias(FileName: string): string;
var
  I: Integer;
begin
  Result := '';
  // 先在已打开的文件中找
  for I := 0 to Count - 1 do
  begin
    if SameFileName(FileName, Items[I].FileName) then
    begin
      Result := Items[I].Alias;
      Exit;
    end;
  end;
  // 再到磁盘上找
  if FileExists(FileName) then
    Result := GetFileAlias(FileName);
end;

function TScFileArchiverManager.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TScFileArchiverManager.GetItems(Index: Integer): TScFileArchiver;
begin
  Result := TScFileArchiver(FList[Index]);
end;

procedure TScFileArchiverManager.RemoveArchiver(
  AArchiver: TScFileArchiver);
begin
  FList.Remove(AArchiver);
end;

procedure TScFileArchiverManager.SetAlias(FileName: string;
  const Value: string);
var
  I: Integer;
begin
  // 先在已打开的文件中找
  for I := 0 to Count - 1 do
  begin
    if SameFileName(FileName, Items[I].FileName) and (not SameText(Items[I].Alias, Value)) then
    begin
      Items[I].Alias := Value;
      //{to do: 似乎有点问题，为了保存别名必须保存整个文件，也许不是操作者的愿望}
      //Items[I].Save;
      Items[I].SaveHead;
      Exit;
    end;
  end;
  // 再到磁盘上找
  if FileExists(FileName) then
    SetFileAlias(FileName, Value);
end;

function FileArchiverManager: TScFileArchiverManager;
begin
  if g_FileArchiverManager = nil then
    g_FileArchiverManager := TScFileArchiverManager.Create;
  Result := g_FileArchiverManager;
end;

{ TScCommonStreamArchiver }

constructor TScCommonStreamArchiver.Create;
begin
  FKey := ByteArrayToStr(PA7, Length(PA7));
  FArchiver := TStreamArchiver.Create(nil);
  FArchiver.OnRequestCryptKey := DoOnArchiverNeedKey;
  FArchiver.OnEnterCryptKey := DoOnArchiverNeedKey;
  FArchiver.ErrorAction := eaContinue;
  FArchiver.RestoreAction := raOverwrite;
  FArchiver.Options := FArchiver.Options + [oCrypt];
end;

destructor TScCommonStreamArchiver.Destroy;
begin
  FArchiver.Free;
  inherited;
end;

procedure TScCommonStreamArchiver.DoOnArchiverNeedKey(Sender: TObject;
  var Key: string);
begin
  Key := FKey;
end;

function TScCommonStreamArchiver.Open: TMemoryStream;
begin
  try
    try
      FTempFile := GetTempFileName('.' + GetTempName(3));
      AddToFileList(FTempFile);
      ReadAndRemoveHead;
      Result := TMemoryStream.Create;
      Result.Size := 0;
      FArchiver.FileName := FTempFile;
      FArchiver.ExtractMemStream(Result);
      Result.Seek(0, soFromBeginning);
    except
      Result := nil;
    end;
  finally
    if FileExists(FTempFile) then
      DeleteFile(FTempFile);
  end;
end;

procedure TScCommonStreamArchiver.ReadAndRemoveHead;
var
  F, FT: TFileStream;
begin
  AddToFileList(FTempFile);
  F := TFileStream.Create(FFileName, fmOpenRead);
  FT := TFileStream.Create(FTempFile, fmCreate);
  try
    F.Seek($00, soFromBeginning);
    F.Read(FFileInfo, Sizeof(TScFile7Head));
    FT.Seek($00, soFromBeginning);
    FT.CopyFrom(F, F.Size - Sizeof(TScFile7Head));
  finally
    F.Free;
    FT.Free;
  end;
end;

function TScCommonStreamArchiver.Save(AStream: TStream): Boolean;
begin
  Result := SaveAs(AStream, FFileName);
end;

function TScCommonStreamArchiver.SaveAs(AStream: TStream;
  AFileName: string): Boolean;
var
  TempStream: TFileStream;
begin
  Result := False;
  FTempFile := GetTempFileName('.' + GetTempName(3));
  AddToFileList(FTempFile);
  FArchiver.FileName := FTempFile;
  try
    FArchiver.Open;
    AStream.Seek(0, soFromBeginning);
    Result := FArchiver.AddStream(AStream);
  finally
    FArchiver.Close;
  end;
  if Result then
  begin
    if not FileExists(FTempFile) then
      raise EScFileSystem.Create('保存文件失败！');
    TempStream := TFileStream.Create(FTempFile, fmOpenReadWrite);
    try
      WriteAndAddHead(TempStream);
    finally
      TempStream.Free;
    end;
    if not CopyFile(PChar(FTempFile), PChar(AFileName), False) then
      raise EScFileSystem.Create('保存文件失败！');
  end;
end;

procedure TScCommonStreamArchiver.SetFileName(const Value: string);
begin
  if not FileExists(Value) then
    raise EScFileSystem.CreateFmt('文件[%s]不存在！', [Value]);
  SetFileWritable(Value);
  FFileName := Value;
end;

procedure TScCommonStreamArchiver.SetFileVer(AVer: string);
begin
  FFileInfo.FileVersion := AVer;
end;

procedure TScCommonStreamArchiver.WriteAndAddHead(AStream: TStream);
var
  FT: TMemoryStream;
begin
  FT := TMemoryStream.Create;
  try
    FT.Seek($00, soFromBeginning);
    FFileInfo.ProductName := ConstProductName;
    FFileInfo.ProductVersion := ConstProductVersion;
    FFileInfo.FileVersion := ConstCommonStreamFileVersion;
    FT.Write(FFileInfo, Sizeof(TScFile7Head));
    AStream.Seek(0,soFromBeginning);
    FT.CopyFrom(AStream, AStream.Size);
    AStream.Size := 0;
    AStream.Seek($00, soFromBeginning);
    FT.Seek($00, soFromBeginning);
    AStream.CopyFrom(FT, FT.Size);
  finally
    FT.Free;
  end;
end;

initialization
  //DeleteAllFile;

finalization
  if FileList <> nil then
    FreeAndNil(FileList);
  if g_FileArchiverManager <> nil then
    FreeAndNil(g_FileArchiverManager);

end.
