Browse Source

* modifications from /install/fpinst merged in

Tomas Hajny 24 years ago
parent
commit
d52ddad318
1 changed files with 69 additions and 12 deletions
  1. 69 12
      packages/zip/unzipdll.pas

+ 69 - 12
packages/zip/unzipdll.pas

@@ -3,26 +3,35 @@
 }
 }
 unit UnzipDLL;
 unit UnzipDLL;
 
 
+{$IFDEF VIRTUALPASCAL}
 {$Cdecl+,AlignRec-,OrgName+}
 {$Cdecl+,AlignRec-,OrgName+}
+{$ELSE}
+ {$IFDEF FPC}
+  {$PACKRECORDS 1}
+ {$ENDIF}
+{$ENDIF}
 
 
 interface
 interface
 
 
 const
 const
-{$IFDEF OS2}
- AllFiles: string [1] = '*';
-{$ELSE}
- AllFiles: string [3] = '*.*';
-{$ENDIF}
+ UnzipErr: longint = 0;
 
 
 type
 type
  TArgV = array [0..1024] of PChar;
  TArgV = array [0..1024] of PChar;
  PArgV = ^TArgV;
  PArgV = ^TArgV;
  TCharArray = array [1..1024*1024] of char;
  TCharArray = array [1..1024*1024] of char;
  PCharArray = ^TCharArray;
  PCharArray = ^TCharArray;
+ TFileUnzipEx = function (SourceZipFile, TargetDirectory,
+                                                    FileSpecs: PChar): integer;
 
 
-function FileUnzipEx (SourceZipFile, TargetDirectory,
+function DllFileUnzipEx (SourceZipFile, TargetDirectory,
                                                     FileSpecs: PChar): integer;
                                                     FileSpecs: PChar): integer;
 
 
+const
+ FileUnzipEx: TFileUnzipEx = @DllFileUnzipEx;
+
+(* Returns non-zero result on success. *)
+
 implementation
 implementation
 
 
 uses
 uses
@@ -36,13 +45,24 @@ uses
      BseDos,
      BseDos,
   {$ENDIF VirtualPascal}
   {$ENDIF VirtualPascal}
  {$ENDIF FPC}
  {$ENDIF FPC}
+{$ELSE}
+ {$IFDEF WIN32}
+     Windows,
+ {$ENDIF WIN32}
 {$ENDIF OS2}
 {$ENDIF OS2}
- Dos;
+ Unzip, Dos;
 
 
 type
 type
- UzpMainFunc = function (ArgC: longint; var ArgV: TArgV): longint;
+ UzpMainFunc = function (ArgC: longint; var ArgV: TArgV): longint; cdecl;
 
 
 const
 const
+{$IFDEF OS2}
+ AllFiles: string [1] = '*';
+{$ELSE}
+ {$IFDEF WIN32}
+ AllFiles: string [3] = '*.*';
+ {$ENDIF}
+{$ENDIF}
 {$IFDEF OS2}
 {$IFDEF OS2}
  LibPath = 'LIBPATH';
  LibPath = 'LIBPATH';
 {$ELSE}
 {$ELSE}
@@ -60,10 +80,13 @@ const
 var
 var
  DLLHandle: longint;
  DLLHandle: longint;
  OldExit: pointer;
  OldExit: pointer;
+ C: char;
 
 
 function DLLInit: boolean;
 function DLLInit: boolean;
 var
 var
+{$IFDEF OS2}
  ErrPath: array [0..259] of char;
  ErrPath: array [0..259] of char;
+{$ENDIF}
  DLLPath: PathStr;
  DLLPath: PathStr;
  Dir: DirStr;
  Dir: DirStr;
  Name: NameStr;
  Name: NameStr;
@@ -73,6 +96,7 @@ begin
  FSplit (FExpand (ParamStr (0)), Dir, Name, Ext);
  FSplit (FExpand (ParamStr (0)), Dir, Name, Ext);
  DLLPath := Dir + DLLName;
  DLLPath := Dir + DLLName;
  Insert ('.DLL', DLLPath, byte (DLLPath [0]));
  Insert ('.DLL', DLLPath, byte (DLLPath [0]));
