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Ｂ?;? 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.