Subversion Repositories autosfx

unit ZMDllLoad19;

(*

  ZMDLLLoad19.pas - Dynamically load the DLL

    Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,

      Eric W. Engler and Chris Vleghert.

        This file is part of TZipMaster Version 1.9.

    TZipMaster is free software: you can redistribute it and/or modify

    it under the terms of the GNU Lesser General Public License as published by

    the Free Software Foundation, either version 3 of the License, or

    (at your option) any later version.

    TZipMaster is distributed in the hope that it will be useful,

    but WITHOUT ANY WARRANTY; without even the implied warranty of

    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License

    along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.

    contact: problems@delphizip.org (include ZipMaster in the subject).

    updates: http://www.delphizip.org

    DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip

  modified 2009-09-22

  --------------------------------------------------------------------------- *)

interface

uses

  Classes, Windows, ZMDelZip19, ZMWrkr19;

procedure _DLL_Abort(worker: TZMWorker; key: Cardinal);

function _DLL_Banner: String;

function _DLL_Build: Integer;

function _DLL_Exec(worker: TZMWorker; const Rec: pDLLCommands;

  var key: Cardinal): Integer;

function _DLL_Load(worker: TZMWorker): Integer;

function _DLL_Loaded(worker: TZMWorker): Boolean;

function _DLL_Path: String;

procedure _DLL_Remove(worker: TZMWorker);

procedure _DLL_Unload(worker: TZMWorker);

implementation

{$I '.\ZMConfig19.inc'}

uses

  SysUtils, ZipMstr19, ZMCompat19, ZMXcpt19,

{$IFNDEF STATIC_LOAD_DELZIP_DLL}

  ZMCore19, ZMExtrLZ7719, ZMUtils19, ZMDLLOpr19, SyncObjs,

{$ENDIF}

  ZMMsg19;

procedure CheckExec(RetVal: Integer);

var

  x: Integer;

begin

  if RetVal < 0 then

  begin

    x := -RetVal;

    if x > _DZ_ERR_MAX then

      raise EZipMaster.CreateResInt(GE_DLLCritical, x);

    if (x = _DZ_ERR_CANCELLED) or (x = _DZ_ERR_ABORT) then

      x := DS_Canceled

    else

      x := x + DZ_RES_GOOD;

    raise EZipMaster.CreateResDisp(x, True);

  end;

end;

{$IFDEF STATIC_LOAD_DELZIP_DLL}

// 'static' loaded dll functions

function DZ_Abort(C: Cardinal): Integer; STDCALL; EXTERNAL DelZipDLL_Name

{$IFDEF VERD2010up} Delayed {$ENDIF};

function DZ_Path: pChar; STDCALL; EXTERNAL DelZipDLL_Name

{$IFDEF VERD2010up} Delayed {$ENDIF};

function DZ_PrivVersion: Integer; STDCALL; EXTERNAL DelZipDLL_Name

{$IFDEF VERD2010up} Delayed {$ENDIF};

function DZ_Exec(C: pDLLCommands): Integer; STDCALL; EXTERNAL DelZipDLL_Name

{$IFDEF VERD2010up} Delayed {$ENDIF};

function DZ_Version: Integer; STDCALL; EXTERNAL DelZipDLL_Name

{$IFDEF VERD2010up} Delayed {$ENDIF};

function DZ_Banner: pChar; STDCALL; EXTERNAL DelZipDLL_Name

{$IFDEF VERD2010up} Delayed {$ENDIF};

function DZ_Name(var buf; bufsiz: Integer; wide: Boolean): Integer; STDCALL;

external DelZipDLL_Name {$IFDEF VERD2010up} Delayed {$ENDIF};

{$ELSE}

type

  TZMCount = record

    worker: TZMWorker;

    Count: Integer;

  end;

