lzexplic.pas

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

{$I LZDefine.inc}

unit LZExplic;
{ sample "explicit" or "dynamic" import unit for ChiefLZ.dll ... }

interface
uses
{$ifdef Win32}
Windows,
SysUtils,
LZ_Link,
{$else Win32}
{$ifdef dpmi}
WinAPI,
{$else dpmi}
WinTypes,
WinProcs,
{$endif dpmi}
{$ifdef Delphi}
Messages,
SysUtils,
{$else Delphi}
{$ifndef dpmi}
Win31,
{$endif dpmi}
Strings,
{$endif Delphi}
{$endif Win32}
ChfTypes,
ChfUtils;

{exported functions}

VAR IsChiefLZArchive: Function(const fName: {$ifdef Win32} string
                                            {$else}        PChar
                                            {$endif} ): boolean;
{$ifdef Win32} stdcall; {$endif Win32}

{$ifdef Win32}
VAR GetChiefLZFileName: Function(const fName: string): string;
  stdcall;
{$else}
VAR GetChiefLZFileName: Function(fName, Dest:PChar): boolean;
{$endif Win32}

VAR GetChiefLZFileSize: Function(fName: {$ifdef Win32} string
                                        {$else}        PChar
                                        {$endif}): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}

VAR GetChiefLZArchiveInfo: Function(const ArchName: {$ifdef Win32} string;
                                                    {$else Win32}  PChar;
                                                    {$endif Win32}
                                    var   Header: TChiefLZArchiveHeader): boolean;
{$ifdef Win32} stdcall; {$endif Win32}

VAR GetChiefLZArchiveSize: Function(const ArchName: {$ifdef Win32} string
                                                    {$else Win32}  PChar
                                                    {$endif Win32}): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}

VAR LZCompress: Function(const {$ifdef Win32} Source, Dest:   string
                               {$else}        aSource, aDest: pChar
                               {$endif};
                         LZQuestion: TLZQuestionFunc;
                         aProc:      TLZReportProc): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}

VAR LZDecompress: Function({$ifdef Win32} Source, Dest:  string
                           {$else} const aSource, aDest: PChar
                           {$endif};
                           LZQuestion: TLZQuestionFunc;
                           aProc:      TLZReportProc): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}


VAR IsChiefLZFile: Function(const fName: {$ifdef Win32} string
                                         {$else}        PChar
                                         {$endif}): boolean;
{$ifdef Win32} stdcall; {$endif Win32}


VAR LZArchive: Function(const fSpec, ArchName: {$ifdef Win32} string
                                               {$else}        PChar
                                               {$endif};
                        LZRecurseDirs: TLZRecurse;
                        aProc:         TLZReportProc): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}


VAR LZDearchive: Function(ArchName: {$ifdef Win32} string
                                    {$else}        PChar
                                    {$endif};
                                    {$ifdef Win32} DefDir: string
                                    {$else} const aDefDir: PChar
                                    {$endif};
                          LZQuestion: TLZQuestionFunc;
                          aProc:      TLZReportProc;
                          aRename:    TLZRenameFunc): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}


VAR LZCompressEx: Function(const {$ifdef Win32} Name:  string
                                 {$else}        aName: PChar
                                 {$endif};
                           ReplaceQuestion: TLZQuestionFunc;
                           aProc:           TLZReportProc): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}


VAR LZDecompressEx: Function({$ifdef Win32} Name:  string
                             {$else}        aName: PChar
                             {$endif};
                             ReplaceQuestion: TLZQuestionFunc;
                             aProc:           TLZReportProc): LongInt;
{$ifdef Win32} stdcall; {$endif Win32}


VAR GetLZMarkerChar: Function: Char; {$ifdef Win32} stdcall; {$endif}

VAR SetLZMarkerChar: Procedure(const NewChar: Char);
                                         {$ifdef Win32} stdcall; {$endif}

VAR ChiefLZDLLVersion: Function: Integer; {$ifdef Win32} stdcall; {$endif}

Var GetFullLZName: Function(Const X: TChiefLZArchiveHeader;
                              Index: Integer): String;
{$ifdef Win32} stdcall; {$endif}