+{$IFDEF OS2}
  if (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLPath [1], DLLHandle) <> 0)
  if (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLPath [1], DLLHandle) <> 0)
  and (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLName [1], DLLHandle) <> 0)
  and (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLName [1], DLLHandle) <> 0)
                                                                            then
                                                                            then
@@ -82,16 +106,40 @@ begin
    Write (#13#10'Error while loading module ');
    Write (#13#10'Error while loading module ');
    WriteLn (PChar (@ErrPath));
    WriteLn (PChar (@ErrPath));
   end;
   end;
+ {$IFDEF FPC}
+ end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, pointer (UzpMain)) = 0;
+ {$ELSE}
  end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, @UzpMain) = 0;
  end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, @UzpMain) = 0;
+ {$ENDIF}
+{$ELSE}
+ {$IFDEF WIN32}
+ DLLHandle := LoadLibrary (@DLLPath [1]);
+ if DLLHandle = 0 then DLLHandle := LoadLibrary (@DLLName [1]);
+ if DLLHandle = 0 then WriteLn (#13#10'Error while loading DLL.') else
+ begin
+(*  UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'UzpMain'));
+*)
+  UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'Unz_Unzip'));
+  DLLInit := Assigned (UzpMain);
+ end;
+ {$ENDIF}
+{$ENDIF}
 end;
 end;
 
 
 procedure NewExit;
 procedure NewExit;
 begin
 begin
  ExitProc := OldExit;
  ExitProc := OldExit;
+{$IFDEF OS2}
  DosFreeModule (DLLHandle);
  DosFreeModule (DLLHandle);
+{$ELSE}
+ {$IFDEF WIN32}
+ FreeLibrary (DLLHandle);
+ {$ENDIF}
+{$ENDIF}
 end;
 end;
 
 
-function FileUnzipEx;
+function DllFileUnzipEx (SourceZipFile, TargetDirectory,
+                                                    FileSpecs: PChar): integer;
 var
 var
  I, FCount, ArgC: longint;
  I, FCount, ArgC: longint;
  ArgV: TArgV;
  ArgV: TArgV;
@@ -153,7 +201,8 @@ begin
  ArgV [ArgC] := TargetDirectory;
  ArgV [ArgC] := TargetDirectory;
  Inc (ArgC);
  Inc (ArgC);
  ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *)
  ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *)
- if UzpMain (ArgC, ArgV) <> 0 then FileUnzipEx := 0 else FileUnzipEx := FCount;
+ UnzipErr := UzpMain (ArgC, ArgV);
+ if UnzipErr <> 0 then DllFileUnzipEx := 0 else DllFileUnzipEx := FCount;
  for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]);
  for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]);
 end;
 end;
 
 
@@ -169,12 +218,20 @@ begin
   WriteLn ('Please, download the library, either from the location where you found');
   WriteLn ('Please, download the library, either from the location where you found');
   WriteLn ('this installer, or from any FTP archive carrying InfoZip programs.');
   WriteLn ('this installer, or from any FTP archive carrying InfoZip programs.');
   WriteLn ('If you have this DLL on your disk, please, check your configuration (' + LIBPATH + ').');
   WriteLn ('If you have this DLL on your disk, please, check your configuration (' + LIBPATH + ').');
-  Halt (255);
+  WriteLn (#13#10'If you want to try unpacking the files with internal unpacking routine,');
+  WriteLn ('answer the following question with Y. However, this might not work correctly');
+  WriteLn ('under some conditions (e.g. for long names and drives not supporting them).');
+  Write (#13#10'Do you want to continue now (y/N)? ');
+  ReadLn (C);
+  if UpCase (C) = 'Y' then FileUnzipEx := TFileUnzipEx (@Unzip.FileUnzipEx) else Halt (255);
  end;
  end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  2000-07-13 06:34:24  michael
+  Revision 1.2  2000-12-19 00:51:10  hajny
+    * modifications from /install/fpinst merged in
+
+  Revision 1.1  2000/07/13 06:34:24  michael
   + Initial import
   + Initial import
 
 
   Revision 1.1  2000/03/02 12:16:57  michael
   Revision 1.1  2000/03/02 12:16:57  michael