type

  TZMDLLLoader = class(TObject)

  private

    AbortFunc: TAbortOperationFunc;

    BannerFunc: TDLLBannerFunc;

    Counts: array of TZMCount;

    ExecFunc: TDLLExecFunc;

    fBanner: String;

    fHasResDLL: Integer;

    fKillTemp: Boolean;

    fLoadErr: Integer;

    fLoading: Integer;

    fLoadPath: String;

    fPath: String;

    fVer: Integer;

    // guard data for access by several threads

    Guard: TCriticalSection;

    hndl: HWND;

    NameFunc: TDLLNameFunc;

    PathFunc: TDLLPathFunc;

    Priv: Integer;

    PrivFunc: TDLLPrivVersionFunc;

    TmpFileName: String;

    VersFunc: TDLLVersionFunc;

    function GetIsLoaded: Boolean;

    function LoadLib(worker: TZMWorker; FullPath: String; MustExist: Boolean)

      : Integer;

    procedure ReleaseLib;

    procedure RemoveTempDLL;

  protected

    function Counts_Dec(worker: TZMWorker): Integer;

    function Counts_Find(worker: TZMWorker): Integer;

    function Counts_Inc(worker: TZMWorker): Integer;

    procedure Empty;

    function ExtractResDLL(worker: TZMWorker; OnlyVersion: Boolean): Integer;

    function LoadDLL(worker: TZMWorker): Integer;

    function UnloadDLL: Integer;

    property IsLoaded: Boolean Read GetIsLoaded;

  public

    procedure Abort(worker: TZMWorker; key: Cardinal);

    procedure AfterConstruction; override;

    function Banner: String;

    procedure BeforeDestruction; override;

    function Build: Integer;

    function Exec(worker: TZMWorker; const Rec: pDLLCommands; var key: Cardinal)

      : Integer;

    function Load(worker: TZMWorker): Integer;

    function Loaded(worker: TZMWorker): Boolean;

    function Path: String;

    procedure Remove(worker: TZMWorker);

    procedure Unload(worker: TZMWorker);

    property Ver: Integer Read fVer;

  end;

const

  MINDLLBUILD = DELZIPVERSION * 10000;

  RESVER_UNTRIED = -99; // have not looked for resdll yet

  RESVER_NONE = -1; // not available

  RESVER_BAD = 0; // was bad copy/version

  // const

  MIN_RESDLL_SIZE = 50000;

  MAX_RESDLL_SIZE = 600000;

var

  G_LoadedDLL: TZMDLLLoader = nil;

procedure TZMDLLLoader.Abort(worker: TZMWorker; key: Cardinal);

begin

  if Loaded(worker) and (hndl <> 0) then

    AbortFunc(key);

end;

procedure TZMDLLLoader.AfterConstruction;

begin

  inherited;

  Guard := TCriticalSection.Create;

  fKillTemp := False;

  Empty;

  fPath := DelZipDLL_Name;

  TmpFileName := '';

  fLoading := 0;

  fBanner := '';

  fHasResDLL := RESVER_UNTRIED; // unknown

end;

function TZMDLLLoader.Banner: String;

var

  tmp: AnsiString;

begin

  Result := '';

  if IsLoaded then

  begin

    tmp := BannerFunc;

    Result := String(tmp);

  end;

end;

procedure TZMDLLLoader.BeforeDestruction;

begin

  if hndl <> 0 then

    FreeLibrary(hndl);

  Counts := nil;

  FreeAndNil(Guard);

  hndl := 0;

  RemoveTempDLL;

  inherited;

end;

function TZMDLLLoader.Build: Integer;

begin

  Result := 0;

  if IsLoaded then

    Result := Priv;

end;

{ TZMDLLLoader }

function TZMDLLLoader.Counts_Dec(worker: TZMWorker): Integer;

var

  p: string;

  keepLoaded: Boolean;

  i: Integer;

