home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World 2001 August
/
PCWorld_2001-08_cd.bin
/
Software
/
Vyzkuste
/
archident
/
IDPACKER.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
2001-06-24
|
109KB
|
3,070 lines
{*********************************************************}
{ Turbo Pascal-Routinen zum Identifizieren von 176 }
{ verschiedenen Typen komprimierter Dateien }
{ }
{ Turbo Pascal routines to identify 176 different }
{ types of compressed files }
{ }
{ Version 2.66.04 / 25.06.2001 }
{ 06-25-2001 }
{ }
{ (C) 1994-2001, Juergen Peters }
{ }
{ eMail : jp@graybeast.de }
{ WWW : http://www.graybeast.de }
{ FTP : ftp://graybeast.dyndns.org }
{ ftp://graybeast.2y.net }
{ ftp://graybeast.darktech.org }
{ ftp://graybeast.dyn.ee }
{ ftp://graybeast.dyns.cx }
{ ftp://graybeast.myip.org }
{ ftp://uu.scieron.com }
{ (wenn eine URL nicht funktioniert, }
{ andere probieren) }
{ (if one URL doesn't work try another) }
{ }
{ Released as Freeware }
{ }
{ Dieser Source ist noch in keinster Weise optimiert, er }
{ tut lediglich, was er soll (hoffe ich). }
{ Eine Dokumentation gibt es auch nicht, aber ich glaube, }
{ es dürfte auch so alles klar sein... }
{ Der Autor übernimmt keine Haftung für irgendetwas ;-)) }
{ }
{ This source isn't yet optimized in any way, it simply }
{ does, what it is intended to do (hopefully). }
{ Another documentation than the comments in it is not }
{ available, but I hope it's all clear nevertheless. }
{ The author is not to be made responsible for anything }
{ this source does to your computer... ;-)) }
{*********************************************************}
{ Letzte Änderungen: 04.04.95: - Erkennung von BSN-EXE-Dateien verbessert }
{ 1.53: 13.05.95: - Erkennung von AIN-Dateien verbessert }
{ - Packer BS2/BSArc und GZIP hinzugefügt }
{ 1.54: 20.05.95 - Packer ACB hinzugefügt }
{ 21.05.95 - Packer MAR hinzugefügt }
{ - ACB-Erkennung verbessert }
{ 1.55: 24.05.95 - Packer CPShrink hinzugefügt }
{ - Packer JRC hinzugefügt }
{ - Packer JARCS hinzugefügt }
{ - Packer Quantum hinzugefügt }
{ - Packer ReSOF hinzugefügt }
{ 25.05.95 - Erkennt nun auch BSN-Sfxes, die nicht }
{ die Extension .EXE haben }
{ 2.00 27.05.95 - Archiveinleseroutinen komplett überarbei-}
{ tet. Archivheader wird jetzt in einen }
{ Puffer eingelesen, dadurch großer Ge- }
{ schwindigkeitsgewinn }
{ - Ungepackte Crush-Dateien hinzugefügt }
{ - Packer ARX (LHArc-Clone) hinzugefügt }
{ 02.06.95 - Erkennt Sfx-Dateien von UC2 Pro }
{ 2.01 06.06.95 - Erkennt mit UCEXE gepackte Files }
{ 08.06.95 - Erkennung von WWPack (EXE-Packer) }
{ 2.02 12.06.95 - Formate von YAC und Quark werden erkannt }
{ 2.03 18.06.95 - Probleme mit 0 Byte-Files und Lesen nach }
{ Dateiende beseitigt (Dank an Christoph }
{ Schuppius für den Hinweis!) }
{ 27.06.95 - ACB 1.07-Erkennung }
{ 29.06.95 - Bugfix bei Funktion IsEXE }
{ 2.04 01.07.95 - Auch RAR-OS/2-Sfx-Dateien werden erkannt }
{ 02.07.95 - X1-eigenes Format wird erkannt }
{ 05.07.95 - Codec- und Codec-DOS-Sfx werden erkannt }
{ - AMGC-Format wird identifiziert }
{ - NuLIB-Format wird erkannt }
{ - PAKLeo-Format wird erkannt }
{ 09.07.95 - Format TGZ wird erkannt }
{ - WWPack-Datafile wird erkannt }
{ - ACB 1.08a wird identifiziert }
{ 18.07.95 - ACB 1.10a, ChArc und PSA werden erkannt }
{ 20.07.95 - Format ZAR wird erkannt }
{ 27.07.95 - Fälschlicherweise wurden viele ungepackte}
{ EXE-Dateien als ZAR-Archive erkannt }
{ 29.07.95 - Auch Read Only-Files werden jetzt erkannt}
{ 09.08.95 - ACB 1.13a wird identifiziert }
{ 19.08.95 - Erneut ZAR-Bugfix }
{ 25.08.95 - Format TPK wird als LZS-Clone erkannt }
{ 2.05 06.10.95 - Verbesserte FileExist-Routine }
{ 07.10.95 - Packer LHARK (-lh7-) wird erkannt }
{ 2.06 03.11.95 - ACB 1.14a wird identifiziert }
{ 04.11.95 - CrossePAC, Freeze, KBoom und NSQ werden }
{ erkannt }
{ 14.11.95 - Format DPA wird identifiziert }
{ 2.07 20.02.96 - ACB 1.15b-Format wird erkannt }
{ 22.02.96 - ACB 1.17a-Format wird identifiziert }
{ 27.02.96 - ACB 1.20a wird erkannt }
{ 29.02.96 - ACB-Erkennung verallgemeinert; nicht mehr}
{ jede Version muß einzeln identifiziert }
{ werden }
{ 2.08 31.05.96 - Format TTComp wird erkannt }
{ 2.09 10.08.96 - Format WIC wird identifiziert, obwohl es }
{ sich bei dem Packer um einen Fake handelt}
{ (packt nicht wirklich, legt nur eine }
{ versteckte Datei WINFILE.DLL an, die die }
{ angeblich gepackten Daten enthält) }
{ 2.10 24.10.96 - Format von RKive wird erkannt }
{ 31.10.96 - Bugfixes }
{ - Format JAR wird identifiziert }
{ 12.11.96 - Kleinere Bugfixes }
{ 2.11 15.11.96 - EXEPacker-Erkennung LZExe, PKLite, Diet }
{ und TinyProg integriert }
{ 2.12 08.12.96 - Packer ESP wird erkannt }
{ - Format ZPack wird identifiziert }
{ 2.13 08.01.97 - Erste deutsch-englische Version }
{ 01.02.97 - Format DRY (Dehydrated) wird erkannt }
{ 03.02.97 - Format OWS wird identifiziert, obwohl es }
{ sich bei dem Packer um einen Fake handelt}
{ (packt nicht wirklich) }
{ 2.14 23.02.97 - Format SKY wird erkannt }
{ 24.02.97 - RKive-Erkennung verbessert }
{ 2.15 08.03.97 - ZAR wurde manchmal als TTComp erkannt }
{ - Format ARI wird notdürftig (anhand der }
{ Dateiextension .ARI) erkannt }
{ - Format UFA wird identifiziert }
{ 09.03.97 - Microsofts CAB (Windows 95) wird erkannt }
{ 11.03.97 - Bugfix: einige Archive wurden nur }
{ erkannt, wenn der Archivname großge- }
{ schrieben war }
{ 12.03.97 - Erkennung von FOXSQZ }
{ 16.03.97 - Erkennung von AR7 }
{ 18.03.97 - Identifizierung des Stirling-Compressors }
{ 22.03.97 - Erkennung von PPMZ }
{ 2.16 30.03.97 - MS Compress hinzugefügt }
{ 02.04.97 - Erkennung von MP3 und ZET }
{ 2.17 07.04.97 - Erkennung von XPack-Data- und Diskimage- }
{ Dateien }
{ 17.04.97 - Identifiziert ARQ-Archive }
{ 2.18 27.04.97 - Erkennt ACE-Archive }
{ 10.05.97 - Packer Squash (D. Murk) wird erkannt }
{ 2.19 14.05.97 - ACE-Sfx-Erkennung verbessert }
{ - Packer Terse wird identifiziert }
{ 17.05.97 - XPack-Single Data File wird erkannt }
{ 2.20 21.05.97 - Erkennt BS Archiver 1.6 (ältere Form von }
{ BSA (PTS-DOS)) als BSN }
{ 24.05.97 - Auch ACE 0.9c5 und 0.9d1 Junior Sfx }
{ werden erkannt }
{ - Stuffit (Mac) wird identifiziert }
{ - Erkennung von PKZip-Windows- und OS/2- }
{ Sfxes und WinRAR-Install-Sfxes verbessert}
{ 2.21 25.05.97 - Wegen Schwierigkeiten mancher älterer }
{ Unpacker mit Multitaskern (z.B. PKUnpak }
{ unter OS/2) öffnet IDPACKER die Archive }
{ nun im Sharing-Modus (permit all) }
{ 01.06.97 - PUCrunch wird identifiziert }
{ 04.06.97 - ACE 0.9d3-Sfx wird erkannt }
{ 05.06.97 - BZip wird identifiziert }
{ 2.22 08.06.97 - ACE 0.9d4-Sfx wird erkannt }
{ 09.06.97 - Folgende Multiple Volume-Archive werden }
{ nicht mehr nur anhand der Dateiextension,}
{ sondern am Volume-Flag im Archivheader }
{ erkannt: ARJ, ARJ-Sfx, RAR, RAR-Sfx, ACE }
{ 2.23 18.06.97 - Erkennung von ACE 0.9e3-Sfx }
{ 20.06.97 - Erkennung von PKZip/2 2.50-Sfx }
{ 23.06.97 - Bugfix: Bei Wildcards in Archivnamen }
{ wurden Sfxes teilweise nicht erkannt }
{ 2.24 19.07.97 - Erkennung von UHarc 0.1.66 }
{ 23.07.97 - Bei folgenden Formaten wird am AV-Flag }
{ im Archivheader erkannt, ob sie einen }
{ AV-Envelope haben oder "locked" sind: }
{ ARJ, ARJ-Sfx, RAR, RAR-Sfx, ACE }
{ 03.08.97 - Bugfix bei IsEXE(): die Variable FileMode}
{ wurde evtl. nicht zurückgesetzt }
{ (Dank an Ralph Roth) }
{ 04.08.97 - Format ABComp ab 2.04b wird erkannt }
{ 18.08.97 - Format CMP (André Olejko) wird erkannt }
{ 20.08.97 - Kleinere Bugfixes }
{ 2.25 24.08.97 - BZip2 wird erkannt }
{ 2.26 25.08.97 - Erkennt BS Archiver 1.9 (ältere Form von }
{ BSA (PTS-DOS)) als BSN }
{ - Erkennt LZOP (M.-F.-X.-J. Oberhumer) }
{ 2.27 26.08.97 - Bessere Unterscheidung ARC/PAK }
{ (Dank an George Shadoff) }
{ 2.28 28.08.97 - Bugfix bei ARJ-AV-Erkennung }
{ - "Rohe" szip-Erkennung (nach nur einem }
{ Byte und Extension .sz) }
{ 31.08.97 - WinZip-Sfxes werden (als ZIP) erkannt }
{ 09.09.97 - Format Splint wird erkannt }
{ 14.09.97 - Funktion IsEXE: DOS-EXEs können auch mit }
{ 'ZM' statt 'MZ' beginnen (Dank an Pierre }
{ Foucart). }
{ 2.29 17.09.97 - Format TAR wird (nur an der Extension }
{ .TAR) erkannt. }
{ - InstallShield-Format wird erkannt }
{ 2.30 24.09.97 - Codec-Erkennung verbessert }
{ - ZIP-Archiv-Erkennung verbessert }
{ - Limit-Erkennung verbessert }
{ - Format CARComp wird (nur an der Extension}
{ .CAR) erkannt }
{ 26.09.97 - Bessere Erkennung von WinRAR (inkl. 2.02)}
{ 29.09.97 - LZS erhält eigenen Archivtyp }
{ 2.31 11.10.97 - Auch 32 Bit-WinZip-Sfxes werden (als ZIP)}
{ erkannt }
{ 13.10.97 - Weiteres Windows-Install-Sfx-Format (ZIP)}
{ hinzugefügt }
{ 14.10.97 - Dateizugriffsmodus simplifiziert }
{ 15.10.97 - Manchmal wurden LHark-Archive als AIN }
{ erkannt }
{ 2.32 01.11.97 - Format BOA wird identifiziert }
{ - InstallShield-Z-Format wird erkannt }
{ 08.11.97 - Formate ARG und Gather (GTH) werden erk. }
{ - RKive 1.9 wird identifiziert. }
{ 2.33 27.11.97 - Formate Pack Magic, Big Tree Software }
{ Archiver, ELI 5750 und QFC werden erkannt}
{ 06.12.97 - PRO-PACK wird identifiziert }
{ - WinZip32-Erkennung weiter verbessert }
{ 01.01.98 - MSXiE von Mercury Soft Technology wird }
{ erkannt }
{ 17.01.98 - Weitere WinZip-Variante wird identifiz. }
{ 2.34 31.01.98 - Format RAX wird erkannt }
{ 01.03.98 - Format 777 (Win32) wird identifiziert }
{ 2.35 12.04.98 - Formate LZS221 (Stac), HPA (Hungarian }
{ Pirate Alliance), Arhangel (George }
{ Lyapko), EXP1 (Bulat Ziganshin) und IMP }
{ werden erkannt }
{ 20.04.98 - BMF (komprimiertes Grafikformat) wird }
{ erkannt }
{ 29.04.98 - NRV (Demo von Markus Oberhumer) wird }
{ identifiziert }
{ 30.04.98 - PAK 1.0a (Dmitry Dvoinikov) wird erkannt }
{ 2.36 08.05.98 - Squisch (Mike Albert) wird identifiziert }
{ - PRO-PACK 2.14 (mit anderem Header) wird }
{ erkannt }
{ - ParB (Win32-Archiver) wird identifiziert }
{ 10.05.98 - PAK 1.0a-Erkennung verbessert }
{ 13.05.98 - ARX-Erkennung verbessert }
{ 17.05.98 - WinRAR-Erkennung optimiert }
{ 2.37 05.06.98 - Formate HIT (Bogdan Ureche) und SBX }
{ werden identifiziert }
{ 09.06.98 - Weitere WinZip-Sfx-Variante wird erkannt }
{ 2.40 14.06.98 - szip-Erkennung verbessert (Dank an }
{ Michael Schindler für Infos) }
{ - Erkennung der alten Sfx-Formate LHarc und}
{ LARC verbessert }
{ 2.41.00 01.07.98 - Indentifizierung des NSK-Formats }
{ 2.41.01 03.07.98 - Weiteres WinZip-32 Bit-Sfx erkannt }
{ 2.41.02 11.07.98 - Format DST (Disintegrator 0.9b, Tommaso }
{ Gugli) wird erkannt }
{ 2.41.03 12.07.98 - ASD (Tobias Svensson) wird identifiziert }
{ 2.42.00 03.08.98 - Zur besseren Errorlevel-Auswertung werden}
{ unbekannte Archive/Nichtarchivdateien }
{ nicht mehr als Typ 0, sondern 251 erkannt}
{ 2.42.01 12.08.98 - SZip-Bugfix }
{ 2.42.02 17.08.98 - Erkennung von BTSPK verbessert }
{ 2.42.03 23.08.98 - InstallShield-CAB wird erkannt }
{ 2.42.04 02.09.98 - QFC 2.0 wird erkannt }
{ 2.42.05 10.09.98 - TOP4 und Batcomp (4DOS) werden erkannt }
{ 2.42.06 11.09.98 - Kleinere Bugfixes }
{ 2.42.07 12.09.98 - TOP4- und Batcomp-Erkennung präzisiert }
{ 2.42.08 14.10.98 - BlakHole (Win32) wird erkannt }
{ 2.43.00 02.12.98 - BIX (Igor Pavlov) wird identifiziert }
{ 2.43.01 15.01.99 - ChiefLZA wird erkannt }
{ 2.50.00 14.02.99 - Bei Einbindung von LFN.PAS von Andreas }
{ Killer ($DEFINE LONGNAME) werden lange }
{ Dateinamen unter Windows unterstützt }
{ 2.50.01 24.02.99 - Blink von D.T.S. wird erkannt }
{ 2.50.02 01.03.99 - CAR von MylesHi! Software wird erkannt }
{ 2.50.03 07.03.99 - SARJ wird anhand Extension .SRJ + ARJ- }
{ Format identifiziert }
{ 2.50.04 11.03.99 - Compack-Sfxes werden erkannt }
{ 2.50.05 16.03.99 - LogiTech Compress wird identifiziert }
{ 2.50.06 20.03.99 - LHarc 1.13c-Sfxes werden erkannt }
{ 2.51.00 24.03.99 - Alle Funktionen LFN-fähig gemacht }
{ 2.51.01 31.03.99 - ARS-Sfx-Packer wird erkannt }
{ 2.51.02 02.04.99 - Format AKT wird identifiziert }
{ 2.51.03 05.04.99 - Formate Flash (FLH) und PC/3270 werden }
{ identifiziert }
{ 2.51.04 11.04.99 - Formate NPack und PFT (Perfect Finishing }
{ Touch) werden erkannt }
{ 2.51.05 06.05.99 - Neues 4DOS 6.02-BATCOMP-Format wird erk. }
{ 2.52.00 11.05.99 - Packer XTreme wird erkannt (scheint eine }
{ RAX-Variante zu sein) }
{ - Format SemOne wird identifiziert }
{ 2.52.01 12.05.99 - AKT32 wird erkannt }
{ 2.52.02 18.05.99 - InstallIt 2.0x wird identifiziert }
{ 2.52.03 23.05.99 - Erkennung von MS Compress verbessert }
{ 2.52.04 27.05.99 - SemOne 0.5-Erkennung }
{ 2.52.05 18.06.99 - Erkennung von PPMD }
{ 2.53.00 02.07.99 - Neues ZIP-Format mit 'PK00PK' im }
{ Dateiheader wird erkannt }
{ 2.53.01 13.07.99 - Format SWG (Sourceware Archival Group) }
{ wird identifiziert }
{ 2.53.02 02.08.99 - Deutscher Winzip 32 Bit-Selfextractor }
{ wird erkannt (z.B. TGeb) }
{ 2.54.00 08.08.99 - ARJ-Win32-Sfxes werden identifiziert }
{ - ARJ-Erkennung verbessert }
{ - FIZ-Format wird erkannt }
{ 2.55.00 13.08.99 - Wesentlich mehr RAR-32 Bit-Sfx-Formate }
{ werden identifiziert }
{ 2.55.01 14.08.99 - RAR-32 Bit-Sfx 2.60b2 und RAR Linux }
{ 2.60b2 werden erkannt }
{ 2.56.00 18.09.99 - BA (M. Lundqvist) wird identifiziert }
{ - RAR-32 Bit-Sfx 2.60b4 wird identifiziert }
{ - Unbekannte EXEs ohne angehängtes Archiv }
{ (Non-Sfxes) werden nicht mehr falsch }
{ identifiziert }
{ - Kleinere Bugfixes bei LFN-Verarbeitung }
{ 2.56.01 21.09.99 - Bessere ARJ-DOS-Sfx-Erkennung (inklusive }
{ Version 2.63) }
{ 2.56.02 22.09.99 - RAR-32 Bit-Sfx 2.60b5 wird erkannt }
{ 2.56.03 29.09.99 - Format XPA32 (Jauming Tseng) wird erkannt}
{ 2.56.04 02.10.99 - BA-Erkennung verbessert (einige Win-Sfxes}
{ wurden fälschlicherweise als BA erkannt) }
{ 2.57.00 14.11.99 - Format RK (Nachfolger von RKive) wird }
{ identifiziert }
{ 2.57.01 09.01.00 - ARJ/2 2.70-Sfxes werden erkannt }
{ 2.58.00 21.02.00 - RedHat Linux RPM-Dateien werden erkannt }
{ 2.58.01 12.03.00 - PAK-Format wird sicherer von ARC/ARC+ }
{ unterschieden }
{ - Format DeepFreezer wird erkannt }
{ 2.58.02 16.03.00 - ZZip (Damien Debin) wird identifiziert }
{ 2.58.03 01.04.00 - ABComp 2.06 wird erkannt }
{ 2.58.04 15.04.00 - DC 0.98b (Edgar Binder) wird erkannt }
{ 2.60.00 24.05.00 - ACE 2.0ß1-Sfxe werden identifiziert }
{ 2.60.01 29.05.00 - TPac 1.7 von Tim Gordon wird erkannt }
{ 2.60.02 07.06.00 - ACE 2.0ß2-Sfxe werden identifiziert }
{ 2.61.00 16.07.00 - Neue eMail-, WWW- und FTP-Adressen }
{ 2.61.01 24.07.00 - Bessere Erkennung neuerer ACE-, RAR- und }
{ ARJ-Sfxe (alle Plattformen) }
{ 2.62.00 09.08.00 - Packer Ai (E.Ilya) wird identifiziert }
{ 2.62.01 26.08.00 - Ybs (Vadim Yoockin) wird erkannt }
{ - (Win)ACE 2.0b2-Sfxe werden identifiziert }
{ 2.62.02 20.09.00 - Ai32 wird erkannt }
{ 2.62.03 08.10.00 - (Win)ACE 2.0b3-Sfxe werden identifiziert }
{ 2.63.00 18.10.00 - ACE 2.0b3-Sfx-Erkennung verbessert }
{ - Packer SBC (Sami Mäkinen) wird erkannt }
{ 2.63.01 29.10.00 - DitPack 1.0 wird identifiziert }
{ 2.64.00 08.12.00 - ACE-Sfxe 2.0b3 und 2.0b4 werden identi- }
{ fiziert (alle Plattformen) }
{ - Codeoptimierung der ACE-Sfx-Erkennungs- }
{ Funktion (Dank an Snow Panther) }
{ 2.64.01 12.12.00 - Codeoptimierung der ZIP- und RAR-Sfx- }
{ Erkennungs-Funktionen durch Snow Panther }
{ - Viele neue ZIP-Sfxe (vor allem von Unix- }
{ Plattformen) und einige ACE-Sfxe zugefügt}
{ 2.64.02 31.12.00 - (Win-)ACE 2.0b5-Sfxe werden erkannt }
{ 2.65.00 11.01.01 - WinRAR und Rar/Linux 2.80b3 werden }
{ identifiziert }
{ - ZZip 0.36b (inkl. Sfxe) wird erkannt }
{ 2.65.01 29.01.01 - PAR 2.00 Beta wird identifiziert }
{ 2.65.02 01.02.01 - (Win)ACE 2.0 Release-Sfxes werden erkannt}
{ 2.65.03 13.02.01 - DMS (Amiga) wird identifiziert }
{ 2.65.04 17.02.01 - Weitere WinRAR- und WinACE-Sfxes werden }
{ identifiziert }
{ 2.65.05 21.02.01 - Packer EPC wird erkannt }
{ 2.65.06 10.03.01 - vectorsoft VSARC wird erkannt }
{ 2.65.07 29.03.01 - Weitere WinRAR-Sfxes werden identifiziert}
{ 2.66.00 12.04.01 - Format RDMC wird erkannt }
{ - Weitere ZIP-Sfxes werden identifiziert }
{ 2.66.01 04.05.01 - RDMC-Erkennung war unzuverlässig - }
{ entfernt }
{ 2.66.02 19.05.01 - Format PDZ wird erkannt }
{ 2.66.03 04.06.01 - Bugfix in Installshield-EXE-Erkennung }
{ (Dank an Snow Panther) }
{ 2.66.04 25.06.01 - "Package for the Web"-Format wird erkannt}
{ (Dank an Snow Panther) }
{ Last changes: }
{ 2.13 - First german-english version }
{ 2.14 02-23-97 - Format SKY is being recognized }
{ 02-24-97 - Better RKive detection }
{ 2.15 03-08-97 - ZAR was sometimes identified as TTComp }
{ - Format ARI is recognized - but only due }
{ to the file extension }
{ - Format UFA is identified }
{ 03-09-97 - Microsoft's CAB (Windows 95) is being }
{ recognized }
{ 03-11-97 - Bugfix: some archives were only recog- }
{ nized, if their names were written in }
{ uppercase letters }
{ 03-12-97 - Recognition of FOXSQZ }
{ 03-16-97 - Recognition of AR7 }
{ 03-18-97 - Idenfification of the Stirling Compressor}
{ 03-22-97 - Added PPMZ-recognition }
{ 2.16 03-30-97 - Added MS Compress }
{ 04-02-97 - Identifies MP3 and ZET }
{ 2.17 04-07-97 - Identifies XPack data and disk image }
{ files }
{ 04-17-97 - Recognizes ARQ archives }
{ 2.18 04-27-97 - Recognizes ACE archives }
{ 05-10-97 - Squash by D. Murk is being recognized }
{ 2.19 05-14-97 - Improved ACE-Sfx-recognition }
{ - Identification of packer Terse }
{ 05-17-97 - Recognizes XPack single file data }
{ 2.20 05-21-97 - BS Archiver 1.6 (older version of BSA) }
{ is being identified (as BSN) }
{ 05-24-97 - ACE 0.9c5 Sfx jr. is being recognized }
{ - Stuffit (Mac) is being identified }
{ - Improved PKZip Windows- and OS/2 sfx and }
{ WinRAR install sfx recognition }
{ 2.21 05-25-97 - Because of problems of some older }
{ unpackers with multitaskers (eg. PKUnpak }
{ and OS/2) IDPACKER opens archives in }
{ sharing mode (permit all) }
{ 06-01-97 - PUCrunch is being identified }
{ 06-04-97 - ACE 0.9d3 sfx is being recognized }
{ 06-05-97 - BZip is being identified }
{ 2.22 06-08-97 - ACE 0.9d4 sfx is being recognized }
{ 06-09-97 - The following multiple volume archives }
{ are not more identified only from the }
{ file extension, but from the volume flag }
{ in the archive header: ARJ, ARJ-Sfx, RAR,}
{ RAR-Sfx, ACE }
{ 2.23 06-18-97 - Recognition of ACE 0.9e3 sfx }
{ 06-20-97 - Recognition of PKZip/2 2.50 sfx }
{ 06-23-97 - Bugfix: when using wildcards in archive }
{ names sfxes were not recognized correctly}
{ 2.24 07-19-97 - Recognition of UHarc 0.1.66 }
{ 07-23-97 - At the following archive formats it is }
{ detected, whether they are AV-secured }
{ or locked (through AV-Flag in header): }
{ ARJ, ARJ-Sfx, RAR, RAR-Sfx, ACE }
{ 08-03-97 - Bugfix in function IsEXE(): the variable }
{ FileMode was eventually not reset }
{ (Thanks to Ralph Roth) }
{ 08-04-97 - Format ABComp 2.04b is being recognized }
{ 08-18-97 - Format CMP (André Olejko) is identified }
{ 08-20-97 - Smaller bugfixes }
{ 2.25 08-24-97 - BZip2 is recognized }
{ 2.26 08-25-97 - BS Archiver 1.9 (older version of BSA) }
{ is being identified (as BSN) }
{ - Recognizes LZOP (M.-F.-X.-J. Oberhumer) }
{ 2.27 08-26-97 - Better distinction ARC/PAK }
{ (Thanks to George Shadoff) }
{ 2.28 08-28-97 - Bugfix at ARJ-AV-recognition }
{ - Crude szip detection (only by one byte }
{ and extension .sz) }
{ 08-31-97 - WinZip sfxes are identified (as ZIPs) }
{ 09-09-97 - Format Splint is being identified }
{ 09-14-97 - Function IsEXE: DOS-EXEs may also start }
{ with 'ZM' instead of 'MZ' (thanks to }
{ Pierre Foucart) }
{ 2.29 09-17-97 - Format TAR is recognized (only from file }
{ extension .TAR) }
{ - InstallShield format is identified }
{ 2.30 09-24-97 - Enhanced Codec-Detection }
{ - Enhanced ZIP-Archiv-Detection }
{ - Enhanced Limit-Detection }
{ - Format CARComp is recognized (only from }
{ file extension .CAR) }
{ 09-26-97 - Better detection of WinRAR (incl. 2.02) }
{ 09-29-97 - LZS gets own archive type }
{ 2.31 10-11-97 - Also 32 bit WinZip sfxes are recognized }
{ (as ZIP) }
{ 10-13-97 - Another Windows install sfx format (ZIP) }
{ added }
{ 10-14-97 - Simplified file access mode }
{ 10-15-97 - Sometimes LHark archives were identified }
{ as AIN }
{ 2.32 01-11-97 - Format BOA is being identified }
{ - InstallShield-Z-format is recognized }
{ 08-11-97 - Formats ARG and Gather (GTH) are identif.}
{ - RKive 1.9 is identified }
{ 2.33 11-27-97 - Formats Pack Magic, Big Tree Software }
{ Archiver, ELI 5750 and QFC are identified}
{ 12-06-97 - PRO-PACK is identified }
{ - WinZip32 recognition again improved }
{ 01-01-98 - MSXiE by Mercury Soft Technology is }
{ being identified }
{ 01-17-98 - Another WinZip variant is identified }
{ 2.34 01-31-98 - Format RAX is being recognized }
{ 03-01-98 - Format 777 (Win32) is being identified }
{ 2.35 04-12-98 - Formats LZS221 (Stac), HPA (Hungarian }
{ Pirate Alliance), Arhangel (George }
{ Lyapko), EXP1 (Bulat Ziganshin) and IMP }
{ are being identified }
{ 04-20-98 - BMF (compressed graphics format) is }
{ being identified }
{ 04-29-98 - NRV (demo by Markus Oberhumer) is being }
{ identified }
{ 04-30-98 - PAK 1.0a (Dmitry Dvoinikov) is recognized}
{ 05-07-98 - Squisch (Mike Albert) is identified }
{ 2.36 05-10-98 - Squisch (Mike Albert) is identified }
{ - PRO-PACK 2.14 (with other header) is }
{ recognized }
{ - ParB (Win32 archiver) is being identified}
{ 05-10-98 - Identification of PAK 1.0a improved }
{ 05-13-98 - Identification of ARX improved }
{ 05-17-98 - WinRAR detection optimized }
{ 2.37 06-05-98 - Formats HIT (Bogdan Ureche) and SBX }
{ are being identified. }
{ 06-09-98 - Another WinZip sfx type added }
{ 2.40 06-14-98 - Improved szip detection (thanks to }
{ Michael Schindler for infos }
{ - Improved old LHarc and LARC sfx detection}
{ 2.41.00 07-01-98 - Format NSK is identified }
{ 2.41.01 07-03-98 - Another WinZip 32 bit sfx detected }
{ 2.41.02 07-11-98 - Format DST (Disintegrator 0.9b, Tommaso }
{ Gugli) is recognized }
{ 2.41.03 07-12-98 - ASD (Tobias Svensson) is identified }
{ 2.42.00 08-03-98 - For better interpretation of the }
{ errorlevel unknown/invalid archives do }
{ not have type 0 anymore, but 251 }
{ 2.42.01 08-12-98 - SZip bugfix }
{ 2.42.02 08-17-98 - Better BTSPK identification }
{ 2.42.03 08-23-98 - InstallShield-CAB is recognized }
{ 2.42.04 09-02-98 - QFC 2.0 is identified }
{ 2.42.05 09-10-98 - TOP4 and Batcomp (4DOS) are recognized }
{ 2.42.06 09-11-98 - Smaller bugfixes }
{ 2.42.07 09-12-98 - Enhanced TOP4 and Batcomp identification }
{ 2.42.08 10-14-98 - BlakHole (Win32) is recognized }
{ 2.43.00 12-02-98 - BIX (Igor Pavlov) is identified }
{ 2.43.01 01-15-99 - ChiefLZA is recognized }
{ 2.50.00 02-14-99 - When incorporating LFN.PAS by Andreas }
{ Killer ($DEFINE LONGNAME) LFNs are }
{ supported under windows }
{ 2.50.01 02-24-99 - Blink by D.T.S. is identified }
{ 2.50.02 03-01-99 - CAR by MylesHi! Software is recognized }
{ 2.50.03 03-07-99 - SARJ is recognized by extension .SRJ and }
{ ARJ format }
{ 2.50.04 03-11-99 - Compack sfxes are recognized }
{ 2.50.05 03-16-99 - LogiTech Compress is identified }
{ 2.50.06 03-20-99 - LHarc 1.13c sfxes are recognized }
{ 2.51.00 03-24-99 - Made all functions LFN capable }
{ 2.51.01 03-31-99 - ARS-Sfx-Packer wird erkannt }
{ 2.51.02 04-02-99 - Format AKT is identified }
{ 2.51.03 04-05-99 - Formats Flash (FLH) and PC/3270 are }
{ identified }
{ 2.51.04 04-11-99 - Formats NPack and PFT (Perfect Finishing }
{ Touch) are recognized }
{ 2.51.05 05-06-99 - New 4DOS 6.02-BATCOMP format is identif. }
{ 2.52.00 05-11-99 - Packer XTreme is recognized (seems to be }
{ a RAX variant) }
{ - Format SemOne is identified }
{ 2.52.01 05-12-99 - AKT32 is recognized }
{ 2.52.02 05-18-99 - InstallIt 2.0x is identified }
{ 2.52.03 05-25-99 - Improved MS Compress detection }
{ 2.52.04 05-27-99 - SemOne 0.5 recognition }
{ 2.52.05 06-18-99 - Recognition of PPMD }
{ 2.53.00 07-02-99 - New ZIP format with 'PK00PK' in the file }
{ header is recognized }
{ 2.53.01 07-13-99 - Format SWG (Sourceware Archival Group) }
{ is being identified }
{ 2.53.02 08-02-99 - Added german Winzip 32 Bit selfextractor }
{ 2.54.00 08-08-99 - ARJ Win32 sfxes are identified }
{ - Improved ARJ detection }
{ - FIZ format is recognized }
{ 2.55.00 08-13-99 - Added several RAR 32 bit-sfx formats }
{ 2.55.01 08-14-99 - RAR 32 bit sfx 2.60b2 and RAR Linux }
{ 2.60b2 are identified }
{ 2.56.00 09-18-99 - BA (M. Lundqvist) is recognized }
{ - RAR 32 bit sfx 2.60b4 is identified }
{ - No more false identifications of unknown }
{ EXEs without archive data at the end }
{ (non-sfxes) }
{ - Small bugfixes in LFN handling }
{ 2.56.01 09-21-99 - Better ARJ DOS sfx recognition (including}
{ version 2.63) }
{ 2.56.02 09-22-99 - RAR 32 bit sfx 2.60b5 is identified }
{ 2.56.03 09-29-99 - Format XPA32 (J. Tseng) is identified }
{ 2.56.04 10-02-99 - BA-Recognition improved (some Win-sfxes }
{ were falsely identified as BA) }
{ 2.57.00 11-14-99 - Format RK (successor of RKive) is being }
{ identified }
{ 2.57.01 01-09-00 - ARJ/2 2.70 format is recognized }
{ 2.58.00 02-21-00 - RedHat Linux RPM files are identified }
{ 2.58.01 03-12-00 - PAK is better distinguished from ARC/ARC+}
{ - Format DeepFreezer is recognized }
{ 2.58.02 03-16-00 - ZZip (Damien Debin) is being identified }
{ 2.58.03 04-01-00 - ABComp 2.06 is recognized }
{ 2.58.04 04-15-00 - DC 0.98b (Edgar Binder) is identified }
{ 2.60.00 05-24-00 - ACE 2.0ß1 sfxes are recognized }
{ 2.60.01 05-29-00 - TPac 1.7 by Tim Gordon is identified }
{ 2.60.02 06-07-00 - ACE 2.0ß1 sfxes are recognized }
{ 2.61.00 07-16-00 - New eMail, WWW and FTP addresses }
{ 2.61.01 07-24-00 - More reliable identification of newer }
{ ACE, RAR and ARJ sfxes (all platforms) }
{ 2.62.00 08-09-00 - Packer Ai (E.Ilya) is being identified }
{ 2.62.01 08-26-00 - Ybs (Vadim Yoockin) is identified }
{ - (Win)ACE 2.0b2 sfxes are recognized }
{ 2.62.02 09-20-00 - Ai32 is identified }
{ 2.62.03 10-08-00 - (Win)ACE 2.0b3 sfxes are recognized }
{ 2.63.00 10-18-00 - ACE 2.0b3 sfx recognition improved }
{ - Packer SBC (Sami Mäkinen) is identified }
{ 2.63.01 10-19-00 - DitPack 1.0 is being identified }
{ 2.64.00 12-08-00 - ACE sfxes 2.0b3 and 2.0b4 are identified }
{ (all platforms) }
{ - Code optimization of ACE sfx recognition }
{ function (thanks to Snow Panther) }
{ 2.64.01 12-12-00 - Code optimization of RAR and ZIP sfx }
{ recognition functions (by Snow Panther) }
{ - Added many new ZIP sfxes (primarily from }
{ Unix platforms) and some ACE sfxes }
{ 2.64.02 12-31-00 - (Win-)ACE 2.0b5 sfxes are recognized }
{ 2.65.00 01-11-01 - WinRAR and Rar/Linux 2.80b3 are being }
{ identified }
{ - ZZip 0.36b (incl. sfxes) is recognized }
{ 2.65.01 01-29-01 - PAR 2.00 beta is being identified }
{ 2.65.02 02-01-01 - (Win)ACE 2.0 Release sfxes are identified}
{ 2.65.03 02-13-01 - DMS (Amiga) is recognized }
{ 2.65.04 02-17-01 - Some other WinRAR and WinACE sfxes are }
{ being identified }
{ 2.65.05 02-21-01 - Packer EPC is recognized }
{ 2.65.06 03-10-01 - vectorsoft VSARC is recognized }
{ 2.65.07 03-29-01 - More WinRAR sfxes are identified }
{ 2.66.00 04-12-01 - Format RDMC is recognized }
{ - More ZIP sfxes are identified }
{ 2.66.01 05-04-01 - RDMC recognition was unreliable - removed}
{ 2.66.02 05-19-01 - Format PDZ is identified }
{ 2.66.03 06-04-01 - Fixed a bug in Installshield EXE }
{ detection (thanks to Snow Panther) }
{ 2.66.04 06-25-01 - "Package for the Web" format is ident. }
{ (thanks to Snow Panther) }
UNIT IDPacker;
{$B-,I-,V-,E-,S-,N-,R-,X+,A+}
{$IFNDEF DEBUG}
{$D-,L-}
{$ENDIF}
INTERFACE
USES Dos
{$IFDEF LONGNAME}
,LFN
{$ENDIF};
CONST ARCType=1;
ZIPType=2;
ZOOType=3;
LZHType=4;
DWCType=5;
MDType=6;
LBRType=7;
ARJType=8;
HYPType=9;
UC2Type=10;
HAPType=11;
HAType=12;
HPKType=13;
SQZType=14;
RARType=15;
PAKType=16;
ARCPlusType=17;
LIMType=18;
BSNType=19;
PUTType=20;
SQWEZType=21;
CruPType=22;
CruJType=23;
CruLType=24;
CruZType=25;
CruHType=26;
LZEXEType=27;
PKLiteType=28;
DietType=29;
TinyProgType=30;
GIFType=31;
JFIFType=32;
JHSIType=33;
AINType=34;
AINEXEType=35;
SARType=36;
BS2Type=37;
GZIPType=38;
ACBType=39;
MARType=40;
CPZType=41;
JRCType=42;
JARType=43;
QType=44;
SofType=45;
CruType=46;
ARXType=47;
UCEXEType=48;
WWPType=49;
QARKType=50;
YACType=51;
X1Type=52;
CDCType=53;
AMGType=54;
NLIType=55;
PLLType=56;
TGZType=57;
WWDType=58;
CHZType=59;
PSAType=60;
ZARType=61;
LHKType=62;
PACType=63;
XFType=64;
KBOType=65;
NSQType=66;
DPAType=67;
TTCType=68;
WICType=69;
RKVType=70;
JRType=71;
ESPType=72;
ZPKType=73;
DRYType=74;
OWSType=75;
SkyType=76;
ARIType=77;
UfaType=78;
CABType=79;
FSqzType=80;
AR7Type=81;
TSCType=82;
PPMZType=83;
ExpType=84;
MP3Type=85;
ZetType=86;
XpaType=87;
XdiType=88;
ArqType=89;
AceType=90;
ArhType=91;
TerType=92;
XpdType=93;
SitType=94;
PucType=95;
BZipType=96;
UhaType=97;
AbcType=98;
CmpType=99;
BZip2Type=100;
LzoType=101;
SzipType=102;
SplType=103;
TarType=104;
IShType=105;
CaCType=106;
LzsType=107;
BoaType=108;
IShZType=109;
ArgType=110;
GthType=111;
PckType=112;
BtsType=113;
EliType=114;
QfcType=115;
RncType=116;
XieType=117;
RaxType=118;
_777Type=119;
StacType=120;
HpaType=121;
LgType=122;
Exp1Type=123;
ImpType=124;
BmfType=125;
NrvType=126;
PddType=127;
SqType=128;
ParType=129;
HitType=130;
SbxType=131;
NskType=132;
DstType=133;
AsdType=134;
IscType=135;
T4Type=136;
BtmType=137;
BhType=138;
BixType=139;
LzaType=140;
BliType=141;
CarType=142;
SArjType=143;
CpkType=144;
LgCType=145;
ArsType=146;
AktType=147;
FlhType=148;
PC3Type=149;
NpaType=150;
PftType=151;
XTType=152;
SemType=153;
A32Type=154;
IiType=155;
PpmType=156;
SwgType=157;
FizType=158;
BaType=159;
Xpa32Type=160;
RKType=161;
RpmType=162;
DfType=163;
ZZType=164;
DCType=165;
TpcType=166;
AiType=167;
YbsType=168;
Ai32Type=169;
SbcType=170;
DitType=171;
DmsType=172;
EpcType=173;
VsaType=174;
PdzType=175;
PfwType=176;
Invalid=251;
FileNotFound=255;
CONST mv: Boolean=false; (* Multiple volume file? *)
av: Boolean=false; (* AV-Envelope/Locked? *)
NewIsc: Boolean=true; (* New InstallShield CAB (> 5.00.200)? *)
IDStr: String=''; (* Archive ID *)
VAR CrushPacked: Boolean;
FUNCTION ArchiveType(ArcName: PathStr): Byte;
FUNCTION ExeSize(FName: PathStr): LongInt;
FUNCTION IsExe(FName: PathStr): Boolean;
IMPLEMENTATION
TYPE FileStr=String[12];
CONST IsEx: Boolean=false;
(* Die FUNKTION CapStr wandelt einen String in Großbuchstaben um, wobei die
deutschen Umlaute berücksichtigt werden. Beispiel:
The FUNCTION CapStr changes a string to uppercase, German "Umlauts" are
being taken into consideration. Example:
Name := CapStr('Düsseldorf'); (ergibt 'DÜSSELDORF') *)
FUNCTION CapStr(St: String): String;
VAR SLen : Byte absolute St;
i : Byte;
BEGIN
For i := 1 to SLen Do
BEGIN
CASE St[i] of
'ä' : St[i] := 'Ä';
'ö' : St[i] := 'Ö';
'ü' : St[i] := 'Ü';
ELSE St[i] := Upcase(St[i]);
END;
END;
CapStr := St;
END;
(* Die Funktion Strip kürzt einen String um ein angegebenes Zeichen.
The function Strip deletes a given character from a string. *)
FUNCTION Strip(L,C: Char; S: String): String;
(* L = links, rechts, beide Enden oder alle Vorkommen.
L = left, right, both ends or all occurances. *)
VAR I: Byte;
BEGIN
Case Upcase(L) of
'L' : BEGIN {Left}
While (S[1] = C) and (length(S) > 0) do
Delete(S,1,1);
END;
'R' : BEGIN {Right}
While (S[length(S)] = C) and (length(S) > 0) do
Delete(S,length(S),1);
END;
'B' : BEGIN {Both left and right}
While (S[1] = C) and (length(S) > 0) do
Delete(S,1,1);
While (S[length(S)] = C) and (length(S) > 0) do
Delete(S,length(S),1);
END;
'A' : BEGIN {All}
I := 1;
Repeat
If (S[I] = C) and (length(S) > 0) then
Delete(S,I,1)
else
Inc(I);
Until (I > length(S)) or (S = '');
END;
END;
Strip := S;
END; {Function Strip}
(* Existiert die Datei?
Does the file exist? *)
FUNCTION Exist(Filename: PathStr): Boolean;
VAR f : File;
FMode : Byte;
IO : Word;
BEGIN
If FileName='' then Exist := false ELSE
BEGIN
FMode := FileMode;
FileMode := 0;
{$IFDEF LONGNAME}
Filename := Strip('B','"',Filename);
{$ENDIF}
Assign(f,Filename);
Reset(f); IO := IOResult; If IO=0 then
BEGIN
Exist := true;
Close(f);
END ELSE Exist := false;
FileMode := FMode;
END;
END;
(* Alte Assembler-Variante von Exist; nicht LFN-fähig.
FUNCTION Exist(Filename: String): Boolean; Assembler;
VAR ZStr: String;
ASM
PUSH DS
LDS SI, Filename { make ASCIIZ }
MOV AX, SS
MOV ES, AX
LEA DI, ZStr
MOV DX, DI
XOR CH, CH
MOV CL, BYTE PTR [SI]
INC SI
REP MOVSB
MOV BYTE PTR ES:[DI], 0
MOV DS, AX
MOV AX, 4371h { get file attributes }
XOR BL, BL
INT 21h
MOV AL, FALSE
JC @Exit { fail? }
AND CX, 24
JNZ @Exit
INC AL
@Exit: POP DS
END; *)
(* LastPos gibt die Stelle des letzten Vorkommens eines Zeichens im String
zurück.
LastPos returns the last occurance of a char in a string. *)
FUNCTION LastPos(c:Char; Str: String): Byte;
Var i: Byte;
BEGIN
i := Length(Str)+1;
Repeat
Dec(i);
Until (i=0) or (Str[i]=c);
LastPos := i;
END;
(* Die FUNKTION GetFName extrahiert aus einem ihr übergebenen Pfadnamen (Typ
PathStr) den eigentlichen Dateinamen (Typ FileStr (≡ String[12]), Wildcards
sind nicht erlaubt. Beispiel:
The FUNCTION GetFName extracts a filename from a complete pathname.
Wildcards are not allowed. Example:
s := GetFName('C:\DOS\FORMAT.COM'); liefert s = 'FORMAT.COM' *)
FUNCTION GetFName(Datei: PathStr): FileStr;
VAR k : Byte;
s : PathStr;
BEGIN
s := '';
k := Length(Datei);
While ((Datei[k] <> '\') and (Datei[k] <> ':') and (k > 0)) Do
BEGIN
s := Datei[k]+s;
Dec(k);
END;
GetFName := s;
END;
(* Die FUNKTION GetExt extrahiert aus einem ihr übergebenen Pfadnamen (Typ
PathStr) die Dateiextension (Typ ExtStr (≡ String[4]), Wildcards sind
nicht erlaubt. Beispiel:
The FUNCTION GetExt extracts the file extension from a complete pathname.
Wildcards are not allowed. Example:
s := GetExt('C:\DOS\FORMAT.COM'); liefert s = '.COM' *)
FUNCTION GetExt(Datei: PathStr): ExtStr;
VAR s : PathStr;
i : Byte;
BEGIN
s := GetFName(Datei);
i := LastPos('.',s);
If i <> 0 then
BEGIN
Delete(s,1,i-1);
GetExt := s;
END ELSE GetExt := '';
END;
(* Die FUNKTION FSize ermittelt die Dateigröße in Bytes und gibt -1 zurück,
wenn die Datei nicht existiert.
The FUNCTION FSize detects the filesize in bytes and returns -1, if
the file does not exist. *)
FUNCTION FSize(Filename: PathStr): LongInt;
VAR f : File of Byte;
IO: Word;
{ FMode: Byte; }
BEGIN
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
Filename := Strip('B','"',Filename);
{$ENDIF}
Assign(f,Filename);
Reset(f); IO := IOResult;
If (IO=0) or (IO=100) then
BEGIN
FSize := FileSize(f);
Close(f);
END ELSE FSize := -1;
{ FileMode := FMode; }
END;
(* Die FUNKTION EXESize ermittelt die Größe einer EXE-Datei aus ihrem Header.
The FUNCTION EXESize detects the size of an EXE-file from its header. *)
FUNCTION ExeSize(FName: PathStr): LongInt;
VAR f : File of Word;
S,R,IO : Word;
Size,Rest : LongInt;
{ FMode : Byte; }
BEGIN
ExeSize := 0;
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
FName := Strip('B','"',FName);
{$ENDIF}
Assign(f,FName);
Reset(f); IO := IOResult;
If (IO=0) or (IO=100) then
BEGIN
Seek(f,1);
Read(f,R);
Read(f,S);
Close(f);
Size := LongInt(S);
Rest := LongInt(R);
ExeSize := ((Size-1) mod 512) shl 9 + Rest;
END ELSE ExeSize := -1;
{ FileMode := FMode; }
END;
(* Handelt es sich bei der Datei um ein EXE-File?
Is the file an EXE-file? *)
FUNCTION IsExe(FName: PathStr): Boolean;
VAR f: File of Word;
{ FMode: Byte; }
MZ,IO: Word;
BEGIN
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
FName := Strip('B','"',FName);
{$ENDIF}
Assign(f,FName);
Reset(f);
IO := IOResult; If (IO=0) or (IO=100) then
BEGIN
Read(f,MZ);
Close(f);
IsExe := ((MZ=$5A4D) or (MZ=$4D5A)) and (ExeSize(FName)>0);
END ELSE IsExe := false;
{ FileMode := FMode; }
END;
(* Die FUNKTION Bit ergibt den Zustand von Bit b der Zahl n und dient zur
Abfrage Bit-codierter Statusinformationen.
The function Bit returns if bit b of the number n is set. *)
FUNCTION Bit(b: Byte; n: Word): Boolean;
BEGIN
b := b and 15;
Bit := ((n SHR b) and 1) = 1;
END;
(* Handelt es sich um ein Multiple volume-Archiv (gängigste Packer)?
Is the file a multiple volume archive (only most common packers)? *)
FUNCTION VolumeFlag(c: Char; Packer: Byte): Boolean;
VAR VFlag: Byte;
Code: Integer;
BEGIN
VolumeFlag := false;
VFlag := Byte(c);
CASE Packer of
ARJType: If Bit(2,VFlag) then VolumeFlag := true;
RARType: If Bit(0,VFlag) then VolumeFlag := true;
ACEType: If Bit(3,VFlag) then VolumeFlag := true;
END;
END;
(* Hat das Archiv einen "Security envelope" (gängigste Packer)?
Has the archive a security envelope (only most common packers)? *)
FUNCTION AVFlag(c: Char; Packer: Byte): Boolean;
VAR AFlag: Byte;
Code: Integer;
BEGIN
AVFlag := false;
AFlag := Byte(c);
CASE Packer of
ARJType: If Bit(6,AFlag) or Bit(1,AFlag) then AVFlag := true; (* Bit 1 = alter Security Envelope *)
RARType: If Bit(5,AFlag) or Bit(2,AFlag) then AVFlag := true; (* Bit 2 = locked *)
ACEType: If Bit(4,AFlag) or Bit(6,AFlag) then AVFlag := true; (* Bit 6 = locked *)
END;
END;
(* Ist die Datei mit AINEXE gepackt?
Is the file AINEXE-packed? *)
FUNCTION AINEXEPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[35];
Size: LongInt;
{ FMode: Byte; }
BEGIN
AINEXEPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #35;
AINEXEPacked := Pos('AIN',s)=33;
END;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei mit UCEXE gepackt?
Is the file UCEXE-packed? *)
FUNCTION UCEXEPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[32];
Size: LongInt;
{ FMode: Byte; }
BEGIN
UCEXEPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #32;
UCEXEPacked := Pos('UC2X',s)=29;
END;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei ein ARJ-Win32-Sfx?
Is the file an ARJ Win32 sfx? *)
FUNCTION ArjWinSfxPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[6];
Size: LongInt;
Sfx: Boolean;
{ FMode: Byte; }
BEGIN
ArjWinSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
Seek(f,900);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjWinSfxPacked := Sfx;
If Sfx then
BEGIN
Seek(f,15006);
BlockRead(f,IDStr[1],SizeOf(IDStr)-1);
IDStr[0] := #255;
END;
END;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei ein ARJ-DOS- oder OS/2-Sfx?
Is the file an ARJ DOS or OS/2 sfx? *)
FUNCTION ArjDOSSfxPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[6];
Size: LongInt;
Sfx: Boolean;
{ FMode: Byte; }
BEGIN
ArjDOSSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
Seek(f,225);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
If not Sfx then
BEGIN
Seek(f,567);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
If not Sfx then
BEGIN
Seek(f,663);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
If not Sfx then
BEGIN
Seek(f,664);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
If not Sfx then
BEGIN
Seek(f,900);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
If not Sfx then
BEGIN
Seek(f,208);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
If not Sfx then
BEGIN
Seek(f,262);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
END;
If not Sfx then
BEGIN
Seek(f,85);
BlockRead(f,s[1],6);
s[0] := #6;
Sfx := CapStr(s)='ARJSFX';
ArjDosSfxPacked := Sfx;
END;
END;
END;
END;
END;
END;
END;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei ein ACE-DOS-, Win- oder OS/2-Sfx?
Is the file an ACE DOS, Win or OS/2 sfx?
Funktion optimiert von Snow Panther, danke!
Function optimized by Snow Panther, thanks! *)
FUNCTION ACESfxPacked(ArcName: PathStr): Boolean;
Label THE_END;
VAR f : File;
Size : LongInt;
zs : String[5];
{ FMode : Byte; }
FUNCTION CheckSignAtPos(fpos:Longint):Boolean;
BEGIN
CheckSignAtPos:=false;
If fpos<=size then
BEGIN
Seek(f,fpos);
BlockRead(f,zs[1],5);
zs[0]:=#5;
If zs='**ACE'then CheckSignAtPos:=true;
END;
END;
BEGIN
ACESfxPacked := false;
zs := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f)-5; {5 = length}
If CheckSignAtPos(7507) then goto THE_END;
If CheckSignAtPos(7607) then goto THE_END;
If CheckSignAtPos(14037) then goto THE_END;
If CheckSignAtPos(15050) then goto THE_END;
If CheckSignAtPos(15607) then goto THE_END;
If CheckSignAtPos(15807) then goto THE_END;
If CheckSignAtPos(16807) then goto THE_END;
If CheckSignAtPos(21807) then goto THE_END;
If CheckSignAtPos(21907) then goto THE_END;
If CheckSignAtPos(22007) then goto THE_END;
If CheckSignAtPos(22607) then goto THE_END;
If CheckSignAtPos(40967) then goto THE_END;
If CheckSignAtPos(42503) then goto THE_END;
If CheckSignAtPos(43015) then goto THE_END;
If CheckSignAtPos(44039) then goto THE_END;
If CheckSignAtPos(44551) then goto THE_END;
If CheckSignAtPos(57162) then goto THE_END;
If CheckSignAtPos(57174) then goto THE_END;
If CheckSignAtPos(57274) then goto THE_END;
If CheckSignAtPos(57290) then goto THE_END;
If CheckSignAtPos(57646) then goto THE_END;
If CheckSignAtPos(57746) then goto THE_END;
If CheckSignAtPos(57770) then goto THE_END;
If CheckSignAtPos(58609) then goto THE_END;
If CheckSignAtPos(58610) then goto THE_END;
If CheckSignAtPos(58756) then goto THE_END;
If CheckSignAtPos(58837) then goto THE_END;
If CheckSignAtPos(58848) then goto THE_END;
If CheckSignAtPos(58850) then goto THE_END;
If CheckSignAtPos(59122) then goto THE_END;
If CheckSignAtPos(59360) then goto THE_END;
If CheckSignAtPos(61110) then goto THE_END;
If CheckSignAtPos(61134) then goto THE_END;
If CheckSignAtPos(61146) then goto THE_END;
If CheckSignAtPos(61150) then goto THE_END;
If CheckSignAtPos(61170) then goto THE_END;
If CheckSignAtPos(61270) then goto THE_END;
If CheckSignAtPos(61341) then goto THE_END;
If CheckSignAtPos(61409) then goto THE_END;
If CheckSignAtPos(61580) then goto THE_END;
If CheckSignAtPos(68261) then goto THE_END;
If CheckSignAtPos(68614) then goto THE_END;
If CheckSignAtPos(68739) then goto THE_END;
If CheckSignAtPos(71192) then goto THE_END;
If CheckSignAtPos(71714) then goto THE_END;
If CheckSignAtPos(73505) then goto THE_END;
If CheckSignAtPos(77619) then goto THE_END;
If CheckSignAtPos(77763) then goto THE_END;
If CheckSignAtPos(90755) then goto THE_END;
If CheckSignAtPos(91010) then goto THE_END;
If CheckSignAtPos(91865) then goto THE_END;
If CheckSignAtPos(92531) then goto THE_END;
If CheckSignAtPos(92996) then goto THE_END;
If CheckSignAtPos(92997) then goto THE_END;
If CheckSignAtPos(95239) then goto THE_END;
If CheckSignAtPos(102801) then goto THE_END;
If CheckSignAtPos(103924) then goto THE_END;
If CheckSignAtPos(104537) then goto THE_END;
If CheckSignAtPos(106488) then goto THE_END;
If CheckSignAtPos(149080) then goto THE_END;
Close(f);
Exit;
THE_END:
ACESfxPacked:=true;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei ein ZIP-DOS-, Win- oder OS/2-Sfx?
Is the file a ZIP DOS, Win or OS/2 sfx?
Funktion optimiert von Snow Panther, danke!
Function optimized by Snow Panther, thanks! *)
FUNCTION PKWinOS2SfxPacked(ArcName: PathStr): Boolean;
Label THE_END;
VAR f: File;
s: String[34];
Size: LongInt;
{ FMode: Byte; }
FUNCTION CheckZIPSignAtPos(fpos: Longint; sub: String; lsub: Byte): Boolean;
BEGIN
CheckZIPSignAtPos := false;
If fpos<=size then
BEGIN
Seek(f,fpos);
BlockRead(f,s[1],lsub);
s[0]:=Chr(lsub);
If s=sub then CheckZIPSignAtPos := true;
END;
END;
BEGIN
PKWinOS2SfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If CheckZIPSignAtPos(50,'PKWARE Inc. All Rights Reserved',31) then goto THE_END;
If CheckZIPSignAtPos(126,'WinZip Self-Extractor',21) then goto THE_END;
If CheckZIPSignAtPos(464,'GWinZip',7) then goto THE_END;
If CheckZIPSignAtPos(512,'GWinZip',7) then goto THE_END;
If CheckZIPSignAtPos(526,'PKSFX',5) then goto THE_END;
If CheckZIPSignAtPos(590,'PKSFX',5) then goto THE_END;
If CheckZIPSignAtPos(780,#3'SFX',4) then goto THE_END;
If CheckZIPSignAtPos(11712,'PKSFX',5) then goto THE_END;
If CheckZIPSignAtPos(12688,'WinZip Self',11) then goto THE_END;
If CheckZIPSignAtPos(14352,'WinZip(R) Self',14) then goto THE_END;
If CheckZIPSignAtPos(15720,'WinZip Self',11) then goto THE_END;
If CheckZIPSignAtPos(15750,'WinZip Self',11) then goto THE_END;
If CheckZIPSignAtPos(15888,'WinZip(R) Self',14) then goto THE_END;
If CheckZIPSignAtPos(16058,'WinZip',6) then goto THE_END;
If CheckZIPSignAtPos(16112,'WinZip Self',11) then goto THE_END;
If CheckZIPSignAtPos(16114,'WinZip Self',11) then goto THE_END;
If CheckZIPSignAtPos(17424,'WinZip',6) then goto THE_END;
If CheckZIPSignAtPos(17688,'GWinZip',7) then goto THE_END;
If CheckZIPSignAtPos(20080,'WinZip Self',11) then goto THE_END;
If CheckZIPSignAtPos(21008,'WinZip(R) Self',14) then goto THE_END;
If CheckZIPSignAtPos(30302,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(30867,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(38483,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(51200,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(84992,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(86016,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(93747,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(94771,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(96832,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(123276,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(132096,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(151704,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(154466,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(161584,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(162816,'PK'#3#4,4) then goto THE_END;
If CheckZIPSignAtPos(Size-34,'Windows Self-Installing Executable',34) then goto THE_END;
Close(f);
Exit;
THE_END:
Close(f);
PKWinOS2SfxPacked:=true;
{ FileMode := FMode; }
END;
(* Ist die Datei im "Package for the Web"-Format?
Is the file in "Package for the Web" format? *)
FUNCTION PfWPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[4];
Size: LongInt;
{ FMode: Byte; }
BEGIN
PfWPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
Seek(f,140546);
BlockRead(f,s[1],4);
s[0] := #4;
PfWPacked := s='MSCF';
END;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei mit LZEXE gepackt?
Is the file LZEXE-packed? *)
FUNCTION LZExed(ArcName: PathStr): Boolean;
CONST BufSize=30;
VAR b: Array[0..BufSize] of Byte;
f: File;
x {, FMode }: Byte;
BEGIN
LZExed := false;
If FSize(ArcName)>330 then
BEGIN
If Exist(ArcName) then
BEGIN
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
BlockRead(f,b,BufSize);
Close(f);
{ FileMode := FMode; }
x := b[28]; (* Nach String 'LZ' an Offset 28 suchen *)
If x=76 then
BEGIN
x := b[29]; (* Char 28=L?; dann weiter *)
LZExed := x=90;
END;
END;
END;
END;
(* Ist die Datei mit PKLite gepackt?
Is the file PKLite-packed? *)
FUNCTION PKExed(ArcName: PathStr): Boolean;
CONST BufSize=48;
VAR b: Array[0..BufSize] of Byte;
f: File;
x {, FMode}: Byte;
BEGIN
PKExed := false;
If FSize(ArcName)>330 then
BEGIN
If Exist(ArcName) then
BEGIN
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
BlockRead(f,b,BufSize);
Close(f);
{ FileMode := FMode; }
x := b[30]; (* Nach String 'PK' an Offset 30 suchen *)
If x=80 then
BEGIN
x := b[31]; (* Char 30=P?; dann weiter *)
If x=75 then
BEGIN
PKExed := true;
Exit;
END;
END;
x := b[46]; (* Nach String 'PK' an Offset 46 suchen *)
If x=80 then
BEGIN
x := b[47]; (* Char 46=P?; dann weiter *)
PKExed := x=75;
END;
END;
END;
END;
(* Ist die Datei mit Diet gepackt?
Is the file Diet-packed? *)
FUNCTION Dieted(ArcName: PathStr): Boolean;
CONST BufSize=$6F;
VAR b: Array[0..BufSize] of Byte;
f: File;
x1,x2{ ,FMode }: Byte;
dlz: String[3];
BEGIN
Dieted := false;
If FSize(ArcName)>330 then
BEGIN
If Exist(ArcName) then
BEGIN
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
BlockRead(f,b,BufSize);
Close(f);
{ FileMode := FMode; }
dlz := '';
x1 := b[0];
x2 := b[1];
System.Move(b[$23],dlz[1],3); (* Nach String 'dlz' an Offset 23h suchen *)
dlz[0] := #3;
If (dlz='dlz') and (x1=$B) and (x2=$E) then
BEGIN
Dieted := true;
Exit;
END;
dlz := '';
System.Move(b[$41],dlz[1],3); (* Nach String 'dlz' an Offset 41h suchen *)
dlz[0] := #3;
If (dlz='dlz') and (x1=$F9) and (x2=$9C) then
BEGIN
Dieted := true;
Exit;
END;
dlz := '';
x1 := b[$12];
x2 := b[$13];
System.Move(b[$57],dlz[1],3); (* Nach String 'dlz' an Offset 57h suchen *)
dlz[0] := #3;
If (dlz='dlz') and (x1=$9D) and (x2=$89) then
BEGIN
Dieted := true;
Exit;
END;
dlz := '';
x1 := b[0];
x2 := b[1];
System.Move(b[$57],dlz[1],3); (* Nach String 'dlz' an Offset 57h suchen *)
dlz[0] := #3;
If (dlz='dlz') and (x1=$9D) and (x2=$89) then
BEGIN
Dieted := true;
Exit;
END;
dlz := '';
x1 := b[$12];
x2 := b[$13];
System.Move(b[$6B],dlz[1],3); (* Nach String 'dlz' an Offset 6Bh suchen *)
dlz[0] := #3;
If (dlz='dlz') and (x1=$9D) and (x2=$89) then
BEGIN
Dieted := true;
Exit;
END;
dlz := '';
System.Move(b[$6C],dlz[1],3); (* Nach String 'dlz' an Offset 6Ch suchen *)
dlz[0] := #3;
Dieted := (dlz='dlz') and (x1=$9D) and (x2=$89);
END;
END;
END;
(* Ist die Datei mit TinyProg gepackt?
Is the file TinyProg-packed? *)
FUNCTION TPExed(ArcName: PathStr): Boolean;
CONST BufSize=30;
VAR b: Array[0..BufSize] of Byte;
f: File;
x {, FMode}: Byte;
BEGIN
TPExed := false;
If FSize(ArcName)>330 then
BEGIN
If Exist(ArcName) then
BEGIN
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
BlockRead(f,b,BufSize);
Close(f);
{ FileMode := FMode; }
x := b[28]; (* Nach String 'tz' an Offset 28 suchen *)
If x=116 then
BEGIN
x := b[29]; (* Char 28=t?; dann weiter *)
TPExed := x=122;
END;
END;
END;
END;
FUNCTION EXEPacked(ArcName: PathStr): Boolean;
BEGIN
EXEPacked := LZExed(ArcName) or PKExed(ArcName) or Dieted(ArcName) or TPExed(ArcName);
END;
FUNCTION WWPackPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[31];
Size: LongInt;
{ FMode: Byte; }
BEGIN
WWPackPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #31;
WWPackPacked := (Pos('WWP',s)=29);
END;
Close(f);
{ FileMode := FMode; }
END;
FUNCTION ARXSfxPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[41];
Size: LongInt;
{ FMode: Byte; }
BEGIN
ARXSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #41;
ARXSfxPacked := (Pos('$ARX',s)=6) or (Pos('$ARX',s)=38);
END;
Close(f);
{ FileMode := FMode; }
END;
FUNCTION LHArcSfxPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[49];
Size: LongInt;
{ FMode: Byte; }
BEGIN
LHArcSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #49;
LHarcSfxPacked := (Pos('LHarc''s SFX',s)=7) or (Pos('LHarc''s SFX',s)=39);
END;
Close(f);
{ FileMode := FMode; }
END;
FUNCTION LZSSfxPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[43];
Size: LongInt;
{ FMode: Byte; }
BEGIN
LZSSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #43;
LZSSfxPacked := (Pos('SFX by LARC',s)=33);
END;
Close(f);
{ FileMode := FMode; }
END;
FUNCTION CompackSfxPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[11];
Size: LongInt;
{ FMode: Byte; }
BEGIN
CompackSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
Seek(f,100);
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #11;
CompackSfxPacked := (Pos('Collis'#0#0'SFX',s)=1);
END;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei ein Windows-InstallShield-Sfx?
Is the file a Windows InstallShield sfx? *)
FUNCTION InstallShieldPacked(ArcName: PathStr): Boolean;
VAR f: File;
s: String[18];
Size: LongInt;
{ FMode: Byte; }
BEGIN
InstallShieldPacked := false;
If IsEXE(ArcName) then
BEGIN
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If Size>=Length(s) then
If Size>=Length(s)+$3AF then
BEGIN
Seek(f,$3AF);
BlockRead(f,s[1],SizeOf(s)-1);
s[0] := #18;
InstallShieldPacked := s='InstallShield Self';
END;
Close(f);
{ FileMode := FMode; }
END;
END;
FUNCTION ID_at_end(ArcName: PathStr; ID: Byte): Boolean;
VAR f: File of Byte;
s: String[5];
c,i {,FMode}: Byte;
Size: LongInt;
BEGIN
ID_at_end := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f);
Size := FileSize(f);
If Size>=Length(s) then
BEGIN
Seek(f,FileSize(f)-5);
For i := 1 to 5 do
BEGIN
Read(f,c);
s[i] := Char(c);
END;
s[0] := #5;
If ID=ARJType then ID_at_end := Copy(s,2,4)=#$60#$EA#0#0 ELSE
If ID=DWCType then ID_at_end := Copy(s,3,3)='DWC' ELSE
If ID=ZARType then ID_at_end := Copy(s,3,2)='PT' ELSE
If ID=ARGType then ID_at_end := Copy(s,5,1)=#1 ELSE
If ID=PC3Type then ID_at_end := Copy(s,4,2)=#$E0#$E0 ELSE
If ID=IiType then ID_at_end := Copy(s,1,5)='xxx32' ELSE
If (ID=XDIType) or (ID=XpdType) then ID_at_end := Copy(s,4,2)='jm' ELSE
If ID=RKType then ID_at_end := ((s[1]=#129) and (Copy(s,4,2)='RK')) ELSE
If ID=PAKType then ID_at_end := Copy(s,4,1)=#$FE ELSE
If ID=RKVType then if (((Copy(s,3,2)=#0#0) and (s[5] in [#$30..#$7A]))) or
(Copy(s,4,2)='RK') then ID_at_end := true;
END;
Close(f);
{ FileMode := FMode; }
END;
(* Ist die Datei ein RAR-DOS-, Win- oder OS/2-Sfx?
Is the file a RAR DOS, Win or OS/2 sfx?
Funktion optimiert von Snow Panther, danke!
Function optimized by Snow Panther, thanks! *)
FUNCTION RARSfxPacked(ArcName: PathStr): Boolean;
Label THE_END;
VAR f: File;
s: String[32];
Size: LongInt;
{ FMode: Byte; }
FUNCTION CheckSignAtPos(fpos:Longint):Boolean;
BEGIN
CheckSignAtPos:=false;
If fpos<=size then
BEGIN
Seek(f,fpos);
BlockRead(f,s[1],4);
s[0]:=#4;
If s='Rar!'then CheckSignAtPos:=true;
END;
END;
BEGIN
RARSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SH6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f);
If size>=32 then
BEGIN
BlockRead(f,s[1],32);
s[0] := #32;
If Pos('RSFX',s)=29 then goto THE_END;
end;
If CheckSignAtPos(12960) then goto THE_END;
If CheckSignAtPos(13312) then goto THE_END;
If CheckSignAtPos(13824) then goto THE_END;
If CheckSignAtPos(17678) then goto THE_END;
If CheckSignAtPos(17721) then goto THE_END;
If CheckSignAtPos(17952) then goto THE_END;
If CheckSignAtPos(18274) then goto THE_END;
If CheckSignAtPos(23040) then goto THE_END;
If CheckSignAtPos(24074) then goto THE_END;
If CheckSignAtPos(24132) then goto THE_END;
If CheckSignAtPos(24788) then goto THE_END;
If CheckSignAtPos(25044) then goto THE_END;
If CheckSignAtPos(28160) then goto THE_END;
If CheckSignAtPos(36864) then goto THE_END;
If CheckSignAtPos(40456) then goto THE_END;
If CheckSignAtPos(46080) then goto THE_END;
If CheckSignAtPos(49355) then goto THE_END;
If CheckSignAtPos(49576) then goto THE_END;
If CheckSignAtPos(49664) then goto THE_END;
If CheckSignAtPos(50176) then goto THE_END;
If CheckSignAtPos(54784) then goto THE_END;
If CheckSignAtPos(55808) then goto THE_END;
If CheckSignAtPos(58773) then goto THE_END;
If CheckSignAtPos(61440) then goto THE_END;
If CheckSignAtPos(64000) then goto THE_END;
If CheckSignAtPos(66560) then goto THE_END;
If CheckSignAtPos(69120) then goto THE_END;
If CheckSignAtPos(69632) then goto THE_END;
If CheckSignAtPos(71168) then goto THE_END;
If CheckSignAtPos(71680) then goto THE_END;
If CheckSignAtPos(57856) then goto THE_END;
If CheckSignAtPos(13905) then goto THE_END;
Close(f);
Exit;
THE_END:
Close(f);
RARSfxPacked := true;
{ FileMode := FMode; }
END;
(* Ist die Datei ein ZZip-Sfx?
Is the file a ZZip sfx?
Funktion optimiert von Snow Panther, danke!
Function optimized by Snow Panther, thanks! *)
FUNCTION ZZipSfxPacked(ArcName: PathStr): Boolean;
Label THE_END;
VAR f : File;
Size : LongInt;
s : String[3];
{ FMode : Byte; }
FUNCTION CheckSignAtPos(fpos:Longint):Boolean;
BEGIN
CheckSignAtPos:=false;
If fpos<=size then
BEGIN
Seek(f,fpos);
BlockRead(f,s[1],3);
s[0]:=#3;
If s='ZZ0'then CheckSignAtPos:=true;
END;
END;
BEGIN
ZZipSfxPacked := false;
s := '';
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
Size := FileSize(f)-5; {5 = length}
If CheckSignAtPos(19968) then goto THE_END;
Close(f);
Exit;
THE_END:
ZZipSfxPacked:=true;
Close(f);
{ FileMode := FMode; }
END;
FUNCTION PakDDPacked(ArcName: PathStr): Boolean;
VAR f: File of Word;
Size: LongInt;
w1,w2,w3,w4: Word;
w: LongInt;
{ FMode: Byte; }
BEGIN
PakDDPacked := false;
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f);
Size := FileSize(f);
If Size>=8 then
BEGIN
Read(f,w1);
Read(f,w2);
Read(f,w3);
Read(f,w4);
w := w1+w2+w3+w4;
PakDDPacked := w=$AAAA;
END;
Close(f);
{ FileMode := FMode; }
END;
FUNCTION ArcMethod(ArcName: PathStr): Byte;
CONST PAKId=$0A;
HYPId=$48;
ARPId=$14;
ARCId=$1A;
VAR ArcHeader : Record
Marker: Byte;
Method: Byte;
Name : Array[1..13] of Char;
Size : LongInt;
Stamp : LongInt;
CRC : Word;
Length: LongInt;
END;
NotOK,IsEx: Boolean;
f : File;
ArcTyp,
{ FMode : Byte; }
ExeLen : LongInt;
BEGIN
If IsExe(ArcName) then
BEGIN
IsEx := true;
ExeLen := ExeSize(ArcName);
END ELSE IsEx := false;
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName);
Reset(f,1);
NotOK := false;
ArcTyp := Invalid;
If IsEx then Seek(f,ExeLen);
Repeat
Blockread(f,ArcHeader,SizeOf(ArcHeader));
If (IOResult=0) or (IOResult=100) then
BEGIN
If ArcHeader.Marker=ARCId then
BEGIN
ArcTyp := ARCType;
If ArcHeader.Method>=PAKid then
BEGIN
NotOK:=true;
If (ArcHeader.Name[11]=#$14) and (ArcHeader.Name[12]=#$15) and
(ArcHeader.Name[13]=#$13) or (ID_at_End(ArcName,PakType)) then ArcTyp := PAKType;
If ArcHeader.Method >= HYPid then
ArcTyp := HYPType ELSE
If ArcHeader.Method=ARPid then ArcTyp := ARCPlusType;
END;
END ELSE NotOK := true;
END ELSE NotOK := true;
Until NotOK;
Close(f);
{ FileMode := FMode; }
ArcMethod := ArcTyp;
END;
FUNCTION OpenArchive(ArcName: PathStr): Boolean;
CONST MinSize=20;
VAR f: File;
IO: Word;
{ FMode, }BufLen: Byte;
Offset,ExeLen,Size: LongInt;
BEGIN
{ FMode := FileMode; FileMode := 0 OR 1 SHL 6; }
{$IFDEF LONGNAME}
ArcName := Strip('B','"',ArcName);
{$ENDIF}
Assign(f,ArcName); Reset(f,1);
Size := FileSize(f);
Close(f);
OpenArchive := false;
If Size>=MinSize then
BEGIN
Offset := 0; ExeLen := 0;
If IsExe(ArcName) then
BEGIN
IsEx := true;
ExeLen := ExeSize(ArcName);
Inc(Offset,ExeLen);
END ELSE IsEx := false;
If ExeLen=Size then
BEGIN
IDStr := '';
OpenArchive := true;
Exit;
END;
Assign(f,ArcName);
Reset(f,1);
BufLen := SizeOf(IDStr)-1;
If Size<BufLen then Buflen := Size;
IO := IOResult;
If Size>=MinSize then
If (IO=0) or (IO=100) then
BEGIN
If (Offset<>0) and (Offset>=ExeLen) then Seek(f,Offset);
Blockread(f,IDStr[1],BufLen);
IDStr[0] := Char(BufLen);
Close(f);
OpenArchive := true;
END;
{ FileMode := FMode; }
END;
END;
FUNCTION ArchiveType(ArcName: PathStr): Byte;
VAR o,p,q,r: Byte;
w1,w2,w3,w4: Word;
w: LongInt;
BEGIN
ArchiveType := Invalid;
If not Exist(ArcName) then ArchiveType := FileNotFound ELSE
BEGIN
If not OpenArchive(ArcName) then Exit ELSE
BEGIN
p := Pos('CRUSH$',IDStr); q := Pos('.CRU',IDStr); r := Pos('.cru',IDStr); o := Pos('CRUSH',IDStr);
If (p=35) or (q in [24..39]) or (r in [24..31,82..89]) or (o=1) then
BEGIN
CrushPacked := true;
If o=1 then ArchiveType := CruType ELSE
If Pos('PK'#3#4,IDStr)=1 then ArchiveType := CruPType ELSE
If (Pos(#$60#$EA,IDStr)=1) or (Pos(#$60#$EA,IDStr)=3) or (Pos('.ARJ',IDStr)=41) then
ArchiveType := CruJType ELSE
If Pos('-lh',IDStr)=3 then ArchiveType := CruLType ELSE
If Pos('ZOO',IDStr)=1 then ArchiveType := CruZType ELSE
If Pos('HA',IDStr)=1 then ArchiveType := CruHType;
Exit;
END;
If (Pos('PK'#3#4,IDStr)=1) or (Pos('PK00PK',IDStr)=1) then
BEGIN
ArchiveType := ZIPType;
Exit;
END ELSE If PKWinOS2SfxPacked(ArcName) then
BEGIN
ArchiveType := ZIPType;
Exit;
END;
If (Pos(#31#139#8#8,IDStr)=1) or (Pos(#$1F#$9D#$90,IDStr)=1) then
BEGIN
ArchiveType := GZIPType;
Exit;
END;
If (Pos(#$60#$EA,IDStr)=1) or (Pos(#$60#$EA,IDStr)=3) or
ArjWinSfxPacked(ArcName) or ArjDOSSfxPacked(ArcName) or
ID_at_end(Arcname,ARJType) then
BEGIN
ArchiveType := ARJType;
mv := (VolumeFlag(IDStr[9],ARJType) or VolumeFlag(IDStr[11],ARJType));
If Pos(#$60#$EA,IDStr)=1 then av := AVFlag(IDStr[9],ARJType) ELSE
If (Pos(#$60#$EA,IDStr)=3) then av := AVFlag(IDStr[11],ARJType);
If Pos('.SRJ',CapStr(ArcName))<>0 then ArchiveType := SARJType;
Exit;
END;
If (Pos(#26'Jar'#27#0,IDStr)=15) then
BEGIN
ArchiveType := JRType;
Exit;
END;
If (Pos('RE'#$7E#$5E,IDStr)=1) or (Pos('Rar',IDStr)=1) or
RARSfxPacked(ArcName) then
BEGIN
ArchiveType := RARType;
mv := VolumeFlag(IDStr[11],RARType);
av := AVFlag(IDStr[11],RARType);
Exit;
END;
If Pos('**ACE**',IDStr)=8 then
BEGIN
ArchiveType := AceType;
mv := VolumeFlag(IDStr[7],ACEType);
av := AVFlag(IDStr[7],ACEType);
Exit;
END;
If AceSfxPacked(ArcName) then
BEGIN
ArchiveType := AceType;
Exit;
END;
If Pos('HLSQZ',IDStr)=1 then
BEGIN
ArchiveType := SQZType;
Exit;
END;
If Pos('SQWEZ',IDStr)=1 then
BEGIN
ArchiveType := SQWEZType;
Exit;
END;
If Pos('HPAK',IDStr)=1 then
BEGIN
ArchiveType := HPKType;
Exit;
END;
If Pos('æ3HF',IDStr)=1 then
BEGIN
ArchiveType := HAPType;
Exit;
END;
If Pos(#$DC#$A7#$C4#$FD,IDStr)=21 then
BEGIN
ArchiveType := ZOOType;
Exit;
END;
If Pos('HA',IDStr)=1 then
BEGIN
ArchiveType := HAType;
Exit;
END;
If Pos('MDmd',IDStr)=1 then
BEGIN
ArchiveType := MDType;
Exit;
END;
If (Pos('LM'#$1A#8#0,IDStr)=1) or (Pos('LM'#$1A#7#0,IDStr)=1) then
BEGIN
ArchiveType := LIMType;
Exit;
END;
If Pos('LH5',IDStr)=4 then
BEGIN
ArchiveType := SARType;
Exit;
END;
If Pos(#212#3'SB '#0,IDStr)=1 then
BEGIN
ArchiveType := BS2Type;
Exit;
END;
If ((Pos('-ah',IDStr)=3) and (IDStr[7]='-')) then
BEGIN
ArchiveType := MARType;
Exit;
END;
If ((Pos(#$80,IDStr)=2) or (Pos(#$81,IDStr)=2) or
(Pos(#$82,IDStr)=2) or (Pos(#$83,IDStr)=2) or
(Pos(#$84,IDStr)=2)) and
(Pos(#0,IDStr)=4) then
BEGIN
ArchiveType := ACBType;
Exit;
END;
If (Pos(#0#0#0,IDStr)=2) and (GetExt(CapStr(ArcName))='.CPZ') then
BEGIN
ArchiveType := CPZType;
Exit;
END;
If Pos('JRchive',IDStr)=1 then
BEGIN
ArchiveType := JRCType;
Exit;
END;
If Pos('JARCS',IDStr)=1 then
BEGIN
ArchiveType := JARType;
Exit;
END;
If Pos('DS'#0,IDStr)=1 then
BEGIN
ArchiveType := QType;
Exit;
END;
If Pos('PK'#3#6,IDStr)=1 then
BEGIN
ArchiveType := SOFType;
Exit;
END;
If Pos('7'#04,IDStr)=1 then
BEGIN
ArchiveType := QARKType;
Exit;
END;
If Pos('YC',IDStr)=15 then
BEGIN
ArchiveType := YACType;
Exit;
END;
If (Pos('X1',IDStr)=1) or (Pos('XhDr',IDStr)=1) then
BEGIN
ArchiveType := X1Type;
Exit;
END;
If ((Pos(#$76#$FF,IDStr)=1) or (Pos(#$76#$FF,IDStr)=5)) and
((IDStr[3] in [#$20..#$3F]) or (IDStr[7] in [#$20..#$3F])) and
(Pos('.DQT',ArcName)=0) then
BEGIN
ArchiveType := CDCType;
Exit;
END;
If Pos(#$AD'6"',IDStr)=1 then
BEGIN
ArchiveType := AMGType;
Exit;
END;
If Pos('N⌡FΘlσ',IDStr)=1 then
BEGIN
ArchiveType := NLIType;
Exit;
END;
If Pos('LEOLZW',IDStr)=1 then
BEGIN
ArchiveType := PLLType;
Exit;
END;
If Pos(#$1F#$8B#$08,IDStr)=1 then
BEGIN
ArchiveType := TGZType;
Exit;
END;
If Pos('SChF',IDStr)=1 then
BEGIN
ArchiveType := CHZType;
Exit;
END;
If Pos('PSA',IDStr)=1 then
BEGIN
ArchiveType := PSAType;
Exit;
END;
If Pos('DSIGDCC',IDStr)=1 then
BEGIN
ArchiveType := PACType;
Exit;
END;
If Pos(#$1F#$9F#$4A#$10#$0A,IDStr)=1 then
BEGIN
ArchiveType := XFType;
Exit;
END;
If Pos('¿MP¿',IDStr)=1 then
BEGIN
ArchiveType := KBOType;
Exit;
END;
If Pos(#$76#$FF,IDStr)=1 then
BEGIN
ArchiveType := NSQType; (* Muss _nach_ CdcType geprueft werden. *)
Exit; (* Has to be tested _after_ CdcType. *)
END;
If Pos('Dirk Paehl',IDStr)=1 then
BEGIN
ArchiveType := DPAType;
Exit;
END;
If (not IsEXE(ArcName)) and (IDStr<>'') and (IDStr[1]=#0) and (IDStr[4]=#0) and (Copy(IDStr,2,2)=Copy(IDStr,5,2)) then
BEGIN
ArchiveType := BaType;
Exit;
END;
If (Pos(#0#6,IDStr)=1) and (not ID_at_end(ArcName,ZARType)) then
BEGIN
ArchiveType := TTCType;
Exit;
END;
If Pos('ESP',IDStr)=1 then
BEGIN
ArchiveType := ESPType;
Exit;
END;
If Pos(#1'ZPK'#1,IDStr)=1 then
BEGIN
ArchiveType := ZPKType;
Exit;
END;
If Pos(#$BC#$40,IDStr)=1 then
BEGIN
ArchiveType := SkyType;
Exit;
END;
If Pos('UFA',IDStr)=1 then
BEGIN
ArchiveType := UfaType;
Exit;
END;
If Pos('-H2O',IDStr)=1 then
BEGIN
ArchiveType := DRYType;
Exit;
END;
If Pos('MSCF',IDStr)=1 then
BEGIN
ArchiveType := CABType;
Exit;
END;
If Pos('FOXSQZ',IDStr)=1 then
BEGIN
ArchiveType := FSqzType;
Exit;
END;
If Pos(',AR7',IDStr)=1 then
BEGIN
ArchiveType := AR7Type;
Exit;
END;
If Pos('PPMZ',IDStr)=1 then
BEGIN
ArchiveType := PPMZType;
Exit;
END;
If Pos(#$88#$F0#$27,IDStr)=5 then
BEGIN
ArchiveType := ExpType;
Exit;
END;
If Pos('MP3'#$1A,IDStr)=1 then
BEGIN
ArchiveType := MP3Type;
Exit;
END;
If Pos('OZ▌',IDStr)=1 then
BEGIN
ArchiveType := ZetType;
Exit;
END;
If Pos(#$65#$5D#$13#$8C#$08#$01#$03#$00,IDStr)=1 then
BEGIN
ArchiveType := TSCType;
Exit;
END;
If Pos('gW'#4#1,IDStr)=1 then
BEGIN
ArchiveType := ArqType;
Exit;
END;
If Pos('OctSqu',IDStr)=4 then
BEGIN
ArchiveType := ArhType;
Exit;
END;
If Pos(#5#1#1#0,IDStr)=1 then
BEGIN
ArchiveType := TerType;
Exit;
END;
If Pos('SIT!',IDStr)=1 then
BEGIN
ArchiveType := SitType;
Exit;
END;
If Pos(#$01#$08#$0B#$08#$EF#$00#$9E#$32#$30#$36#$31,IDStr)=1 then
BEGIN
ArchiveType := PucType;
Exit;
END;
If Pos('UHA',IDStr)=1 then
BEGIN
ArchiveType := UHaType;
Exit;
END;
If (Pos(#2'AB',IDStr)=1) or (Pos(#3'AB2',IDStr)=1) then
BEGIN
ArchiveType := AbcType;
Exit;
END;
If Pos('CO'#0,IDStr)=1 then
BEGIN
ArchiveType := CmpType;
Exit;
END;
If Pos('ëLZO',IDStr)=1 then
BEGIN
ArchiveType := LZOType;
Exit;
END;
If Pos(#$93#$B9#$06,IDStr)=1 then
BEGIN
ArchiveType := SplType;
Exit;
END;
If Pos(#$13#$5D#$65#$8C,IDStr)=1 then
BEGIN
ArchiveType := IShZType;
Exit;
END;
If Pos('GTH',IDStr)=2 then
BEGIN
ArchiveType := GthType;
Exit;
END;
If Pos('BOA',IDStr)=1 then
BEGIN
ArchiveType := BoaType;
Exit;
END;
If Pos('ULEB'#$A,IDStr)=1 then
BEGIN
ArchiveType := RaxType;
Exit;
END;
If Pos('ULEB'#0,IDStr)=1 then
BEGIN
ArchiveType := XTType;
Exit;
END;
If (Pos('BZ',IDStr)=1) and (IDStr[3] in ['0'..'9']) and (IDStr[4] in ['0'..'9']) then
BEGIN
ArchiveType := BZipType;
Exit;
END;
If (Pos('BZ',IDStr)=1) and (IDStr[3]='h') and (IDStr[4] in ['0'..'9']) then
BEGIN
ArchiveType := BZip2Type;
Exit;
END;
If Pos('@Γ'#1#0,IDStr)=1 then
BEGIN
ArchiveType := PckType;
Exit;
END;
If (IDStr[1] in [#$1A..#$1B]) and (Pos(#3'Descript',IDStr)=2) then
BEGIN
ArchiveType := BtsType;
Exit;
END;
If Pos('Ora ',IDStr)=1 then
BEGIN
ArchiveType := EliType;
Exit;
END;
If (Pos(#$1A'FC'#$1A,IDStr)=1) or (Pos(#$1A'QF'#$1A,IDStr)=1) then
BEGIN
ArchiveType := QfcType;
Exit;
END;
If Pos('RNC',IDStr)=1 then
BEGIN
ArchiveType := RncType;
Exit;
END;
If Pos('777',IDStr)=1 then
BEGIN
ArchiveType := _777Type;
Exit;
END;
If Pos('sTaC',IDStr)=1 then
BEGIN
ArchiveType := StacType;
Exit;
END;
If Pos('HPA',IDStr)=1 then
BEGIN
ArchiveType := HpaType;
Exit;
END;
If Pos('LG',IDStr)=1 then
BEGIN
ArchiveType := LgType;
Exit;
END;
If Pos('0123456789012345BZh91AY&SY',IDStr)=1 then
BEGIN
ArchiveType := Exp1Type;
Exit;
END;
If Pos('IMP'#$A,IDStr)=1 then
BEGIN
ArchiveType := ImpType;
Exit;
END;
If Pos(#0#$9E#$6E#$72#$76#$FF,IDStr)=1 then
BEGIN
ArchiveType := NrvType;
Exit;
END;
If PakDDPacked(ArcName) then
BEGIN
ArchiveType := PddType;
Exit;
END;
If Pos(#$73#$B2#$90#$F4,IDStr)=1 then
BEGIN
ArchiveType := SqType;
Exit;
END;
If (Pos('PHILIPP',IDStr)=1) or (Pos('PAR',IDStr)=1) then
BEGIN
ArchiveType := ParType;
Exit;
END;
If Pos('UB',IDStr)=1 then
BEGIN
ArchiveType := HitType;
Exit;
END;
If (Pos('SB',IDStr)=1) and (IDStr[3] in ['1'..'9']) then
BEGIN
ArchiveType := SbxType;
Exit;
END;
If Pos('NSK',IDStr)=1 then
BEGIN
ArchiveType := NskType;
Exit;
END;
If Pos('DST',IDStr)=1 then
BEGIN
ArchiveType := DstType;
Exit;
END;
If Pos('ASD',IDStr)=1 then
BEGIN
ArchiveType := AsdType;
Exit;
END;
If Pos('ISc(',IDStr)=1 then
BEGIN
ArchiveType := IscType;
If Pos(#4,IDStr)=5 then NewIsc := false;
Exit;
END;
If Pos('T4'#$1A,IDStr)=1 then
BEGIN
ArchiveType := T4Type;
Exit;
END;
If (Pos(#$EB#$BE,IDStr)=1) or (Pos(#$BE#$EB,IDStr)=1) then
BEGIN
ArchiveType := BtmType;
Exit;
END;
If Pos('BH'#5#7,IDStr)=1 then
BEGIN
ArchiveType := BhType;
Exit;
END;
If Pos('BIX0',IDStr)=1 then
BEGIN
ArchiveType := BixType;
Exit;
END;
If Pos('ChfLZ',IDStr)=4 then
BEGIN
ArchiveType := LzaType;
Exit;
END;
If Pos('Blink',IDStr)=1 then
BEGIN
ArchiveType := BliType;
Exit;
END;
If Pos(#$DA#$FA,IDStr)=1 then
BEGIN
ArchiveType := LgCType;
Exit;
END;
If Pos('(C) STEPANYUK',IDStr)=2 then
BEGIN
ArchiveType := ArsType;
Exit;
END;
If Pos('AKT32',IDStr)=1 then
BEGIN
ArchiveType := A32Type;
Exit;
END;
If Pos('AKT',IDStr)=1 then
BEGIN
ArchiveType := AktType;
Exit;
END;
If Pos('MSTSM',IDStr)=1 then
BEGIN
ArchiveType := NpaType;
Exit;
END;
If Pos(#0#$50#0#$14,IDStr)=1 then
BEGIN
ArchiveType := PftType;
Exit;
END;
If Pos('SEM',IDStr)=1 then
BEGIN
ArchiveType := SemType;
Exit;
END;
If Pos('Å»¼ä',IDStr)=1 then
BEGIN
ArchiveType := PpmType;
Exit;
END;
If Pos('FIZ',IDStr)=1 then
BEGIN
ArchiveType := FizType;
Exit;
END;
If (Pos('MS',IDStr)=1) and (IDStr[3] in [#0..#15]) and (IDStr[4] in [#0..#9]) then
BEGIN
ArchiveType := XieType;
Exit;
END;
If Pos(#$ED#$AB#$EE#$DB,IDStr)=1 then
BEGIN
ArchiveType := RpmType;
Exit;
END;
If (Pos('yz0',IDStr)=1) and (IDStr[4] in ['1'..'9']) and (IDStr[5] in ['0'..'9']) then
BEGIN
ArchiveType := DfType;
Exit;
END;
If (Pos('ZZ '#0#0,IDStr)=1) or (Pos('ZZ0',IDStr)=1) or ZZipSfxPacked(ArcName) then
BEGIN
ArchiveType := ZZType;
Exit;
END;
If (Pos('<DC-',IDStr)=1) and (Pos('>',IDStr)=9) then
BEGIN
ArchiveType := DCType;
Exit;
END;
If Pos(#4'TPAC'#3,IDStr)=1 then
BEGIN
ArchiveType := TpcType;
Exit;
END;
If (Pos('Ai'#1#1#0,IDStr)=1) or (Pos('Ai'#1#0#0,IDStr)=1) then
BEGIN
ArchiveType := AiType;
Exit;
END;
If (Pos('Ai'#2#0,IDStr)=1) or (Pos('Ai'#2#1,IDStr)=1) then
BEGIN
ArchiveType := Ai32Type;
Exit;
END;
If Pos('SBC',IDStr)=1 then
BEGIN
ArchiveType := SbcType;
Exit;
END;
If Pos('YBS',IDStr)=1 then
BEGIN
ArchiveType := YbsType;
Exit;
END;
If Pos(#$9E#0#0,IDStr)=1 then
BEGIN
ArchiveType := DitType;
Exit;
END;
If Pos('DMS!',IDStr)=1 then
BEGIN
ArchiveType := DmsType;
Exit;
END;
If Pos(#$8F#$AF#$AC#$8C,IDStr)=1 then
BEGIN
ArchiveType := EpcType;
Exit;
END;
If Pos('VS'#$1A,IDStr)=1 then
BEGIN
ArchiveType := VsaType;
Exit;
END;
If Pos('PDZ',IDStr)=2 then
BEGIN
ArchiveType := PdzType;
Exit;
END;
If PfWPacked(ArcName) then
BEGIN
ArchiveType := PfWType;
Exit;
END;
If Pos('WIC',IDStr)=1 then
BEGIN
ArchiveType := WICType; (* Achtung: Fake-Packer *)
Exit;
END;
If Pos('OWS ',IDStr)=1 then
BEGIN
ArchiveType := OWSType; (* Achtung: Fake-Packer *)
Exit;
END;
If Pos('WWP',IDStr)=1 then
BEGIN
ArchiveType := WWDType;
Exit;
END;
If Pos('GIF',IDStr)=1 then
BEGIN
ArchiveType := GIFType;
Exit;
END;
If Pos('JFIF',IDStr)=7 then
BEGIN
ArchiveType := JFIFType;
Exit;
END;
If Pos('hsi',IDStr)=1 then
BEGIN
ArchiveType := JHSIType;
Exit;
END;
If Pos(#$81#$8A,IDStr)=1 then
BEGIN
ArchiveType := BMFType;
Exit;
END;
p := Pos(#$FF'BSG',IDStr);
If (p=1) or (p=2) or (p=4) or (Pos(#0#174#2,IDStr)=2) or
(Pos(#0#174#3,IDStr)=2) or
(Pos(#0#174#7,IDStr)=2) then
BEGIN
ArchiveType := BSNType;
Exit;
END;
If ((Pos('-l',IDStr)=3) and (IDStr[7]='-')) or
((Pos('-l',IDStr)=4) and (IDStr[8]='-')) or
((Pos('-l',IDStr)=12) and (IDStr[16]='-')) or
((Pos('-TK1-',IDStr)=3)) or LHarcSfxPacked(ArcName) or LZSSfxPacked(ArcName) then
BEGIN
If (Pos('-lZ',IDStr)=3) and (IDStr[7]='-') then
ArchiveType := PUTType ELSE
If ((Pos('-lz',IDStr)=3) and (IDStr[7]='-')) or LZSSfxPacked(ArcName) then
ArchiveType := LzsType ELSE
BEGIN
If (((Pos('-lh0-',IDStr)=3) or (Pos('-lh1-',IDStr)=3)) and
(GetExt(CapStr(ArcName))='.ARX')) then
BEGIN
ArchiveType := ARXType;
Exit;
END ELSE
BEGIN
If Pos('-lh7-',IDStr)=3 then
BEGIN
ArchiveType := LHKType;
Exit;
END ELSE
BEGIN
If Pos('.CAR',CapStr(ArcName))<>0 then
BEGIN
ArchiveType := CarType;
Exit;
END;
ArchiveType := LZHType;
Exit;
END;
END
END;
Exit;
END;
If Pos('-sw1-',IDStr)=3 then
BEGIN
ArchiveType := SwgType;
Exit;
END;
If ComPackSfxPacked(ArcName) then
BEGIN
ArchiveType := CpkType;
Exit;
END;
If (Pos(#33#18,IDStr)=1) or (Pos(#33#17,IDStr)=1) then
BEGIN
ArchiveType := AINType;
Exit;
END;
If (Pos('UC2',IDStr)=1) or (Pos('UC2SFX Header',IDStr)=1) then
BEGIN
ArchiveType := UC2Type;
Exit;
END;
If UCEXEPacked(ArcName) then
BEGIN
If not ACESfxPacked(ArcName) then ArchiveType := UCEXEType ELSE
ArchiveType := AceType;
Exit;
END;
If AINEXEPacked(ArcName) then
BEGIN
ArchiveType := AINEXEType;
Exit;
END;
If LZEXEd(ArcName) then
BEGIN
ArchiveType := LZEXEType;
Exit;
END;
If Dieted(ArcName) then
BEGIN
ArchiveType := DietType;
Exit;
END;
If PKExed(ArcName) then
BEGIN
ArchiveType := PKLiteType;
Exit;
END;
If TPExed(ArcName) then
BEGIN
ArchiveType := TinyProgType;
Exit;
END;
If WWPackPacked(ArcName) then
BEGIN
If not ACESfxPacked(ArcName) then ArchiveType := WWPType ELSE
ArchiveType := ACEType;
Exit;
END;
If ARXSfxPacked(ArcName) then
BEGIN
ArchiveType := ARXType;
Exit;
END;
If InstallShieldPacked(ArcName) then
BEGIN
ArchiveType := IShType;
Exit;
END;
If ID_at_end(ArcName,DwcType) then
BEGIN
ArchiveType := DwcType;
Exit;
END;
If (Pos(#0,IDStr)=1) and ID_at_end(ArcName,ArgType) then
BEGIN
ArchiveType := ArgType;
Exit;
END;
If ID_at_end(ArcName,ZARType) then
BEGIN
ArchiveType := ZARType;
Exit;
END;
If ID_at_end(ArcName,PC3Type) then
BEGIN
ArchiveType := PC3Type;
Exit;
END;
If ID_at_end(ArcName,IiType) then
BEGIN
ArchiveType := IiType;
Exit;
END;
If ID_at_end(ArcName,RKVType) then
BEGIN
(* If (Pos('≡',IDStr)=2) or (Pos('Ç',IDStr)=2) or (Pos('ï',IDStr)=2) or
(Pos('à',IDStr)=2) or (Pos('ë',IDStr)=2) then *)
If IDStr[3] in [#0..#15] then
BEGIN
ArchiveType := RKVType;
Exit;
END;
END;
If ID_at_end(ArcName,RKType) then
BEGIN
ArchiveType := RKType;
Exit;
END;
If ID_at_end(ArcName,XdiType) then
BEGIN
If Pos('jm',IDStr)=1 then ArchiveType := XdiType ELSE
If Pos('xpa',IDStr)=1 then ArchiveType := XpaType ELSE
If Pos('═ jm',IDStr)=1 then ArchiveType := XpdType;
Exit;
END;
If Pos('xpa'#0#1,IDStr)=1 then
BEGIN
ArchiveType := Xpa32Type;
Exit;
END;
If Pos(#26#0#0#0,IDStr)=19 then
BEGIN
ArchiveType := FlhType;
Exit;
END;
If Pos('.ARI',CapStr(ArcName))<>0 then
BEGIN
ArchiveType := AriType;
Exit;
END;
If Pos('.TAR',CapStr(ArcName))<>0 then
BEGIN
ArchiveType := TarType;
Exit;
END;
If Pos('.CAR',CapStr(ArcName))<>0 then
BEGIN
ArchiveType := CaCType;
Exit;
END;
If (Pos('SZ'#10#4,IDStr)=1) or (* szip ab 1.10 *)
(((Pos(#0,IDStr)=2) and (IDStr[1] in [#0..#21])) or (* szip 1.04 *)
((IDStr[1] in [#0..#41]) and (IDStr[2] in [#0,#3..#255]) and (IDStr[4]=#0))) and (* szip 1.05 *)
(Pos('.EXE',CapStr(ArcName))=0) then
BEGIN
ArchiveType := SzipType;
Exit;
END;
If Pos('.LBR',CapStr(ArcName))<>0 then
BEGIN
ArchiveType := LBRType;
Exit;
END;
ArchiveType := ArcMethod(ArcName);
END;
END;
END;
END.