1{ 2} 3unit UnzipDLL; 4 5{$IFDEF VIRTUALPASCAL} 6{$Cdecl+,AlignRec-,OrgName+} 7{$ELSE} 8 {$IFDEF FPC} 9 {$PACKRECORDS 1} 10 {$ENDIF} 11{$ENDIF} 12 13interface 14 15uses 16 ZipTypes; 17 18const 19 UnzipErr: longint = 0; 20 21type 22 TArgV = array [0..1023] of PChar; 23 PArgV = ^TArgV; 24 TCharArray = array [1..1024*1024] of char; 25 PCharArray = ^TCharArray; 26 TFileUnzipEx = function (SourceZipFile, TargetDirectory, 27 FileSpecs: PChar): integer; 28 29function DllFileUnzipEx (SourceZipFile, TargetDirectory, 30 FileSpecs: PChar): integer; 31 32const 33 FileUnzipEx: TFileUnzipEx = @DllFileUnzipEx; 34 35(* Returns non-zero result on success. *) 36 37implementation 38 39uses 40{$IFDEF OS2} 41 {$IFDEF FPC} 42 DosCalls, 43 {$ELSE FPC} 44 {$IFDEF VirtualPascal} 45 OS2Base, 46 {$ELSE VirtualPascal} 47 BseDos, 48 {$ENDIF VirtualPascal} 49 {$ENDIF FPC} 50{$ELSE} 51 {$IFDEF WIN32} 52 Windows, 53 {$ENDIF WIN32} 54{$ENDIF OS2} 55 Unzip51g, Dos; 56 57type 58 UzpMainFunc = function (ArgC: longint; var ArgV: TArgV): longint; cdecl; 59 60const 61{$IFDEF OS2} 62 AllFiles: string [1] = '*'; 63{$ELSE} 64 {$IFDEF WIN32} 65 AllFiles: string [3] = '*.*'; 66 {$ENDIF} 67{$ENDIF} 68{$IFDEF OS2} 69 LibPath = 'LIBPATH'; 70{$ELSE} 71 LibPath = 'PATH'; 72{$ENDIF} 73 UzpMainOrd = 4; 74 DLLName: string [8] = 'UNZIP32'#0; 75 UzpMain: UzpMainFunc = nil; 76 QuietOpt: array [1..4] of char = '-qq'#0; 77 OverOpt: array [1..3] of char = '-o'#0; 78 CaseInsOpt: array [1..3] of char = '-C'#0; 79 ExDirOpt: array [1..3] of char = '-d'#0; 80 OptCount = 4; 81 82var 83 DLLHandle: longint; 84 OldExit: pointer; 85 C: char; 86 87function DLLInit: boolean; 88var 89{$IFDEF OS2} 90 ErrPath: array [0..259] of char; 91{$ENDIF} 92 DLLPath: PathStr; 93 Dir: DirStr; 94 Name: NameStr; 95 Ext: ExtStr; 96begin 97 DLLInit := false; 98 FSplit (FExpand (ParamStr (0)), Dir, Name, Ext); 99 DLLPath := Dir + DLLName; 100 Insert ('.DLL', DLLPath, byte (DLLPath [0])); 101{$IFDEF OS2} 102 if (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLPath [1], DLLHandle) <> 0) 103 and (DosLoadModule (@ErrPath, SizeOf (ErrPath), @DLLName [1], DLLHandle) <> 0) 104 then 105 begin 106 if ErrPath [0] <> #0 then 107 begin 108 Write (#13#10'Error while loading module '); 109 WriteLn (PChar (@ErrPath)); 110 end; 111 {$IFDEF FPC} 112 end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, pointer (UzpMain)) = 0; 113 {$ELSE} 114 end else DLLInit := DosQueryProcAddr (DLLHandle, UzpMainOrd, nil, @UzpMain) = 0; 115 {$ENDIF} 116{$ELSE} 117 {$IFDEF WIN32} 118 DLLHandle := LoadLibrary (@DLLPath [1]); 119 if DLLHandle = 0 then DLLHandle := LoadLibrary (@DLLName [1]); 120 if DLLHandle = 0 then WriteLn (#13#10'Error while loading DLL.') else 121 begin 122(* UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'UzpMain')); 123*) 124 UzpMain := UzpMainFunc (GetProcAddress (DLLHandle, 'Unz_Unzip')); 125 DLLInit := Assigned (UzpMain); 126 end; 127 {$ENDIF} 128{$ENDIF} 129end; 130 131procedure NewExit; 132begin 133 ExitProc := OldExit; 134{$IFDEF OS2} 135 DosFreeModule (DLLHandle); 136{$ELSE} 137 {$IFDEF WIN32} 138 FreeLibrary (DLLHandle); 139 {$ENDIF} 140{$ENDIF} 141end; 142 143function DllFileUnzipEx (SourceZipFile, TargetDirectory, 144 FileSpecs: PChar): integer; 145var 146 I, FCount, ArgC: longint; 147 ArgV: TArgV; 148 P: PChar; 149 StrLen: array [Succ (OptCount)..1023] of longint; 150begin 151 ArgV [0] := @DLLName; 152 ArgV [1] := @QuietOpt; 153 ArgV [2] := @OverOpt; 154 ArgV [3] := @CaseInsOpt; 155 ArgV [4] := SourceZipFile; 156 FCount := 0; 157 if FileSpecs^ <> #0 then 158 begin 159 P := FileSpecs; 160 I := 0; 161 repeat 162 case FileSpecs^ of 163 '"': begin 164 Inc (FileSpecs); 165 repeat Inc (I) until (FileSpecs^ = '"') or (FileSpecs^ = #0); 166 Inc (FileSpecs); 167 Inc (I); 168 end; 169 '''': begin 170 Inc (FileSpecs); 171 repeat Inc (I) until (FileSpecs^ = '''') or (FileSpecs^ = #0); 172 Inc (FileSpecs); 173 Inc (I); 174 end; 175 #0, ' ', #9: begin 176 Inc (I); 177 Inc (FCount); 178 GetMem (ArgV [OptCount + FCount], I); 179 Move (P^, ArgV [OptCount + FCount]^, Pred (I)); 180 PCharArray (ArgV [OptCount + FCount])^ [I] := #0; 181 StrLen [OptCount + FCount] := I; 182 while (FileSpecs^ = #9) or (FileSpecs^ = ' ') do Inc (FileSpecs); 183 P := FileSpecs; 184 I := 0; 185 end; 186 else 187 begin 188 Inc (I); 189 Inc (FileSpecs); 190 end; 191 end; 192 until (FileSpecs^ = #0) and (I = 0); 193 end else 194 begin 195 FCount := 1; 196 StrLen [OptCount + FCount] := Succ (byte (AllFiles [0])); 197 GetMem (ArgV [OptCount + FCount], StrLen [OptCount + FCount]); 198 Move (AllFiles [1], ArgV [OptCount + FCount]^, StrLen [OptCount + FCount]); 199 end; 200 ArgC := Succ (FCount + OptCount); 201 ArgV [ArgC] := @ExDirOpt; 202 Inc (ArgC); 203 ArgV [ArgC] := TargetDirectory; 204 Inc (ArgC); 205 ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *) 206 UnzipErr := UzpMain (ArgC, ArgV); 207 if UnzipErr <> 0 then DllFileUnzipEx := 0 else DllFileUnzipEx := FCount; 208 for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]); 209end; 210 211begin 212{$IFDEF EMX} 213 if os_Mode <> osOS2 then 214 FileUnzipEx := TFileUnzipEx (@Unzip51g.FileUnzipEx) 215 else 216{$ENDIF EMX} 217 if DLLInit then 218 begin 219 OldExit := ExitProc; 220 ExitProc := @NewExit; 221 if GetEnv ('TZ') = '' then 222 begin 223 WriteLn (#13#10'TZ variable was not found in your environment.'); 224 WriteLn ('This variable is necessary for setting correct date/time of unpacked files.'); 225 WriteLn ('Please, add it to your environment and restart this program afterwards.'); 226 Halt (1); 227 end; 228 end else 229 begin 230 WriteLn (#13#10'Dynamic library UNZIP32.DLL from InfoZip is needed to unpack archives.'); 231 WriteLn ('This library could not be found on your system, however.'); 232 WriteLn ('Please, download the library, either from the location where you found'); 233 WriteLn ('this package, or from any FTP archive carrying InfoZip programs.'); 234 WriteLn ('If you already have this DLL, please, check your configuration (' + LibPath + ').'); 235 WriteLn (#13#10'If you want to try unpacking the files with internal unpacking routine,'); 236 WriteLn ('answer the following question with Y. However, this might not work correctly'); 237 WriteLn ('under some conditions (e.g. for long names and drives not supporting them).'); 238 Write (#13#10'Do you want to continue now (y/N)? '); 239 ReadLn (C); 240 if UpCase (C) = 'Y' then FileUnzipEx := TFileUnzipEx (@Unzip51g.FileUnzipEx) else Halt (255); 241 end; 242end. 243