begin

  Result := -1;

  Guard.Enter;

  try

    // find worker

    i := Counts_Find(worker);

    if i >= 0 then

    begin

      // found

      Dec(Counts[i].Count);

      Result := Counts[i].Count;

      if Result < 1 then

      begin

        // not wanted - remove from list

        Counts[i].worker := nil;

        Counts[i].Count := 0;

      end;

    end;

    // ignore unload if loading

    if fLoading = 0 then

    begin

      keepLoaded := False;

      for i := 0 to HIGH(Counts) do

        if (Counts[i].worker <> nil) and (Counts[i].Count > 0) then

        begin

          keepLoaded := True;

          break;

        end;

      if not keepLoaded then

      begin

        p := fPath;

        UnloadDLL;

        if worker.Verbosity >= zvVerbose then

          worker.ReportMsg(LD_DLLUnloaded, [p]);

      end;

    end;

  finally

    Guard.Leave;

  end;

end;

function TZMDLLLoader.Counts_Find(worker: TZMWorker): Integer;

var

  i: Integer;

begin

  Result := -1;

  if Counts <> nil then

  begin

    for i := 0 to HIGH(Counts) do

    begin

      if Counts[i].worker = worker then

      begin

        // found

        Result := i;

        break;

      end;

    end;

  end;

end;

function TZMDLLLoader.Counts_Inc(worker: TZMWorker): Integer;

var

  len: Integer;

  i: Integer;

  loadVer: Integer;

begin

  Guard.Enter;

  try

    // find worker

    i := Counts_Find(worker);

    if i >= 0 then

    begin

      // found

      Inc(Counts[i].Count);

      Result := Counts[i].Count;

    end

    else

    begin

      // need new one - any empty

      i := Counts_Find(nil);

      if i >= 0 then

      begin

        // have empty position - use it

        Counts[i].worker := worker;

        Counts[i].Count := 1;

        Result := 1;

      end

      else

      begin

        // need to extend

        len := HIGH(Counts);

        if len > 0 then

          Inc(len)

        else

          len := 0;

        SetLength(Counts, len + 4);

        // clear the rest

        for i := len + 3 downto len + 1 do

        begin

          Counts[i].worker := nil;

          Counts[i].Count := 0;

        end;

        i := len;

        Counts[i].worker := worker;

        Counts[i].Count := 1;

        Result := 1;

      end;

    end;

    if not IsLoaded then

    begin

      // avoid re-entry

      Inc(fLoading);

      try

        if fLoading = 1 then

        begin

          try

            loadVer := LoadDLL(worker);

          except

            on Ers: EZipMaster do

            begin

              loadVer := -1;

              worker.ShowExceptionError(Ers);

            end;

            on E: Exception do

            begin

              loadVer := -1;

              worker.ShowExceptionError(E);

            end;

          end;

          if loadVer < DELZIPVERSION then

          begin // could not load it - empty it (i is index for this worker)

            Counts[i].worker := nil;

            Counts[i].Count := 0;

            if worker.Verbosity >= zvVerbose then

              worker.ReportMsg(LD_LoadErr, [fLoadErr, SysErrorMessage(fLoadErr)

                  , fLoadPath]);

            Result := -1;

          end

          else

          begin

            if worker.Verbosity >= zvVerbose then

              worker.ReportMsg(LD_DLLLoaded, [fPath]);

          end;

        end;

      finally

        Dec(fLoading);

      end;

    end;

  finally

    Guard.Leave;

  end;

end;

procedure TZMDLLLoader.Empty;

begin

  hndl := 0;

  ExecFunc := nil;

  VersFunc := nil;

  PrivFunc := nil;

  AbortFunc := nil;

  NameFunc := nil;

  PathFunc := nil;

  BannerFunc := nil;

  fVer := 0;

  Priv := 0;

  fBanner := '';

end;

function TZMDLLLoader.Exec(worker: TZMWorker; const Rec: pDLLCommands;

  var key: Cardinal): Integer;

begin

  Result := -1; // what error

  if Counts_Inc(worker) > 0 then

  begin

    try

      Result := ExecFunc(Rec);

    finally

      Counts_Dec(worker);

      key := 0;

    end;

  end;