Function LoadChiefLZDLL(DLLName: PChar): {$ifdef Win32} BOOL {$else} Integer {$endif};
{load the ChiefLZ DLL - Win16 returns 0 if successful,
                        and something else if not successful
                      - Win32 returns True if successful and False otherwise
                        If False, the error code is obtained by calling
                        GetLastError()
                      - you can supply a new DLL name to use instead of
                        the default "ChiefLZ.DLL".
Call this first, before doing anything}

Function UnloadChiefLZDLL: {$ifdef Win32} BOOL {$else} Boolean {$endif};
{unload the DLL - call this last, after doing the LZ functions}

Function GetChiefLZDLLHandle: THandle;
{return the value of the ChiefLZDLLHandle}

implementation

{$ifdef Win32}
Var
{$else Win32}
Const
{$endif Win32}
ChiefLZDLLHandle: THandle = 0;

{$ifdef Win32}
Var
{$else Win32}
Const
{$endif Win32}
ChiefLZDLLDefaultName: PChar = 'ChiefLZ.DLL';  {DLL Name}
{ This is the default in the DLL "load" function; we will use this pointer
  if no other is passed in LoadChiefLZDLL() }

{/////////////////////////////////////////////}
{$ifdef Win32}
function LoadChiefLZProc(var   FuncAddr:  Pointer;
                         const FuncIndex: Integer): boolean;
var
  LocalAddr: Pointer;
begin
  LocalAddr := GetProcAddress(ChiefLZDLLHandle, Ptr(FuncIndex));
  Result := LocalAddr <> nil;
  if Result then
    FuncAddr := LocalAddr
end;
{$endif Win32}
{/////////////////////////////////////////////}
{/////////////////////////////////////////////}
Function LoadChiefLZDLL(DLLName: PChar): {$ifdef Win32} BOOL {$else} Integer {$endif};
{$ifndef DPMI}
Var
  OldWError: THandle;
{$endif DPMI}
Begin

{see if we supplied another DLL name; use default if we didn't ...}
  if StrLen(DLLName) = 0 then
    DLLName := ChiefLZDLLDefaultName;

 {$ifdef Win32}
{
  First check that a DLL hasn't already been loaded ... There is no
  guarantee that the existing DLL is the same as DLLName, and loading
  library DLLName will destroy ChiefLZDLLHandle ...
}
  if ChiefLZDLLHandle <> 0 then
    RaiseError(EChiefLZDLL,SDLLReadyLoaded);
{
  Load DLL, putting Windows handle in ChiefLZDLLHandle ...
}
  OldWError := SetErrorMode(sem_NoOpenFileErrorBox);
  ChiefLZDLLHandle := LoadLibrary(DLLName);
  SetErrorMode(OldWError);
  if ChiefLZDLLHandle = 0 then
    Result := False  // Load failed
  else
{
  Loaded successfully: put the addresses of the DLL functions into
  procedural and functional variables ...
}
    begin
      Result := LoadChiefLZProc(@LZCompress, 1) and
                LoadChiefLZProc(@LZDecompress, 2) and
                LoadChiefLZProc(@IsChiefLZFile, 3) and
                LoadChiefLZProc(@LZArchive, 4) and
                LoadChiefLZProc(@LZDearchive, 5) and

                LoadChiefLZProc(@IsChiefLZArchive, 6) and
                LoadChiefLZProc(@GetChiefLZFileName, 7) and
                LoadChiefLZProc(@GetChiefLZFileSize, 8) and
                LoadChiefLZProc(@GetChiefLZArchiveInfo, 9) and

                LoadChiefLZProc(@LZCompressEx, 10) and
                LoadChiefLZProc(@LZDecompressEx, 11) and

                LoadChiefLZProc(@GetLZMarkerChar, 12) and
                LoadChiefLZProc(@SetLZMarkerChar, 13) and

                LoadChiefLZProc(@GetFullLZName, 14) and
                LoadChiefLZProc(@ChiefLZDLLVersion, 15) and
                LoadChiefLZProc(@GetChiefLZArchiveSize, 16);
      if not Result then
        UnloadChiefLZDLL   // At least one load failed: backtrack out...
    end

  {$else Win32}

   LoadChiefLZDLL := -1; {DLL can't be loaded}
   {$ifndef DPMI}
   OldWError := SetErrorMode(sem_NoOpenFileErrorBox);
   {$endif DPMI}

   {v1.01 - fixed bug on next line}
   ChiefLZDLLHandle := LoadLibrary(DLLName);

   {$ifndef DPMI}
   SetErrorMode(OldWError);
   {$endif DPMI}
   If ChiefLZDLLHandle <= 32 then Exit;

   LoadChiefLZDLL := -2; {undefined dyna-link}
   @LZCompress        := GetProcAddress(ChiefLZDLLHandle, 'LZCompress');
   @LZDecompress      := GetProcAddress(ChiefLZDLLHandle, 'LZDecompress');
   @IsChiefLZFile     := GetProcAddress(ChiefLZDLLHandle, 'IsChiefLZFile');
   @LZArchive         := GetProcAddress(ChiefLZDLLHandle, 'LZArchive');
   @LZDeArchive       := GetProcAddress(ChiefLZDLLHandle, 'LZDearchive');

   @IsChiefLZArchive  := GetProcAddress(ChiefLZDLLHandle, 'IsChiefLZArchive');
   @GetChiefLZFileName:= GetProcAddress(ChiefLZDLLHandle, 'GetChiefLZFileName');
   @GetChiefLZFileSize:= GetProcAddress(ChiefLZDLLHandle, 'GetChiefLZFileSize');
   @GetChiefLZArchiveInfo:= GetProcAddress(ChiefLZDLLHandle, 'GetChiefLZArchiveInfo');
   @LZCompressEx         := GetProcAddress(ChiefLZDLLHandle, 'LZCompressEx');
   @LZDeCompressEx       := GetProcAddress(ChiefLZDLLHandle, 'LZDecompressEx');
   @GetLZMarkerChar      := GetProcAddress(ChiefLZDLLHandle, 'GetLZMarkerChar');
   @SetLZMarkerChar      := GetProcAddress(ChiefLZDLLHandle, 'SetLZMarkerChar');
   @GetFullLZName        := GetProcAddress(ChiefLZDLLHandle, 'GetFullLZName');
   @ChiefLZDLLVersion    := GetProcAddress(ChiefLZDLLHandle, 'ChiefLZDLLVersion');
   @GetChiefLZArchiveSize := GetProcAddress(ChiefLZDLLHandle, 'GetChiefLZArchiveSize');

   If (@LZCompress = Nil)
   or (@LZDecompress = Nil)
   or (@IsChiefLZFile = Nil)
   or (@LZArchive = Nil)
   or (@LZDeArchive = Nil)
   or (@IsChiefLZArchive = Nil)
   or (@GetChiefLZFileName = Nil)
   or (@GetChiefLZFileSize = Nil)
   or (@GetChiefLZArchiveInfo = Nil)
   or (@LZCompressEx = Nil)
   or (@LZDeCompressEx = Nil)
   or (@GetLZMarkerChar = Nil)
   or (@SetLZMarkerChar = Nil)
   or (@GetFullLZName = Nil)
   or (@ChiefLZDLLVersion = Nil)
   or (@GetChiefLZArchiveSize = Nil)
   then begin
      FreeLibrary(ChiefLZDLLHandle);
      ChiefLZDLLHandle := 0;
      Exit;
   end;

  LoadChiefLZDLL := 0; {success}

  {$endif Win32}
End;
{/////////////////////////////////////////////}
{$ifdef Win32}
Function UnloadChiefLZDLL: BOOL;
Begin
{
  Make sure the DLL has been loaded first ...
}
  if ChiefLZDLLHandle = 0 then
    Result := True    // DLL is (was already) unloaded
  else
{
  WAS loaded: now to unload ...
}
    begin
      Result := FreeLibrary(ChiefLZDLLHandle);
      if Result then
        ChiefLZDLLHandle := 0  // Success
    end
End;
{$else Win32}
Function UnloadChiefLZDLL: Boolean;
Begin
   UnloadChiefLZDLL := False; {invalid handle}
   If ChiefLZDLLHandle > 32
   then begin
      FreeLibrary(ChiefLZDLLHandle);
      UnloadChiefLZDLL := True;
   end;
   ChiefLZDLLHandle := 0;
End;
{$endif Win32}
{/////////////////////////////////////////////}

Function GetChiefLZDLLHandle: THandle;
{return the value of the ChiefLZDLLHandle}
Begin
  GetChiefLZDLLHandle := ChiefLZDLLHandle
End;
{/////////////////////////////////////////////}
{/////////////////////////////////////////////}
{/////////////////////////////////////////////}
{/////////////////////////////////////////////}
{/////////////////////////////////////////////}
End.