chieflz.pas

delhpi下lzss加密算法源码及例子

{
   CHIEFLZ UNIT/DLL, by Dr A Olowofoyeku (the African Chief);
   internet: [e-mail]
   http://ourworld.compuserve.com/homepages/African_Chief/

   Version 1.00.

   USES the original LZSSUNIT source, as amended by the Chief,
   and Chris J Rankin. Ported to Win32 (Delphi 2.0) by Chris Rankin.

   // -----------------------------------------------------------//
    * 16-bit ASM functions converted to 32-bit ASM by Chris J Rankin
    * Win32 (Delphi 2.0) code: added by Chris J Rankin

  Package assembled together for first public release: 5th September 1996.

  The routines in this package are already being used in some famous
  programs!

}



{----------------------------------------------------------------------}
{to compile to a DLL in Delphi you need to rename this with the
extension .DPR}

{$I LZDefine.inc}   {// defines various things, including "aDLL" //}

{$ifDef aDLL}
 Library ChiefLZ;

 Uses
 {$ifdef Win32}
   ShareMem,    // Because the library exports functions that have
                // long-string results/parameters, we need to use
                // the ShareMem unit. All apps that use this library
                // *must also use ShareMem* - Put DelphiMM.dll on the
                // Path too ...
   Windows,
   LZSS32,
   LZ_Const,
   LZ_DLL,
 {$else Win32}
   LZSS16,
 {$ifdef Windows}
 {$ifdef DPMI}
   WinAPI,
 {$else DPMI}
   WinProcs,
 {$endif DPMI}
 {$endif Windows}
 {$endif Win32}
 {$ifDef Delphi}
   SysUtils,
 {$else Delphi}
   WinDos,
   Strings,
 {$endif Delphi}
   ChfTypes,
   ChfUtils;

{$else aDLL}
 Unit ChiefLZ;
{$endif aDLL}

{------------------------------------------------------------}

{$ifNDef aDLL}
interface
uses
{$ifdef Delphi}
  SysUtils,
{$endif}
  ChfTypes;
{$endif aDLL}

 Const ChiefLZVersionNumber = 102; { version 1.02 }

{$ifdef Win32} Var
{$else}        Const
{$endif} MyLZMarker:Char = '~'; {last char in filenames created automatically}

{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
  {Pascal object encapsulating the functionality of
  this unit - CANNOT BE EXPORTED BY DLL}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{$ifndef aDLL}

Type
LZObj={$ifdef Delphi}Class{$else Delphi}Object{$Endif Delphi}
   Constructor {$ifdef Delphi} Create
               {$else}         Init
               {$endif}(Const InfName, OutFName:String);
   {you can init with source and target file names,
   or with blanks - so set the source and target file names
   later
   }

   Destructor {$ifdef Delphi} Destroy; override
              {$else}         Done;    virtual
              {$endif};

   {$ifndef Delphi}
   Procedure SetInputName(Const aName: String);
   {set source file name; absolutely necessary}

   Procedure SetOutputName(Const aName: String);
   {set target file name = if empty, then a default one
   will be used}

   Procedure SetReportProc(const aProc: TLZReportProc);
   {point to procedure to report progress}

   Procedure SetQuestionProc(const aProc: TLZQuestionFunc);
   {point to function to ask question if the target file exists
   already - if nothing is set, then existing target files will
   be overwritten automatically}
   {$endif}

   Function Compress: Longint; virtual;
   {compress the source file >> target file }

   Function Decompress: Longint; virtual;
   {decompress the source file >> target file}

 private
 {$ifdef Delphi}
   FQuestionProc: TLZQuestionFunc;
   FReportProc  : TLZReportProc;
   fInputName,
   fOutputName  : StrType;
   function GetIsInited: boolean;
 public
   property QuestionProc: TLZQuestionFunc read FQuestionProc
                                          write FQuestionProc;
   property ReportProc: TLZReportProc read FReportProc
                                      write FReportProc;
   property IsInited:   boolean read GetIsInited;
   property InputName:  StrType read FInputName write FInputName;
   property OutputName: StrType read FOutputName write FOutputName;
 {$else Delphi}
   IsInited    : boolean;
   QuestionProc: TLZQuestionFunc;
   ReportProc  : TLZReportProc;
   InputName,
   OutputName  : StrType;
 {$endif Delphi}
End{LZOBJ};
{$endif aDLL}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}

{exported INTERFACE functions}
{$ifNDef aDLL}

Function LZCompress(const {$ifdef Win32} Source, Dest:   string
                          {$else}        aSource, aDest: PChar
                          {$endif};
                    LZQuestion: TLZQuestionFunc;
                    aProc:      TLZReportProc):LongInt;
{ This Function is used for compression.
  Source     = Source file name
  Dest       = target file name
  LZQuestion = procedural type to ask for overwrite permission
  aProc      = procedural type to return progress information
}


Function LZDecompress({$ifdef Win32} Source, Dest:  string
                      {$else} const aSource, aDest: PChar
                      {$endif};
                      LZQuestion: TLZQuestionFunc;
                      aProc:      TLZReportProc):LongInt;
{ This functione is used for decompression.
  Source     = Source file name
  Dest       = target file name
  LZQuestion = procedural type to ask for overwrite permission
  aProc      = procedural type to return progress information
}

Function IsChiefLZFile(const fName: {$ifdef Win32} string
                                    {$else}        PChar
                                    {$endif} ): boolean;
{is this an LZ file compressed with this unit?}

Function LZArchive(const fSpec, ArchName: {$ifdef Win32} string
                                          {$else}        PChar
                                          {$endif};
                   LZRecurseDirs: TLZRecurse;
                   aProc:         TLZReportProc): LongInt;
{archive all the files matching "fSpec" into archive "ArchName";
 fSpec = a filespec (e.g., "*.PAS", or a filename containing a list
 of files to be archived - in which case, use "/F=<listfilename>" as
 the fSpec.
 LZRecurseDirs = whether to recurse into subdirectories for matching
 files
}

Function LZDearchive(ArchName: {$ifdef Win32} string
                               {$else}        PChar
                               {$endif};
                    {$ifdef Win32} DefDir: string
                    {$else} const aDefDir: PChar
                    {$endif};
                     LZQuestion: TLZQuestionFunc;
                     aProc:      TLZReportProc;
                     aRename:    TLZRenameFunc): LongInt;
{De-Arc a ChiefLZ archive}

Function IsChiefLZArchive(const fName: {$ifdef Win32} string
                                       {$else}        PChar
                                       {$endif} ): boolean;
{is this an LZ archive file compressed with this unit?}

Function GetChiefLZFileName{$ifdef Win32}(const fName: string): string;
                           {$else} (fName, Dest: PChar): boolean;
                           {$endif}
{if LZ file, then return name (in dest, if not Win32) - else return
 fname (in dest, if not Win32) }

Function GetChiefLZFileSize(fName: {$ifdef Win32} string
                                   {$else}        PChar
                                   {$endif}): LongInt;
{if LZ file then return uncompressed size - else
 return actual filesize. On error, Win32 throws exception; Win16 returns -1 }

function GetChiefLZArchiveInfo(const ArchName: {$ifdef Win32} string
                                               {$else Win32}  PChar
                                               {$endif Win32};
                               var Header: TChiefLZArchiveHeader): boolean;
{ if LZ-Archive then this function returns True, with the header info
  in Header. Otherwise the function returns False }

Function GetChiefLZArchiveSize(const ArchName: {$ifdef Win32} string
                                               {$else Win32}  PChar
                                               {$endif Win32}): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
              {$else Win32}  export
              {$endif Win32};
{$endif aDLL}
{ If ArchName is LZArchive, returns sum of uncompressed file-sizes in archive.
  If not LZArchive then returns size of file ArchName } 

Function LZCompressEx(const {$ifdef Win32} Name:  string
                            {$else}        aName: PChar
                            {$endif};
                      ReplaceQuestion: TLZQuestionFunc;
                      aProc:           TLZReportProc): LongInt;
{compress the file aName, and use the filename,
 with the last character replaced by a '~' as the output file
 If target file exists, and autoreplace=false then the
 function exits and returns -100 else the target file
 will be overwritten
}

Function LZDecompressEx({$ifdef Win32} Name: string
                        {$else}       aName: PChar
                        {$endif};
                        ReplaceQuestion: TLZQuestionFunc;
                        aProc:           TLZReportProc): LongInt;
{decompress the file aName, obtaining the output name from
the header automatically
If target file exists, and autoreplace=false then the
function exits and returns -100 else the target file
will be overwritten
}

function GetFullLZName(Const X    : TChiefLZArchiveHeader;
                             Index: Integer): String;
{for internal use}

{$endif aDLL}

{////////////////////////////////////////////////////}

{$ifNDef aDLL}
implementation

uses
  ChfUtils,
{$ifdef Win32}
  LZSS32, Windows, LZ_Const
{$else Win32}
  LZSS16,           { All 16-bit code }
{$ifdef Windows}
  WinProcs          { Win16 }
{$ifndef Delphi}
 ,WinDos, Strings   { TPW / BPW }
{$endif Delphi}
{$else Windows}
  Dos, Strings      { TP / BP }
{$endif Windows}
{$endif Win32};

{$endif aDLL}

{$ifdef Win32}
{
  These constants taken from SysUtils.inc ...
}
{$ifdef Ver90}
const SInOutError   = 65416;
const SFileNotFound = 65417;
const SEndOfFile    = 65421;
{$else Ver90}
//  These constants may have changed; Check SysUtils.inc ... or scan
//  the String Resource Table from 0-65535 looking for keywords ...
{$endif Ver90}
{$endif Win32}

const ChiefLZSig = 'aChiefM#';
const NulFileDate = 2162688;   { 01/01/1980 12:00a }

{////////////////////////////////////////////////////}

{//// my header to identify LZ file///}
Type
PLZHeader = ^TLZHeader;
TLZHeader = Packed Record
 fName: TLZFileStr;   {filename}
 uSize: LongInt;      {uncompressed size}
 cSize: LongInt;      {compressed size}
 fTime: LongInt;      {time/date stamp}
 Version: TLZVerStr;
 Signature: String[8];  {the identification header}
end;

Type
TLZBigFileRec= packed Record
{is it a directory}
       IsBigDir: Boolean;
{its directory ID}
       BigDirID: Word;
{its parent directory ID}
       BigParentDir: Word;
{is it compressed?}
       BigCompressed: Boolean;
{any version information?}
       BigFileVersion: TLZVerStr;
{compressed sizes}
       BigSizes: LongInt;
{uncompressed sizes}
       uBigSizes:LongInt;
{date/time stamps}
       BigTimes: LongInt;
{file names}
       BigNames: TLZPathStr
end;

PLZArchiveFiles = ^TLZArchiveFiles;
TLZArchiveFiles = Array[1..MaxChiefLZArchiveSize] of TLZBigFileRec;

Const
MySigStr = #4+^M+'ChfLZ'+#5#6#8;
MyLZSignature :String[Length(MySigStr)]= MySigStr;

Const
CopyBufSize=32000;

Type
PBufType=^TBufType;
TBufType=array[1..CopyBufSize] of byte;

{////////////////////////////////////////////////////}

Type  {don't want to use collections because of other versions of TPascal}
PLZDirArray=^TLZDirArray;
TLZDirArray = array[0..MaxChiefLZDirectories] of {$ifdef Win32} string
                                                 {$else Win32}  PString
                                                 {$endif Win32};

{////////////////////////////////////////////////////}
Var
buf : PBufType;
jR  : PLZArchiveFiles;
jR2 : PChiefLZArchiveHeader;
{
  This global variable contains a long-string field in Delphi 2; it must
  therefore be initialised if ChiefLZ is to be made into a DLL ...
  (This is a problem with Delphi v2.00 - v2.01 seems to have fixed this)
}
BlankRec: TLZReportRec {$ifdef Win32} = () {$endif Win32};

{/////////////////////////////////////////////////////////}
var aRead, aWrite: Longint;
var LZReportProc: TLZReportProc {$ifdef Win32} = nil {$endif Win32};
{
  This global variable ensures that MyReadProc() calls LZReportProc()
  only during compression, and that MyWriteProc() calls LZReportProc()
  only during decompression. This is done by setting Decompressing
  to the appropriate value immediately before calling LZEncode() or
  LZDecode().
}
var Decompressing: Boolean;

{/////////////////////////////////////////////////////////}
var InFile, OutFile: file;

{/////////////////////////////////////////////////////////}
{$ifdef Win32}
{
  These are Win32-specific functions that cannot be moved into the more
  general ChfUtils due to their dependance on types defined in ChfTypes
}
function GetTempChiefFileName: string;
var
  RetBuf: PChar;
begin
  GetMem(RetBuf, MAX_PATH);
  try
    if (GetTempPath(MAX_PATH, RetBuf) = 0) or
       (GetTempFileName(RetBuf,'CHF',0,RetBuf) = 0) then
      RaiseError(EChiefLZError,SNoTempFileName);
    SetString(Result,RetBuf,StrLen(RetBuf))
  finally
    FreeMem(RetBuf, MAX_PATH)
  end
end;

function GetFoundFileName(const Search: TSearchRec): string;
begin
  if Length(Search.Name) >= SizeOf(TLZFileStr) then
    Result := string(Search.FindData.cAlternateFileName)
  else
    Result := Search.Name  // Take long filename (if short enough)
end;                       // else take short filename

{$else Win32}

function GetTempChiefFileName(const FName: PChar): boolean; assembler;
asm
{
  Create a temporary file- FName must specify a path + '\', with enough
  room afterwards to append 12 characters.
}
  PUSH DS
  LDS DX, FName
  MOV AH, $5A
  MOV CX, faArchive
{$ifdef Windows}
  CALL DOS3Call