end;

function TZMDLLLoader.ExtractResDLL(worker: TZMWorker; OnlyVersion: Boolean):

    Integer;

var

  fs: TFileStream;

  rs: TResourceStream;

  done: Boolean;

  w: Word;

begin

  done := False;

  Result := -1;

  fs := nil;

  rs := nil;

  try

    // only check if unknown or know exists

    if (fHasResDLL = RESVER_UNTRIED) or (fHasResDLL > MINDLLBUILD) then

      rs := OpenResStream(DZRES_DLL, RT_RCDATA);

    if fHasResDLL = RESVER_UNTRIED then

      fHasResDLL := RESVER_NONE; // in case of exception

    // read the dll version if it exists

    if (rs <> nil) and (rs.Size > MIN_RESDLL_SIZE) and

      (rs.Size < MAX_RESDLL_SIZE) then

    begin

      rs.Position := 0;

      rs.ReadBuffer(Result, sizeof(Integer));

      fHasResDLL := Result;   // the dll version

      if (Result > MINDLLBUILD) and not OnlyVersion then

      begin

        rs.ReadBuffer(w, sizeof(Word));

        rs.Position := sizeof(Integer);

        TmpFileName := worker.MakeTempFileName('DZ_', '.dll');

        if TmpFileName = '' then

            raise EZipMaster.CreateResDisp(DS_NoTempFile, True);

        fs := TFileStream.Create(TmpFileName, fmCreate);

        if w = IMAGE_DOS_SIGNATURE then

          done := fs.CopyFrom(rs, rs.Size - sizeof(Integer)) =

            (rs.Size - sizeof(Integer))

        else

          done := LZ77Extract(fs, rs, rs.Size - sizeof(Integer)) = 0;

        if not done then

          fHasResDLL := RESVER_BAD; // could not extract

      end;

    end;

  finally

    FreeAndNil(fs);

    FreeAndNil(rs);

    if not OnlyVersion then

    begin

      if (not done) and FileExists(TmpFileName) then

        DeleteFile(TmpFileName);

      if not FileExists(TmpFileName) then

        TmpFileName := '';

    end;

  end;

end;

function TZMDLLLoader.GetIsLoaded: Boolean;

begin

  Result := hndl <> 0;

end;

function TZMDLLLoader.Load(worker: TZMWorker): Integer;

begin

  Result := 0;

  if Counts_Inc(worker) > 0 then

    Result := G_LoadedDLL.Ver;

end;

function TZMDLLLoader.LoadDLL(worker: TZMWorker): Integer;

var

  AllowResDLL: Boolean;

  FullPath: String;

  DBuild: Integer;

  DLLDirectory: String;

  dpth: string;

begin

  if hndl = 0 then

  begin

    fVer := 0;

    FullPath := '';

    DLLDirectory := DelimitPath(TZMDLLOpr(worker).DLLDirectory, False);

    if DLLDirectory = '><' then

    begin

      // use res dll (or else)

      if (TmpFileName <> '') or (ExtractResDLL(worker, False) > MINDLLBUILD{MIN_RESDLL_SIZE}) then

        LoadLib(worker, TmpFileName, True);

      Result := fVer;

      exit;

    end;

    if DLLDirectory <> '' then

    begin

      // check relative?

      if DLLDirectory[1] = '.' then

        FullPath := PathConcat(ExtractFilePath(ParamStr(0)), DLLDirectory)

      else

        FullPath := DLLDirectory;

      if (ExtractNameOfFile(DLLDirectory) <> '') and

        (CompareText(ExtractFileExt(DLLDirectory), '.DLL') = 0) then

      begin

        // must load the named dll

        LoadLib(worker, FullPath, True);

        Result := fVer;

        exit;

      end;

      dpth := ExtractFilePath(FullPath);

      if (dpth <> '') and not DirExists(dpth) then

        FullPath := '';

    end;

    AllowResDLL := DLLDirectory = ''; // only if no path specified

//    DBuild := MINDLLBUILD;//0;

    if AllowResDLL then

    begin

      // check for res dll once only

      if fHasResDLL = RESVER_UNTRIED then

        ExtractResDLL(worker, True);  // read the res dll version if it exists

      if fHasResDLL < MINDLLBUILD then

        AllowResDLL := False;  // none or bad version

    end;

    DBuild := LoadLib(worker, PathConcat(FullPath, DelZipDLL_Name), not AllowResDLL);

    // if not loaded we only get here if allowResDLL is true;

    if DBuild < MINDLLBUILD then

    begin

      // use resdll if no other available

      if (TmpFileName <> '') or (ExtractResDLL(worker, False) > 0) then

      begin

        if LoadLib(worker, TmpFileName, False) < MINDLLBUILD then

        begin

          // could not load the res dll

          fHasResDLL := RESVER_BAD; // is bad version

        end;

      end;

    end;

  end;

  Result := fVer;

  // if (Result > 0) and (worker.Verbosity >= zvVerbose) then

  // worker.ReportMsg(LD_DLLLoaded,[fPath]);

end;

function TZMDLLLoader.Loaded(worker: TZMWorker): Boolean;

var

  i: Integer;

begin

  Result := False;

  i := Counts_Find(worker);

  if (i >= 0) and (Counts[i].Count > 0) then

    Result := True;

end;

// returns build

function TZMDLLLoader.LoadLib(worker: TZMWorker; FullPath: String;

  MustExist: Boolean): Integer;

var

  oldMode: Cardinal;

  tmp: AnsiString;

begin

  if hndl > 0 then

    FreeLibrary(hndl);

  Empty;

  fLoadErr := 0;

  fLoadPath := FullPath;

  oldMode := SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOGPFAULTERRORBOX);

  try

    hndl := LoadLibrary(pChar(FullPath));

    if hndl > HInstance_Error then

    begin

      @ExecFunc := GetProcAddress(hndl, DelZipDLL_Execfunc);

      if (@ExecFunc <> nil) then

        @VersFunc := GetProcAddress(hndl, DelZipDLL_Versfunc);

      if (@VersFunc <> nil) then

        @PrivFunc := GetProcAddress(hndl, DelZipDLL_Privfunc);

      if (@PrivFunc <> nil) then

        @AbortFunc := GetProcAddress(hndl, DelZipDLL_Abortfunc);

      if (@AbortFunc <> nil) then

        @NameFunc := GetProcAddress(hndl, DelZipDLL_Namefunc);

      if (@NameFunc <> nil) then

        @BannerFunc := GetProcAddress(hndl, DelZipDLL_Bannerfunc);

      if (@BannerFunc <> nil) then

        @PathFunc := GetProcAddress(hndl, DelZipDLL_Pathfunc);

    end

    else

      fLoadErr := GetLastError;

  finally

    SetErrorMode(oldMode);

  end;

  if hndl <= HInstance_Error then

  begin

    Empty;

    if MustExist then

    begin

      if worker.Verbosity >= zvVerbose then

        worker.ReportMsg(LD_LoadErr, [fLoadErr, SysErrorMessage(fLoadErr),

          fLoadPath]);

      raise EZipMaster.CreateResStr(LD_NoDLL, FullPath);

    end;

    Result := 0;

    exit;

  end;

  if (@BannerFunc <> nil) then

  begin

    Priv := PrivFunc;

    fVer := VersFunc;

    SetLength(fPath, MAX_PATH + 1);

{$IFDEF UNICODE}

    NameFunc(fPath[1], MAX_PATH, True);

{$ELSE}

    NameFunc(fPath[1], MAX_PATH, False);

{$ENDIF}

    fPath := String(pChar(fPath));

    tmp := BannerFunc;

    fBanner := String(tmp);

  end;

  if (fVer < DELZIPVERSION) or (fVer > 300) then

  begin

    FullPath := fPath;

    FreeLibrary(hndl);

    Empty;

    if MustExist then

    begin

      if worker.Verbosity >= zvVerbose then

        worker.ReportMsg(LD_LoadErr, [fLoadErr, SysErrorMessage(fLoadErr),

          fLoadPath]);

      raise EZipMaster.CreateResStr(LD_NoDLL, FullPath);

    end;

  end;

  Result := Priv;

end;

function TZMDLLLoader.Path: String;

begin

  Result := '';

  if IsLoaded then

    Result := fPath;

end;

procedure TZMDLLLoader.ReleaseLib;

begin

  if hndl <> 0 then

  begin

    FreeLibrary(hndl);

    hndl := 0;

  end;

  if hndl = 0 then

  begin

    Empty;

    fPath := '';

    if fKillTemp then

      RemoveTempDLL;

  end;

end;

procedure TZMDLLLoader.Remove(worker: TZMWorker);

var

  i: Integer;

begin

  Guard.Enter;

  try

    i := Counts_Find(worker);

    if i >= 0 then

    begin

      // found - remove it

      Counts[i].worker := nil;

      Counts[i].Count := 0;

    end;

  finally

    Guard.Leave;

  end;

end;

procedure TZMDLLLoader.RemoveTempDLL;

var

  t: String;

begin

  t := TmpFileName;

  TmpFileName := '';

  fKillTemp := False;

  if (t <> '') and FileExists(t) then

    SysUtils.DeleteFile(t);

end;

procedure TZMDLLLoader.Unload(worker: TZMWorker);

begin

  Counts_Dec(worker);

end;

function TZMDLLLoader.UnloadDLL: Integer;

begin

  ReleaseLib;

  Result := fVer;

end;

{$ENDIF}

{ public functions }

procedure _DLL_Abort(worker: TZMWorker; key: Cardinal);

begin

  if key <> 0 then

{$IFDEF STATIC_LOAD_DELZIP_DLL}

    DZ_Abort(key);

{$ELSE}

  G_LoadedDLL.Abort(worker, key);

{$ENDIF}

end;

function _DLL_Banner: String;

begin

{$IFDEF STATIC_LOAD_DELZIP_DLL}

  Result := DZ_Banner;

{$ELSE}

  Result := G_LoadedDLL.Banner;

{$ENDIF}

end;

function _DLL_Build: Integer;

begin

{$IFDEF STATIC_LOAD_DELZIP_DLL}

  Result := DZ_PrivVersion;

{$ELSE}

  Result := G_LoadedDLL.Build;

{$ENDIF}

end;

function _DLL_Exec(worker: TZMWorker; const Rec: pDLLCommands;

  var key: Cardinal): Integer;

begin

  try

{$IFDEF STATIC_LOAD_DELZIP_DLL}

    Result := DZ_Exec(Rec);

{$ELSE}

    Result := G_LoadedDLL.Exec(worker, Rec, key);

{$ENDIF}

    key := 0;

  except

    Result := -6; // -7;

    key := 0;

  end;

  CheckExec(Result);

end;

function _DLL_Load(worker: TZMWorker): Integer;

begin

{$IFDEF STATIC_LOAD_DELZIP_DLL}

  Result := DZ_Version;

{$ELSE}

  Result := G_LoadedDLL.Load(worker);

{$ENDIF}

end;

function _DLL_Loaded(worker: TZMWorker): Boolean;

begin

{$IFDEF STATIC_LOAD_DELZIP_DLL}

  Result := True;

{$ELSE}

  Result := G_LoadedDLL.Loaded(worker);

{$ENDIF}

end;

function _DLL_Path: String;

begin

{$IFDEF STATIC_LOAD_DELZIP_DLL}

  Result := DZ_Path;

{$ELSE}

  Result := G_LoadedDLL.Path;

{$ENDIF}

end;