From c7f57d3f8586bc70edc4c5838151e86dea341741 Mon Sep 17 00:00:00 2001 From: Thomas Knoefel Date: Sat, 8 Apr 2023 17:56:10 +0200 Subject: [PATCH] Add TOP Compression UI source code --- DOC/FRAGEBOG.TXT | 26 + DOC/INSTALL.FID | 29 + DOC/PACKER.DOC | 580 +++++++++++++++ DOC/TOP.TXT | 306 ++++++++ DOC/TOP_V.TXT | 304 ++++++++ ERR/ARJ.ERR | 10 + ERR/DWC.ERR | 42 ++ ERR/HPACK.ERR | 26 + ERR/HYPER.ERR | 10 + ERR/IOERROR.MSG | 41 ++ ERR/LHA.ERR | 3 + ERR/PAK.ERR | 3 + ERR/PKUNZIP.ERR | 14 + ERR/PKZIP.ERR | 20 + ERR/SQZ.ERR | 34 + ERR/ZOO.ERR | 1 + HELP/HELP.TXT | 803 +++++++++++++++++++++ HELP/HELP_COM.PAS | 110 +++ HELP/TKVTEST.PAS | 38 + TKSTRING/ASM/HBBINARY.ASM | 58 ++ TKSTRING/ASM/HBBM.ASM | 201 ++++++ TKSTRING/ASM/HBCASE.ASM | 129 ++++ TKSTRING/ASM/HBCLRSTR.ASM | 47 ++ TKSTRING/ASM/HBCOMP1.ASM | 144 ++++ TKSTRING/ASM/HBCOMP2.ASM | 243 +++++++ TKSTRING/ASM/HBDATEST.ASM | 73 ++ TKSTRING/ASM/HBHEX.ASM | 92 +++ TKSTRING/ASM/HBLEFTP.ASM | 82 +++ TKSTRING/ASM/HBPAD.ASM | 80 ++ TKSTRING/ASM/HBSEARCH.ASM | 153 ++++ TKSTRING/ASM/HBTAB.ASM | 174 +++++ TKSTRING/ASM/HBTIMEST.ASM | 116 +++ TKSTRING/ASM/HBTRIM.ASM | 124 ++++ TKSTRING/HBBINARY.OBJ | Bin 0 -> 102 bytes TKSTRING/HBBM.OBJ | Bin 0 -> 333 bytes TKSTRING/HBCASE.OBJ | Bin 0 -> 263 bytes TKSTRING/HBCLRSTR.OBJ | Bin 0 -> 92 bytes TKSTRING/HBCOMP1.OBJ | Bin 0 -> 273 bytes TKSTRING/HBCOMP2.OBJ | Bin 0 -> 567 bytes TKSTRING/HBDATEST.OBJ | Bin 0 -> 148 bytes TKSTRING/HBHEX.OBJ | Bin 0 -> 219 bytes TKSTRING/HBLEFTP.OBJ | Bin 0 -> 173 bytes TKSTRING/HBPAD.OBJ | Bin 0 -> 163 bytes TKSTRING/HBSEARCH.OBJ | Bin 0 -> 256 bytes TKSTRING/HBTAB.OBJ | Bin 0 -> 283 bytes TKSTRING/HBTIMEST.OBJ | Bin 0 -> 233 bytes TKSTRING/HBTRIM.OBJ | Bin 0 -> 239 bytes TKSTRING/TKSTRING.PAS | 1129 +++++++++++++++++++++++++++++ TOP.PAS | 497 +++++++++++++ UNITS/ARCVIEW.INC | 1072 +++++++++++++++++++++++++++ UNITS/EMS.PAS | 262 +++++++ UNITS/INIT.PAS | 463 ++++++++++++ UNITS/INSTALL.PAS | 455 ++++++++++++ UNITS/KBM.PAS | 1143 +++++++++++++++++++++++++++++ UNITS/KBMA.ASM | 153 ++++ UNITS/KBMA.OBJ | Bin 0 -> 329 bytes UNITS/SWAP.PAS | 218 ++++++ UNITS/SWAPA.ASM | 672 +++++++++++++++++ UNITS/SWAPA.OBJ | Bin 0 -> 1550 bytes UNITS/TBAUM.PAS | 1442 +++++++++++++++++++++++++++++++++++++ UNITS/TCONTROL.PAS | 579 +++++++++++++++ UNITS/TCTRL2.PAS | 852 ++++++++++++++++++++++ UNITS/TDATEI.PAS | 722 +++++++++++++++++++ UNITS/TEST.PAS | 80 ++ UNITS/TKDISK.PAS | 339 +++++++++ UNITS/TKSAA.PAS | 671 +++++++++++++++++ UNITS/TKSTREAM.PAS | 418 +++++++++++ UNITS/TKVIDEO.PAS | 411 +++++++++++ UNITS/TKVIEW.PAS | 1207 +++++++++++++++++++++++++++++++ UNITS/TKVIEW2.PAS | 578 +++++++++++++++ UNITS/TKWIN.PAS | 401 +++++++++++ UNITS/TPACKEN.PAS | 214 ++++++ UNITS/TPINST.PAS | 180 +++++ UNITS/TURFEN.PAS | 187 +++++ 74 files changed, 18461 insertions(+) create mode 100644 DOC/FRAGEBOG.TXT create mode 100644 DOC/INSTALL.FID create mode 100644 DOC/PACKER.DOC create mode 100644 DOC/TOP.TXT create mode 100644 DOC/TOP_V.TXT create mode 100644 ERR/ARJ.ERR create mode 100644 ERR/DWC.ERR create mode 100644 ERR/HPACK.ERR create mode 100644 ERR/HYPER.ERR create mode 100644 ERR/IOERROR.MSG create mode 100644 ERR/LHA.ERR create mode 100644 ERR/PAK.ERR create mode 100644 ERR/PKUNZIP.ERR create mode 100644 ERR/PKZIP.ERR create mode 100644 ERR/SQZ.ERR create mode 100644 ERR/ZOO.ERR create mode 100644 HELP/HELP.TXT create mode 100644 HELP/HELP_COM.PAS create mode 100644 HELP/TKVTEST.PAS create mode 100644 TKSTRING/ASM/HBBINARY.ASM create mode 100644 TKSTRING/ASM/HBBM.ASM create mode 100644 TKSTRING/ASM/HBCASE.ASM create mode 100644 TKSTRING/ASM/HBCLRSTR.ASM create mode 100644 TKSTRING/ASM/HBCOMP1.ASM create mode 100644 TKSTRING/ASM/HBCOMP2.ASM create mode 100644 TKSTRING/ASM/HBDATEST.ASM create mode 100644 TKSTRING/ASM/HBHEX.ASM create mode 100644 TKSTRING/ASM/HBLEFTP.ASM create mode 100644 TKSTRING/ASM/HBPAD.ASM create mode 100644 TKSTRING/ASM/HBSEARCH.ASM create mode 100644 TKSTRING/ASM/HBTAB.ASM create mode 100644 TKSTRING/ASM/HBTIMEST.ASM create mode 100644 TKSTRING/ASM/HBTRIM.ASM create mode 100644 TKSTRING/HBBINARY.OBJ create mode 100644 TKSTRING/HBBM.OBJ create mode 100644 TKSTRING/HBCASE.OBJ create mode 100644 TKSTRING/HBCLRSTR.OBJ create mode 100644 TKSTRING/HBCOMP1.OBJ create mode 100644 TKSTRING/HBCOMP2.OBJ create mode 100644 TKSTRING/HBDATEST.OBJ create mode 100644 TKSTRING/HBHEX.OBJ create mode 100644 TKSTRING/HBLEFTP.OBJ create mode 100644 TKSTRING/HBPAD.OBJ create mode 100644 TKSTRING/HBSEARCH.OBJ create mode 100644 TKSTRING/HBTAB.OBJ create mode 100644 TKSTRING/HBTIMEST.OBJ create mode 100644 TKSTRING/HBTRIM.OBJ create mode 100644 TKSTRING/TKSTRING.PAS create mode 100644 TOP.PAS create mode 100644 UNITS/ARCVIEW.INC create mode 100644 UNITS/EMS.PAS create mode 100644 UNITS/INIT.PAS create mode 100644 UNITS/INSTALL.PAS create mode 100644 UNITS/KBM.PAS create mode 100644 UNITS/KBMA.ASM create mode 100644 UNITS/KBMA.OBJ create mode 100644 UNITS/SWAP.PAS create mode 100644 UNITS/SWAPA.ASM create mode 100644 UNITS/SWAPA.OBJ create mode 100644 UNITS/TBAUM.PAS create mode 100644 UNITS/TCONTROL.PAS create mode 100644 UNITS/TCTRL2.PAS create mode 100644 UNITS/TDATEI.PAS create mode 100644 UNITS/TEST.PAS create mode 100644 UNITS/TKDISK.PAS create mode 100644 UNITS/TKSAA.PAS create mode 100644 UNITS/TKSTREAM.PAS create mode 100644 UNITS/TKVIDEO.PAS create mode 100644 UNITS/TKVIEW.PAS create mode 100644 UNITS/TKVIEW2.PAS create mode 100644 UNITS/TKWIN.PAS create mode 100644 UNITS/TPACKEN.PAS create mode 100644 UNITS/TPINST.PAS create mode 100644 UNITS/TURFEN.PAS diff --git a/DOC/FRAGEBOG.TXT b/DOC/FRAGEBOG.TXT new file mode 100644 index 0000000..8bb166e --- /dev/null +++ b/DOC/FRAGEBOG.TXT @@ -0,0 +1,26 @@ + FRAGEBOGEN zu TOP Version 2.1 + +Bitte beantworten Sie diese acht Fragen kritisch! + +1. Welche ungeklrten Probleme und Fragen sind bei Ihnen aufgetreten oder + sollten besser dokumentiert werden? + +2. Fanden Sie die Hilfe des Top-Programmes informativ, zu detailliert, zu dnn + oder zu kompliziert? + +3. Welche Funktionen wrden Sie sich zustzlich noch wnschen oder weglassen? + +4. Gibt es Dinge die Ihnen kritikwrdig sind (zB. Farbe, Bildschirmmaske etc.)? + +5. Welche Fehler sind Ihnen bei den Testlufen aufgefallen? + Bitte bei Beschreibung etwas detailliert. + +6. Haben Sie Grammatik-, Ausdrucks- oder Rechtschreibfehler mi Hilfetext oder + der Dokumentation gefunden? + +7. Waren Ihre Farbeinstellungen korrekt (Farbe1-Dunkelblau,Farbe2-Dunkelgrn)? + Bitte geben Sie den Typ und Hersteller Ihrer Grafikkarte an! + +8. Haben Sie sonst noch was auf dem Herzen? + +Vielen Dank fr Ihre Bemhungen! \ No newline at end of file diff --git a/DOC/INSTALL.FID b/DOC/INSTALL.FID new file mode 100644 index 0000000..0468d8f --- /dev/null +++ b/DOC/INSTALL.FID @@ -0,0 +1,29 @@ +\TOP\TOP.EXE +\TOP\TOP.HLP +\TOP\PACKER.CFG +\TOP\IOERROR.MSG +\TOP\ARJ.ERR +\TOP\DWC.ERR +\TOP\LHA.ERR +\TOP\HPACK.ERR +\TOP\HYPER.ERR +\TOP\PAK.ERR +\TOP\PKUNZIP.ERR +\TOP\PKZIP.ERR +\TOP\SQZ.ERR +\TOP\ZOO.ERR +\PACKER\ARC.EXE 2 +\PACKER\ARJ.EXE 2 +\PACKER\BSA.EXE 2 +\PACKER\DWC.EXE 2 +\PACKER\HPACK.EXE 2 +\PACKER\HYPER.EXE 2 +\PACKER\LHA.EXE 2 +\PACKER\LIMIT.EXE 2 +\PACKER\PKZIP.EXE 2 +\PACKER\PKUNZIP.EXE 2 +\PACKER\PAK.EXE 2 +\PACKER\SQZ.EXE 2 +\PACKER\ZOO.EXE 2 +\TOP_V.TXT +\FRAGEBOG.TXT \ No newline at end of file diff --git a/DOC/PACKER.DOC b/DOC/PACKER.DOC new file mode 100644 index 0000000..05f0d7b --- /dev/null +++ b/DOC/PACKER.DOC @@ -0,0 +1,580 @@ + + Zip - Format + ------------ + + 2 (4b50) Signature (an jedem Header, und Multiple Volume) + +---------------------------- + + 2 (0807) Anfang Multple Volume ohne folgende Bytes (nur zu Beginn des ersten Volume) + +---------------------------- + + 2 (0403) Normaler Header in der Datei + ? + ? + ? + ? + 1 byte 0 - stored (no compression) + 1 - Shrunk + 2 - Reduced with compression factor 1 + 3 - Reduced with compression factor 2 + 4 - Reduced with compression factor 3 + 5 - Reduced with compression factor 4 + 6 - Imploded + 7 - Token + 8 - DeflatX + ? + 4 Zeit + 4 CRC + 4 gep. Gre + 4 orig Gre + 1 Lnge des Dateinamen + ? + ? + ? + X Dateiname der angegebenen Lnge + + +---------------------------------------- + + 2 (0201) EndeHeader mit Liste aller Dateien + ? + ? + ? + ? + 1 verschlsselt + ? + 1 byte 0 - stored (no compression) + 1 - Shrunk + 2 - Reduced with compression factor 1 + 3 - Reduced with compression factor 2 + 4 - Reduced with compression factor 3 + 5 - Reduced with compression factor 4 + 6 - Imploded + 7 - Token + 8 - DeflatX + ? + 4 Zeit + 4 CRC + 4 gep. Gre + 4 orig Gre + 1 Lnge des Dateinamen + ? + ? + ? + 1 Kommentarlnge + ? + ? + ? + ? + ? + 1 Attribut + ? + ? + ? + ? + ? + ? + ? + X Dateiname der angegebenen Lnge + +============================================================ + + Arj-Format + ---------- + + Hauptheader + ----------- + 2 header id (main and local file) = 0x60 0xEA + 2 basic header size (from 'first_hdr_size' thru 'comment' below) + = first_hdr_size + strlen(filename) + 1 + strlen(comment) + 1 + = 0 if end of archive + maximum header size is 2600 + + 1 first_hdr_size (size up to and including 'extra data') + 1 archiver version number + 1 minimum archiver version to extract + 1 host OS (0 = MSDOS, 1 = PRIMOS, 2 = UNIX, 3 = AMIGA, 4 = MAC-OS) + (5 = OS/2, 6 = APPLE GS, 7 = ATARI ST, 8 = NEXT) + (9 = VAX VMS) + 1 arj flags + (0x01 = NOT USED) + (0x02 = OLD_SECURED_FLAG) + (0x04 = VOLUME_FLAG) indicates presence of succeeding + volume + (0x08 = NOT USED) + (0x10 = PATHSYM_FLAG) indicates archive name translated + ("\" changed to "/") + (0x20 = BACKUP_FLAG) indicates backup type archive + (0x40 = SECURED_FLAG) + 1 security version (2 = current) + 1 file type (must equal 2) + 1 reserved + 4 date time when original archive was created + 4 date time when archive was last modified + 4 archive size (currently used only for secured archives) + 4 security envelope file position + 2 filespec position in filename + 2 length in bytes of security envelope data + 2 (currently not used) + ? (currently none) + + ? filename of archive when created (null-terminated string) + ? archive comment (null-terminated string) + + 4 basic header CRC + + 2 1st extended header size (0 if none) + ? 1st extended header (currently not used) + 4 1st extended header's CRC (not present when 0 extended header size) + + + + + + Dateiheader: + ------------ + + 2 (EA60) Arj header + 2 Headergre ab hier + Maximum =2600 + first_hdr_size + strlen(filename) + 1 + strlen(comment) + 1 + 0 falls Ende des Archives + 1 first_hdr_size (fr Extra Daten) + 1 archiv Versionsnummer + 1 kleinste Archivversion zum enpacken + 1 OS (0 = MSDOS, 1 = PRIMOS, 2 = UNIX, 3 = AMIGA, 4 = MAC-OS) + (5 = OS/2, 6 = APPLE GS, 7 = ATARI ST, 8 = NEXT) + (9 = VAX VMS) + 1 arj flags + (0x01 = NOT USED) + (0x02 = OLD_SECURED_FLAG) + (0x04 = VOLUME_FLAG) indicates presence of succeeding + volume + (0x08 = NOT USED) + (0x10 = PATHSYM_FLAG) indicates archive name translated + ("\" changed to "/") + (0x20 = BACKUP_FLAG) indicates backup type archive + (0x40 = SECURED_FLAG) + 1 Methode (0 = stored, 1 ... 4 = compressed) + 1 file type (0 = binary, 1 = 7-bit text) + (3 = directory, 4 = volume label) in der Regel 0 + 1 reserved + 4 Zeit + 4 gep. Gre + 4 orig. Gre + 4 CRC + 2 filespec position in filename (?) + 2 file access mode (1= Attribut) + 2 host data (currently not used) + ? extra data + 4 bytes for extended file starting position when used + (these bytes are present when EXTFILE_FLAG is set). + 0 bytes otherwise. + + ? filename (null-terminated string) + ? comment (null-terminated string) (Endkennung 0A) + + 4 basic header CRC + + 2 1st extended header size (0 if none) + ? 1st extended header (currently not used) + 4 1st extended header's CRC (not present when 0 extended header size) + + ... + + ? compressed file + +=========================================================== + +Hyper-Format +------------ + +1 CtrlZ : Char; {Ctrl-Z} {1A} +2 id : Word; {'HP'=komprimiert, 'ST'=1 zu 1} +1 Version : Byte; {$26} +4 ArchiveSize, {komprimierte Gre} +4 OriginSize, {ungepackte Gre} +4 FDateTime, {Datum und Zeit} +4 ChkSum: LongInt; {Prfsumme} +1 FAttr : Byte; {Dateiattribute} +? FName: String; {Dateiname} + Data: Array[1..ArchiveSize] Of Byte; {gepackte Daten} + + +============================================================ + +Lha-Format +---------- + +1 Lnge des Kopfes +1 Unbekannt +3 -lz +1 Kompimermethode -$30 +1 - +4 gepackte Gr +4 orig. Gr +4 Zeit +1 Attribut +? +1 Lnge des Filenamen +X Filename +2 CRC +? +1 Lnge des Zusatzheader bis #05 +3 Unbekannt +X Verzeichnisname(Einzeln) bis FF +. +. +. +1 Endkennung #05 + +================================================== + +Zoo-Format +---------- + +Zoo-Header + +20 Zoo Text (ZOO 2.10 Archive..) +4 Signature (FD C4 A7 DC) +4 Start +4 Zoo_Minus { Vrification de concordance } +1 hchste Version +? +1 kleinste Version +7 Unbekannt + + +Zoo-FileHeader + +4 Signature (FD C4 A7 DC) +? +1 0 : Stored + 1 : Lzw +4 Sprung zum nchsten Header +4 Unbekannt +4 Datum (Zeit<->Datum) +? +2 CRC +4 gep. Gre +4 orig Gre +? +1 0 : nicht gelscht + 1 : gelscht +2 Unbekannt +4 Sprungadresse zum Kommentars +2 Unbekannt +1 Lnge des Verzeichnisnamen inkl. 0 +X Filename nullterminiert +1 0 +9 Unbekannt letztes Byte 0 +4 Unbekannt +1 Lnge des Verzeichnisnamen inkl. 0 +X Verzeichnisname nullterminiert +1 0 +8 alles 0 +4 Endkennung (28 23 29 40) + +Zoo-EndHeader +------------- +ist an jedem Ende der Datei vorhanden +auf diesen zeigt die Spungmarke wenn Ende erreicht + +4 Signature (FD C4 A7 DC) +? +49 alles 0 +2 Endkennung (83 FC) + + +=============================================== + +Arc,Pak-Format +-------------- +1 Signature (1A) +1 1: 'Stor1'; + 2: 'Stor2'; + 3: 'Packd'; + 4: 'Squzd'; + 5: 'Crun1'; + 6: 'Crun2'; + 7: 'Crun3'; + 8: 'Crun4'; + 9: 'Sqash'; + 10: 'Crushed'; + 11: 'Distill'; +X Filename nullterminiert +1 0 +4 Unbekannt (gep. Gre?) +3 Unbekannt +4 gep. Gre +4 Datum (Datum<->Zeit) +2 Crc +4 orig Gre (nicht vorhanden falls attr=1) + +Ende-Header +----------- +am Ende jeder Datei vorhanden +1 Signature (1A) +1 0 + +2 (02 FE) +1 Ziffer der Datei (1..X) +? +1 Lnge des Verzeichnisses (0 im Hauptverz.) +3 Unbekannt +X Verzeichnisname + +2 (00 FE) ArchivEnde + +================================================= + +Dwc-Format +---------- + +Header wird von hinten nach vorn aufgebaut + + +Anfangsheader (am abs. Ende) +------------- +1 (1B) +15 Unbekannt +4 Datum der letzten nderung +4 Anzahl der Dateien +3 (43 57 44) (DWC) + +Fileheader +---------- +13 Name nullterminiert +4 orig. Gre +4 Datum (Format unbekannt) +4 gepackte Gre +4 Adresse des Anfangs der gepackten Daten +1 Cattr 1 : Crunched + 2 : Stored +2 Unbekannt +2 CRC + + +========================================================== + +SQZ-Format +---------- + + +Archive header: + offset 0..4: Id: HLSQZ (072d 076d 083d 081d 090d) + 5: Version: 1 (049d) + 6: OS: 76543210 + xxxxx000 0 PC-DOS + xxxxx001 1 OS/2 + xxxxx010 2 MVS + xxxxx011 3 HPSF(OS/2) + xxxxx100 4 Amiga + xxxxx101 5 Macintosh + xxxxx110 6 *nix + xxxxx111 7 Future use + XXXXXxxx Future use + 7: Flag 76543210 + xxxxxxxX byte order + 0 Little Endian, Motorola order + 1 Big Endian, Intel order + xxxxxxXx Format for Data and time + 0 UNIX format. Number of seconds + since 1:st of january 1970. + 1 DOS format for Date and Time + in file: E8631E19. + Decoded: 1992/08/30 12.31.32 + MSB LSB + 19 1E 63 E8 + 76543210765432107654321076543210 + 00011001000111100110001111101000 + YYYYYYYMMMMDDDDDHHHHHMMMMMM22222 + 12 8 30 12 31 16 + +=1980 *=2 + 1992 08 30 12 31 32 + xxxxx1xx Security Envelope + No modifications allowed! + If you do any thing, you'll ruin it + xxxx1xxx Whole archive encrypted! Keep OUT + When I say whole, I mean WHOLE. + There's nothing that you can do, + just stay out of trouble. + This archive can't be used until + it's decrypted. + xxx1xxxx Unified data + XXXxxxxx Future use + + +------------------------------------------------------------------------------- +File header: + + offset Size Comment + 0 1 Header size and type (+3) + 0 -> End of archive + 1..18 Se below (Extra data) + 19.. -> normal file header + if normal file + 1 1 Header algebraic sum & 0FFh + 0 1:76543210 + xxxxXXXX Method 0..4(15) + XXXXxxxx Future use + 1 4 Compressed size + 5 4 Original size + 9 4 Last DateTime + 13 1 Attributes + 14 4 CRC + 18.. (size-18) filename, w/o \0. +_________________________________________________________ +Extra data + + 00d END_OF_ARC: Well, what's there to say? + + 01d COMMENT: Created by SQZ 1.08.2 + 0 2 Number of bytes in comment + Uncompressed size = this field - 7 + 2 2 Number of bytes compressed + 4 1:76543210 + xxxxXXXX Method 0..4(15) + XXXXxxxx Future use + 5 4 CRC + 9 size-7 Comment + + + 02d PASSWORD: + 0 2 n + 2 1 76543210 + xxxxxxx1 Public + xxxxxx1x Not public + xxxxx1xx Signature included + XXXXXxxx Future use + 3 n-1 + ************************************************************** + I'm not done thinking about this one yet, so I'll be in touch. + I've been thinking and... see ya l'ter + ************************************************************** + + 03d POSTFIX: This code are among the last one in the archive (<256) + 0 2 5 + 2 5 HLSQZ + Postfix are automatically added when closing a modified + archive, but, who knows, it might change in the future + so please check the last 256 bytes, just not the last + nine ones, 'cause who knows, someone might have been + using XModem... + + 04d SECURITY ENVELOPE: + 0 2 n + 2 2 SE version (major.minor.test.mask)0010 + 76543210 + testmask + majomino + 2 2 SE revision. + 6 n-2 None of your business + + 05d VOLUME LABEL + 0 2 Number of bytes + 2 4 Time for creation of volume + 6 1 Attribute, bit 3 always set (if DOS) + 7 4 Serial number, if available, otherwise 00000000h + 11 n Label + Number of bytes - 9 -> length of label. + + 06d DIRECTORY + 0 2 Number of bytes + 2 1 Algebraic sum & 0xFF + 3 4 Time for creation of directory + 7 1 Attribute + 8 n Path + Number of bytes - 6 --> length of path + + 07d COMMENT: Created by SQZ 1.08.3 and later + 0 2 Number of bytes in field + Compressed size = this field - 7 + 2 2 Number of uncompressed bytes + 4 1:76543210 + xxxxXXXX Method 0..4(15) + XXXXxxxx Future use + 5 4 CRC + 9 size-7 Comment + + ??d OTHERWISE: + 0 2 Number of bytes to skip + + +========================================================== + + +Limit-Format +------------ + +Archiv-Header +---------- + +3 (1A 4D 4C) (LM ) +1 Lnge ab Anfang bis zum nchsten Header +1 Unbekannt 0 +1 grte Version +1 kleinste Version +1 Unbekannt 0 + + +Verzeichnis-Header +------------------ +alle Dateien welche nach diesem Header kommen sind fr diesen gltig! +Dateien werden zwischengeschoben + +2 (D1 80) Signature +1 Lnge ab Anf. bis nchster Header +1 0 +X Verzeichnisname nullterminiert +1 0 + +File-Header (auch fr Verzeichnisse) +----------- +2 (F1 23) Signature +1 Lnge ab Anfang bis zum nchsten Header +1 0 +1 OS 0 : DOS + 2 : VMS + . + . +1 0 +4 Datum +1 Fileattr. (Directory =10) +2 0 +4 orig.Gre +4 gepackte Gre +4 CRC +X Filename (nullterminiert) +1 0 + +Endkennung +---------- +3 (F8 13) Signature +2 Lnge der Endkennung (5) +X 0 + + +=============================================================== + +Bsa-format +---------- + +6 Anfangssignature (00 00 47 53 42 FF) (BSG) + + +File-Header +----------- +4 Anfangssignature (41 53 42 FF) +1 0 +1 Lnge bis Ende (+10) +1 Unbekannt (Flags) +3 0 +4 Datum +X Name +4 orig Gre +4 gep.Gre +4 FileCRC +4 KopfCrc \ No newline at end of file diff --git a/DOC/TOP.TXT b/DOC/TOP.TXT new file mode 100644 index 0000000..beb514e --- /dev/null +++ b/DOC/TOP.TXT @@ -0,0 +1,306 @@ +TOP - Toms Oberflche fr Packprogramme - Version 2.1 +Copyright(c) 1992-94, Thomas Knfel + + + 1. ..................EINFHRUNG + 2. ...........LIZENSBEDINGUNGEN + 3. ...........LEISTUNGSMERKMALE + 4. ...TECHNISCHE VORRAUSSETZUNG + 5. ................LIEFERUMFANG + 6. ................INSTALLATION + 7. .............SCHNELLEINSTIEG + 8. .........FRAGEN UND PROBLEME + 9. .....................SUPPORT + 10. ..................DANKSAGUNG + + + +1. EINFHRUNG + + Sehr geehrte Damen und Herren, + +endlich haben Sie ein Programm mit dem Sie unkompliziert Backups durchfhren +knnen. Der Wust an Packprogrammen scheint unermelich zu sein, von denen +die meisten keine Benutzeroberflche besitzen. Die einzige Alternative war +bisher das Schreiben von unkomfortablen Batchdateien. Mit diesem komfortablen +Archivmanager sind Sie in der Lage Ihre Packprogramme unter einer +einheitlichen Benutzeroberflche zu nutzen. + +Bei der Programmierung und Entwicklung dieses Programmes habe ich versucht, +den umfangreichen Befehlsumfang der Packprogramme mglichst detailiert zu +bercksichtigen. + +Anregungen und Hinweise die zur Verbesserung des Programmes fhren nehme ich +gerne entgegen. Wenden Sie sich bitte an meinen Distributor. (Adresse siehe +unten) + + + + +2. LIZENSBEDINGUNG + +DIESE VOLLVERSION DARF NICHT AN DRITTE WEITERGEGEBEN WERDEN! +Der Lizensnehmer darf zum Zwecke der Datensicherheit beliebig viele Kopien +der Software herstellen, solange gewhrleistet ist, da das Programm zu jedem +Zeitpunkt garantiert nur auf einem Einzelplatz-Rechner lauffhig ist. +Fr Softwareverlust oder Hardwareschden die sich aus der Benutzung +der Top-Software ergeben wird keine Garantie bernommen. + + + + +3. LEISTUNGSMERKALE + - Eine bersichtliche Maus- und Funktionstastenbedienbare Benut- + zeroberflche. + - Es werden keine Kenntnisse ber die Packer selbst bentigt, da + automatisch erkannt wird welcher Packer mit welchen Optionen zum + Packen, Entpacken oder Ansehen eines Archives bentigt wird. + - Das Bestimmen der Kompressionsrate ist mglich. + - Funktion zum Packen und Entpacken ber mehrere Disketten vorhanden. + - Es knnen bis zu 99 eigene Packer eingebunden werden, wobei 12 + bereits vorkonfiguriert sind. + - Direktes Konfigurieren der Packer aus der Benutzeroberflche + ist mglich. + - Fehlermeldungen der Packer knnen selbst bestimmt werden. + - Erstellen von Scripten, um regelmige Pack- und Entpackvorgnge zu + automatisieren ist mglich. + - Verzeichnisse anlegen sowie lschen von Dateien und Verzeichnissen + - Markieren von Dateien ber mehrere Verzeichnisse und Laufwerke + gleichzeitig mglich. + - Integrierter Archivbetrachter fr ber 13 Archivformate. + - Archive knnen wie ein normales Verzeichnis eingelesen werden und + einzelne Dateien und Verzeichnisse daraus gelscht, kopiert oder + entpackt werden. + - Einfaches Bestimmen des Zielpfades zum Packen oder Entpacken. + - Fr anfallende temporre Dateien kann ein Laufwerk bzw. Verzeichnis + (z.B. eine schnelle RAM-Disk) vorgegeben werden. + - Es knnen unsichtbare-, schreibgeschtzte- und Systemdateien + archiviert werden. + - Eine komfortable Online-Hilfe. + + + + +4. TECHNISCHE VORRAUSSETZUNG + +Zur fehlerfreien Benutzung des TOP-Programmes bentigen Sie: + +-Hardware + einen 286 AT, eine Festplatte, eine EGA oder VGA Grafikkarte, + mindestens 640Kb besser 1,5Mb Arbeitsspeicher + +-Software + eine MS-DOS Version ab 3.3, nach Mglichkeit 550K EMS-Speicher + + + + +5. LIEFERUMFANG + +Zum Lieferumfang gehren: + INSTALL EXE - Installationsprogramm + TOP EXE - Hauptrogramm + TOP HLP - Hilfedatei + IOERROR MSG - Fehlerdatei + PACKER CFG - Konfigurationsdatei der Packerparameter + ARJ ERR - Fehlerdatei fr arj.exe + DWC ERR - Fehlerdatei fr dwc.exe + PKZIP ERR - Fehlerdatei fr pkzip.exe + PKUNZIP ERR - Fehlerdatei fr pkunzip.exe + HAPCK ERR - Fehlerdatei fr hpack.exe + HYPER ERR - Fehlerdatei fr hyper.exe + LHA ERR - Fehlerdatei fr lha.exe + PAK ERR - Fehlerdatei fr pak.exe + SQZ ERR - Fehlerdatei fr sqz.exe + ZOO ERR - Fehlerdatei fr zoo.exe + TOP_V TXT - Zusatzinformationen + +Packprogramme sind nicht im Lieferumfang enthalten. Alle in TOP angegebenen +Packer sind Sharewareprogramme und knnen kostenfrei getauscht werden, soweit +sie nicht kommerziell genutzt werden. + + + + + +6. INSTALLATION + +Schlieen Sie zuerst den Schreibschutz der Installationsdiskette! + +Sollte das Programm noch nicht vorinstalliert sein oder bereits von Ihnen +installiert worden sein, werden Sie zu Beginn aufgefordert Ihren Namen +Ihre Adresse sowie die auf dem Diskettenlabel stehende Lizensnummer einzugeben. + +Anschlieend mssen das Zielverzeichnis und das Packerverzeichnis bestimmt +werden. Das Zielverzeichnis bestimmt das Verzeichnis, in welches das +Hauptprogramm installiert wird. Im Packer-Verzeichnis sind alle Packprogramme +die von TOP aufgerufen werden. + +Als nchster Schritt werden die TOP-Dateien in das Zielverzeichnis kopiert. +Sie knnen nach erfolgreicher Beendigung durch Eingabe von TOP das Programm +starten. + + + + + +7. SCHNELLEINSTIEG + +Das Programm ist in zwei Fensterhlften aufgebaut. Im linken Fenster werden +alle Dateien die sich auf Ihrem Laufwerk befinden angezeigt und im rechten +Fenster nur alle komprimierten Archivdateien. Zu Beginn sehen Sie nur die +Verzeichnisbume der entsprechenden Laufwerke. +Die Dateien in den Verzeichnissen knnen Sie sich anzeigen lassen indem Sie +ENTER eingeben, und wieder schlieen indem Sie an den Anfang der Dateiliste +gehen und ENTER eingeben. + +F5 Komprimieren + Wollen Sie ein Verzeichnis komprimieren so bewegen Sie den Balkencursor in + der linken Fensterhlfte auf dieses und drcken die Funktionstaste F5. + Es ffnet sich ein Fenster in welchem Sie verschiedene Einstellungen + vornehmen knnen wie zum Beispiel den Packer fr Ihre Komprimierung + auswhlen und den Namen des zu erzeugenden Archives bestimmen. Whlen Sie + die Einstellung 'inklusive Unterverzeichnisse' ab. Um die Komprimierung + auszufhren geben Sie ENTER ein. Falls der Interaktive Modus eingeschaltet + ist blendet sich die Oberflche aus und Sie knnen die Arbeit des Packers + verfolgen. Anschlieend ist die TOP Oberflche wieder sichtbar. Bewegen + Sie sich mit der TAB-Taste in das rechte Fenster und geben Sie ENTER ein um + das Verzeichnis zu ffnen. Dort befindet sich das von Ihnen erzeugte Archiv. + +F5 Dekomprimieren + Um das eben erzeugte Archiv wieder zu dekomprimieren wechseln Sie mit TAB + in die linke Fensterhlfte und bewegen Sie den Cursor auf das Verzeichnis + in welches die entpackten Dateien geschrieben werden sollen. Stellen Sie + sich nun wieder auf das Archiv in der rechten Fensterhlfte und geben Sie + F5 ein. Es ffnet sich ein Fenster zum Dekomprimieren. Nachdem Sie Enter + eingegeben haben wird der Dekomprimiervorgang gestartet und alle entpackten + Dateien befinden sich im Verzeichnis auf der linken Seite. + +F1 Hilfe + Mit F1 knnen Sie sich zu jedem geffneten Fenster eine umfangreiche + Erluterung geben lassen. + +F2 Optionen + In der Option F2 knnen Sie bestimmen welche Dateien angezeigt und nach + welchem Kriterium diese sortiert werden sollen. Desweiteren ist es Ihnen + mglich zwischen verschiedenen Farbeinstellungen zu whlen. + Unter 'Weitere Optionen' finden Sie die Einstellungen: + Backup/Restore Erkennung + - Dieser Mechanismus wird unmittelbar nach dem Programmstart ausgefhrt. + Starten Sie TOP aus einem leeren Verzeichnis so steht der Balkencursor + zu Beginn im rechten Fenster. + Starten Sie TOP im vollen Verzeichnis so steht der Balkencursor in der + linken Fensterseite. + Interaktiver Modus + - Sie knnen die Arbeit des Packers direkt verfolgen. + Sofort Ende + - Beendet das Programm unmittelbar nach dem Packen oder Entpacken + Verify + - berprft ob die Dateien korrekt auf den Datentrger geschrieben wurden. + Das Packer Verzeichnis bestimmt das Verzeichnis in welchem sich die Packer + fr die TOP-Oberflche befinden. In das Temporre Verzeichnis werden vom + Programm Dateien zwischengelagert, die fr den Benutzer nicht von Bedeutung + sind. + +F3 Script + Die Funktion F3 dient zum Erstellen von Scriptdateien mit deren Hilfe man + regelmig einfach Backups durchfhren kann. In der Scriptdatei werden die + Dateien und Verzeichnisse beschrieben die Sie regelmig packen oder + entpacken mchten. Nachdem Sie die Datei mit OK aktiviert haben werden alle + beschriebenen Dateien angewhlt. Mit F5 knnen Sie diese nun packen oder + entpacken. + +F4 DatInfo + Die Option F4 gibt Ihnen zu den Dateien im Dateilisting oder im Archiv + verschiedene Informationen an. Diese Funktion ist nur in einer geffneten + Dateiliste anwhlbar. + +F7 Verzeichnis + Mit F7 knnen Sie neue Verzeichnisse erstellen. + +F8 Lschen + F8 gibt Ihnen die Mglichkeit Dateien, Verzeichnisse und Unterverzeichnisse + zu lschen. + +F9 Parameter + In der Option F9 werden alle Parameter der Packprogramme gespeichert. Diese + Einstellungen sollten nur verndert werden wenn Sie bereits mit dem Umgang + von Packprogrammen vertraut sind. + +ALT-X Ende + Die Tastenkombination ALT-X beendet das Programm. + + + + +8. FRAGEN UND PROBLEME + +Warum ffnet sich zu Beginn immer das Hilfefenster? +-Fhren Sie erneut eine Installation nach den unter INSTALLATION angegebenen + Anweisungen aus. + +Warum beendet das Programm zu Beginn mit der Meldung +'Zu wenig Speicher fr das Programm!'? +-berprfen Sie Ihre Speicherkonfiguration und stellen Sie dem Programm + mindestens 550K Hauptspeicher zur Verfgung. + +Warum bleibt das Programm 'hngen' sobald das Verzeichnis eingelesen wird? +-berprfen Sie Ihre Treiberkonfiguration und entfernen Sie testweise + einzelne Treiber bis die Ursache gefunden wurde. + +Warum wird keine Archivdatei erzeugt oder entpackt? +- berprfen Sie die Parameter unter F9 und Schalten Sie unter F2-Optionen + das Programm in den interaktiven Modus. Sollte dies nicht zum Erfolg fhren + testen Sie das Packprogramm auf der DOS-Oberflche. + +Warum wird kein Pack- oder Entpackvorgang gestartet obwohl +das Packerverzeichnis und die Parameter richtig konfiguriert wurden? +-Sie mssen mehr Speicher zu Verfgung stellen, da das Packprogramm sofort zu + Startbeginn terminiert. Das TOP-Programm belegt nach Aufruf eines externen + Packprogrammes nur 1K im Speicher. + +Warum werden mir Fehlermeldungen in Zahlen angegeben? +-berprfen Sie ob die Datei ioerror.msg im Top-Verzeichnis vorhanden ist. + Sollte dies whrend des Aufrufes eines Pack- oder Entpackvorganges erfolgen, + so berprfen Sie das Vorhandensein der Fehlerdatei mit dem Namen des + Packers oder Entpackers im TOP-Verzeichnis und berprfen Sie den Inhalt mit + einem DOS-Editor auf das Vorhandensein der Fehlerbeschreibung. Sie knnen + diese bei nicht vorhanden sein selbst ergnzen. + +Warum wird trotz erfolgreichem Packvorgang keine Archivdatei im rechten Fenster +angezeigt? +-berprfen sie die Archivendung unter F9 Parameter. + +Warum wird der freie Platz auf der Festplatte nicht auf beiden Fensterseiten +gleich angezeigt? +-Eine geringe Abweichung ist mglich, wenn Sie Ihr temporres Verzeichnis auf + dieser Festplatte eingerichtet haben, da TOP whrend seiner Arbeit stetig + temporre Daten auslagert. Um Abhilfe zu schaffen verlegen Sie das temporre + Verzeichnis auf ein anderes Laufwerk oder lesen Sie das Laufwerk mit Strg-R + neu ein! + + + + +9. SUPPORT + +Bei ungelsten Fragen und Problemen richten Sie sich bitte an: + + Multimedia-Service + Burkhard Pabst + Max-Josef-Metzger-Str. 25 + 14772 Brandenburg + Tel./Fax (03381) 761598 + + + +10. DANKSAGUNG + +Mein besonderer Dank gilt Heiko Becker der wertvolle Hinweise und Programmteile +beisteuerte. Desweiteren mchte ich mich bei meinen Crashtestern Andreas Drewke +und Sven Ertelt fr ihre intensive 'BUG'suche bedanken und bei all denjenigen +die mich bei meiner Arbeit untersttzt haben. + + + + ------- Ende ------- \ No newline at end of file diff --git a/DOC/TOP_V.TXT b/DOC/TOP_V.TXT new file mode 100644 index 0000000..88d059b --- /dev/null +++ b/DOC/TOP_V.TXT @@ -0,0 +1,304 @@ +TOP - Toms Oberflche fr Packprogramme - Version 2.1 +Copyright(c) 1992-94, Thomas Knfel + + + 1. EINFHRUNG + 2. LIZENSBEDINGUNGEN + 3. LEISTUNGSMERKMALE + 4. TECHNISCHE VORRAUSSETZUNG + 5. LIEFERUMFANG + 6. INSTALLATION + 7. SCHNELLEINSTIEG + 8. FRAGEN UND PROBLEME + 9. SUPPORT +10. DANKSAGUNG + + + +1. EINFHRUNG + + Sehr geehrte Damen und Herren, + +endlich haben Sie ein Programm mit dem Sie unkompliziert Backups durchfhren +knnen. Der Wust an Packprogrammen scheint unermelich zu sein, von denen +die meisten keine Benutzeroberflche besitzen. Die einzige Alternative war +bisher das Schreiben von unkomfortablen Batchdateien. Mit diesem komfortablen +Archivmanager sind Sie in der Lage Ihre Packprogramme unter einer einheitlichen +Benutzeroberflche zu nutzen. + +Bei der Programmierung und Entwicklung dieses Programmes habe ich versucht, +den umfangreichen Befehlsumfang der Packprogramme mglichst detailiert zu +bercksichtigen. + +Anregungen und Hinweise die zur Verbesserung des Programmes fhren nehme ich +gerne entgegen. Wenden Sie sich bitte an meinen Distributor. (Adresse siehe +unten) + + + + +2. LIZENSBEDINGUNG + +DIESE VOLLVERSION DARF NICHT AN DRITTE WEITERGEGEBEN WERDEN! +Der Lizensnehmer darf zum Zwecke der Datensicherheit beliebig viele +Kopien der Software herstellen, solange gewhrleistet ist, da das +Programm zu jedem Zeitpunkt garantiert nur auf einem Einzelplatz-Rechner +lauffhig ist. Fr Softwareverlust oder Hardwareschden die sich aus der +Benutzung der Top-Software ergeben wird keine Garantie bernommen. + + + + +3. LEISTUNGSMERKALE + - Eine bersichtliche Maus- und Funktionstastenbedienbare Benut- + zeroberflche. + - Es werden keine Kenntnisse ber die Packer selbst bentigt, da + automatisch erkannt wird welcher Packer mit welchen Optionen zum + Packen, Entpacken oder Ansehen eines Archives bentigt wird. + - Das Bestimmen der Kompressionsrate ist mglich. + - Funktion zum Packen und Entpacken ber mehrere Disketten vorhanden. + - Es knnen bis zu 99 eigene Packer eingebunden werden, wobei 12 bereits + vorkonfiguriert sind. + - Direktes Konfigurieren der Packer aus der Benutzeroberflche + ist mglich. + - Fehlermeldungen der Packer knnen selbst bestimmt werden. + - Erstellen von Scripten, um regelmige Pack- und Entpackvorgnge zu + automatisieren ist mglich. + - Verzeichnisse anlegen sowie lschen von Dateien und Verzeichnissen + - Markieren von Dateien ber mehrere Verzeichnisse und Laufwerke + gleichzeitig mglich. + - Integrierter Archivbetrachter fr ber 13 Archivformate. + - Archive knnen wie ein normales Verzeichnis eingelesen werden und + einzelne Dateien und Verzeichnisse daraus gelscht, kopiert oder + entpackt werden. + - Einfaches Bestimmen des Zielpfades zum Packen oder Entpacken. + - Fr anfallende temporre Dateien kann ein Laufwerk bzw. Verzeichnis + (z.B. eine schnelle RAM-Disk) vorgegeben werden. + - Es knnen unsichtbare-, schreibgeschtzte- und Systemdateien + archiviert werden. + - Eine komfortable Online-Hilfe. + + + + +4. TECHNISCHE VORRAUSSETZUNG + +Zur fehlerfreien Benutzung des TOP-Programmes bentigen Sie: + +-Hardware + einen 286 AT, eine Festplatte, eine EGA oder VGA Grafikkarte, + mindestens 640Kb besser 1,5Mb Arbeitsspeicher + +-Software + eine MS-DOS Version ab 3.3, nach Mglichkeit 550K EMS-Speicher + + + + +5. LIEFERUMFANG + +Zum Lieferumfang gehren: + INSTALL EXE - Installationsprogramm + TOP EXE - Hauptrogramm + TOP HLP - Hilfedatei + IOERROR MSG - Fehlerdatei + PACKER CFG - Konfigurationsdatei der Packerparameter + ARJ ERR - Fehlerdatei fr arj.exe + DWC ERR - Fehlerdatei fr dwc.exe + PKZIP ERR - Fehlerdatei fr pkzip.exe + PKUNZIP ERR - Fehlerdatei fr pkunzip.exe + HAPCK ERR - Fehlerdatei fr hpack.exe + HYPER ERR - Fehlerdatei fr hyper.exe + LHA ERR - Fehlerdatei fr lha.exe + PAK ERR - Fehlerdatei fr pak.exe + SQZ ERR - Fehlerdatei fr sqz.exe + ZOO ERR - Fehlerdatei fr zoo.exe + TOP_V TXT - Zusatzinformationen + +Packprogramme sind nicht im Lieferumfang enthalten. Alle in TOP angegebenen +Packer sind Sharewareprogramme und knnen kostenfrei getauscht werden, soweit +sie nicht kommerziell genutzt werden. + + + + + +6. INSTALLATION + +Schlieen Sie zuerst den Schreibschutz der Installationsdiskette! + +Sollte das Programm noch nicht vorinstalliert sein oder bereits von Ihnen +installiert worden sein, werden Sie zu Beginn aufgefordert Ihren Namen +Ihre Adresse sowie die auf dem Diskettenlabel stehende Lizensnummer einzugeben. + +Anschlieend mssen das Zielverzeichnis und das Packerverzeichnis +bestimmt werden. Das Zielverzeichnis bestimmt das Verzeichnis, in welches +das Hauptprogramm installiert wird. Im Packer-Verzeichnis sind alle +Packprogramme die von TOP aufgerufen werden. + +Als nchster Schritt werden die TOP-Dateien in das Zielverzeichnis kopiert. +Sie knnen nach erfolgreicher Beendigung durch Eingabe von TOP das Programm +starten. + + + + + +7. SCHNELLEINSTIEG + +Das Programm ist in zwei Fensterhlften aufgebaut. Im linken Fenster werden +alle Dateien die sich auf Ihrem Laufwerk befinden angezeigt und im rechten +Fenster nur alle komprimierten Archivdateien. Zu Beginn sehen Sie nur die +Verzeichnisbume der entsprechenden Laufwerke. +Die Dateien in den Verzeichnissen knnen Sie sich anzeigen lassen indem +Sie ENTER eingeben, und wieder schlieen indem Sie an den Anfang der Dateiliste +gehen und ENTER eingeben. + +F5 Komprimieren + Wollen Sie ein Verzeichnis komprimieren so bewegen Sie den Balkencursor in + der linken Fnsterhlfte auf dieses und drcken die Funktionstaste F5. + Es ffnet sich ein Fenster in welchem Sie verschiedene Einstellungen + vornehmen knnen wie zum Beispiel den Packer fr Ihre Komprimierung + auswhlen und den Namen des zu erzeugenden Archives bestimmen. Whlen Sie + die Einstellung 'inklusive Unterverzeichnisse' ab. Um die Komprimierung + auszufhren geben Sie ENTER ein. Falls der Interaktive Modus eingeschaltet + ist blendet sich die Oberflche aus und Sie knnen die Arbeit des Packers + verfolgen. Anschlieend ist die TOP Oberflche wieder sichtbar. Bewegen + Sie sich mit der TAB-Taste in das rechte Fenster und geben Sie ENTER ein um + das Verzeichnis zu ffnen. Dort befindet sich das von Ihnen erzeugte Archiv. + +F5 Dekomprimieren + Um das eben erzeugte Archiv wieder zu dekomprimieren wechseln Sie mit TAB + in die linke Fensterhlfte und bewegen Sie den Cursor auf das Verzeichnis in + welches die entpackten Dateien geschrieben werden sollen. Stellen Sie sich nun + wieder auf das Archiv in der rechten Fensterhlfte und geben Sie F5 ein. + Es ffnet sich ein Fenster zum Dekomprimieren. Nachdem Sie Enter eingegeben + haben wird der Dekomprimiervorgang gestartet und alle entpackten Dateien + befinden sich im Verzeichnis auf der linken Seite. + +F1 Hilfe + Mit F1 knnen Sie sich zu jedem geffneten Fenster eine umfangreiche + Erluterung geben lassen. + +F2 Optionen + In der Option F2 knnen Sie bestimmen welche Dateien angezeigt und nach + welchem Kriterium diese sortiert werden sollen. Desweiteren ist es Ihnen + mglich zwischen verschiedenen Farbeinstellungen zu whlen. + Unter 'Weitere Optionen' finden Sie die Einstellungen: + Backup/Restore Erkennung + - Dieser Mechanismus wird unmittelbar nach dem Programmstart ausgefhrt. + Starten Sie TOP aus einem leeren Verzeichnis so steht der Balkencursor + zu Beginn im rechten Fenster. + Starten Sie TOP im vollen Verzeichnis so steht der Balkencursor in der + linken Fensterseite. + Interaktiver Modus + - Sie knnen die Arbeit des Packers direkt verfolgen. + Sofort Ende + - Beendet das Programm unmittelbar nach dem Packen oder Entpacken + Verify + - berprft ob die Dateien korrekt auf den Datentrger geschrieben wurden. + Das Packer Verzeichnis bestimmt das Verzeichnis in welchem sich die Packer fr + die TOP-Oberflche befinden. In das Temporre Verzeichnis werden vom Programm + Dateien zwischengelagert, die fr den Benutzer nicht von Bedeutung sind. + +F3 Script + Die Funktion F3 dient zum Erstellen von Scriptdateien mit deren Hilfe man + regelmig einfach Backups durchfhren kann. In der Scriptdatei werden die + Dateien und Verzeichnisse beschrieben die Sie regelmig packen oder entpacken + mchten. Nachdem Sie die Datei mit OK aktiviert haben werden alle beschriebenen + Dateien angewhlt. Mit F5 knnen Sie diese nun packen oder entpacken. + +F4 DatInfo + Die Option F4 gibt Ihnen zu den Dateien im Dateilisting oder im Archiv + verschiedene Informationen an. Diese Funktion ist nur in einer geffneten + Dateiliste anwhlbar. + +F7 Verzeichnis + Mit F7 knnen Sie neue Verzeichnisse erstellen. + +F8 Lschen + F8 gibt Ihnen die Mglichkeit Dateien, Verzeichnisse und Unterverzeichnisse zu + lschen. + +F9 Parameter + In der Option F9 werden alle Parameter der Packprogramme gespeichert. Diese + Einstellungen sollten nur verndert werden wenn Sie bereits mit dem Umgang von + Packprogrammen vertraut sind. + +ALT-X Ende + Die Tastenkombination ALT-X beendet das Programm. + + + + +8. FRAGEN UND PROBLEME + +Warum ffnet sich zu Beginn immer das Hilfefenster? +-Fhren Sie erneut eine Installation nach den unter INSTALLATION angegebenen + Anweisungen aus. + +Warum beendet das Programm zu Beginn mit der Meldung +'Zu wenig Speicher fr das Programm!'? +-berprfen Sie Ihre Speicherkonfiguration und stellen Sie dem Programm + mindestens 550K Hauptspeicher zur Verfgung. + +Warum bleibt das Programm 'hngen' sobald das Verzeichnis eingelesen wird? +-berprfen Sie Ihre Treiberkonfiguration und entfernen Sie testweise einzelne + Treiber bis die Ursache gefunden wurde. + +Warum wird keine Archivdatei erzeugt oder entpackt? +- berprfen Sie die Parameter unter F9 und Schalten Sie unter F2-Optionen + das Programm in den interaktiven Modus. Sollte dies nicht zum Erfolg fhren + testen Sie das Packprogramm auf der DOS-Oberflche. + +Warum wird kein Pack- oder Entpackvorgang gestartet obwohl +das Packerverzeichnis und die Parameter richtig konfiguriert wurden? +-Sie mssen mehr Speicher zu Verfgung stellen, da das Packprogramm sofort zu + Startbeginn terminiert. Das TOP-Programm belegt nach Aufruf eines externen + Packprogrammes nur 1K im Speicher. + +Warum werden mir Fehlermeldungen in Zahlen angegeben? +-berprfen Sie ob die Datei ioerror.msg im Top-Verzeichnis vorhanden ist. + Sollte dies whrend des Aufrufes eines Pack- oder Entpackvorganges erfolgen, + so berprfen Sie das Vorhandensein der Fehlerdatei mit dem Namen des + Packers oder Entpackers im TOP-Verzeichnis und berprfen Sie den Inhalt mit + einem DOS-Editor auf das Vorhandensein der Fehlerbeschreibung. Sie knnen + diese bei nicht vorhanden sein selbst ergnzen. + +Warum wird trotz erfolgreichem Packvorgang keine Archivdatei im rechten Fenster +angezeigt? +-berprfen sie die Archivendung unter F9 Parameter. + +Warum wird der freie Platz auf der Festplatte nicht auf beiden Fensterseiten +gleich angezeigt? +-Eine geringe Abweichung ist mglich, wenn Sie Ihr temporres Verzeichnis auf + dieser Festplatte eingerichtet haben, da TOP whrend seiner Arbeit stetig + temporre Daten auslagert. Um Abhilfe zu schaffen verlegen Sie das + temporre Verzeichnis auf ein anderes Laufwerk oder lesen Sie das Laufwerk + mit Strg-R neu ein! + + + + +9. SUPPORT + +Bei ungelsten Fragen und Problemen richten Sie sich bitte an: + + Multimedia-Service + Burkhard Pabst + Max-Josef-Metzger-Str. 25 + 14772 Brandenburg + + + + +10. DANKSAGUNG + +Mein besonderer Dank gilt Heiko Becker der wertvolle Hinweise und Programmteile +beisteuerte. Desweiteren mchte ich mich bei meinen Crashtestern Andreas Drewke +und Sven Ertelt fr ihre intensive 'BUG'suche bedanken und bei all denjenigen +die mich bei meiner Arbeit untersttzt haben. + + + + ------- Ende ------- \ No newline at end of file diff --git a/ERR/ARJ.ERR b/ERR/ARJ.ERR new file mode 100644 index 0000000..3e272fc --- /dev/null +++ b/ERR/ARJ.ERR @@ -0,0 +1,10 @@ + 1 : Datei ist nicht auffindbar! + 2 : Fataler Fehler + 3 : CRC-Fehler (im Kommentar oder in der Datei selbst)! + 4 : ARJ-Sicherheitsfehler! + 5 : Diskette/Platte voll oder Schreibfehler! + 6 : ffnen des Archives oder der Datei nicht mglich! + 7 : Bedienungsfehler durch falsche Parameter! + 8 : Nicht gengend Hauptspeicher vorhanden! + 9 : Diese Datei ist kein ARJ Archiv! + 255 : Anwender brach mit Strg-C oder Strg-Pause ab! diff --git a/ERR/DWC.ERR b/ERR/DWC.ERR new file mode 100644 index 0000000..1f209c4 --- /dev/null +++ b/ERR/DWC.ERR @@ -0,0 +1,42 @@ + 1 : Anwender brach mit Strg-C oder Strg-Pause ab! + 2 : Mehrfache Fehler! + 3 : Mehrfache Warnungen! + 10 : Falscher Parameter in der Befehlszeile! + 11 : Kein Befehl angegeben! + 12 : Zu viele Befehle angegeben! + 13 : Passwort erwartet die Option 'g'! + 14 : Fehlende Archivzeile in der Befehlszeile! + 20 : Zu wenig Speicher! + 21 : Zu lschende Dateien wurden nicht angegeben! + 22 : Keine Header-Datei angegeben! + 23 : Kann den NULL Ausgabekanal nicht ffnen! + 24 : Kann Archivdatei nicht zum Schreiben ffnen! + 25 : Zu wenig Speicher auf Laufwerk! + 40 : Archivdatei nicht gefunden! + 41 : Kann temporre Datei nicht anlegen! + 42 : Unerwartetes Ende beim Lesen der Datei! + 43 : Datei ist beschdigt, CRC-Fehler! + 43 : Datei ist beschdigt, Stackberlauf! + 43 : Datei ist beschdigt, Gre falsch! + 44 : Datei ist kein DWC-Archiv oder ist beschdigt! + 45 : Verzeichnis der Archivdatei ist beschdigt! + 46 : Kann keine temporre DWC-Datei anlegen! + 47 : Archiv ist zu sehr beschdigt! + 48 : Kann Datei nicht anlegen! + 49 : Platte/Diskette ist voll! + 50 : Platte/Diskette ist voll! + 51 : Laufwerk existiert nicht! + 52 : Kann Archive nicht anlegen! + 60 : Datei ist bereits vorhanden! + 61 : Datei nicht gefunden! + 62 : Kann temporre Datei nicht ffnen! + 63 : Kann Datei nicht ffnen! + 64 : Datei wurde mit einem Passwort archiviert! + 65 : Entpacken einer Datei auf sich selbst nicht erlaubt! + 66 : Unbekannte Komprimierung (falsche Version)! + 67 : Header-Datei nicht im Archiv gefunden! + 68 : Mehr als eine Archivdatei in der Dateiliste! + 69 : Angegebene Datei nicht im Archiv gefunden! + 70 : Zu wenig Verzeichnisse im Archiv gefunden! + 71 : Verzeichniseintrag beschdigt! + 72 : Unerwartetes Ende! \ No newline at end of file diff --git a/ERR/HPACK.ERR b/ERR/HPACK.ERR new file mode 100644 index 0000000..1e351ac --- /dev/null +++ b/ERR/HPACK.ERR @@ -0,0 +1,26 @@ + 1 : Interner Fehler! + 2 : Zu wenig Hauptspeicher! + 3 : Zu wenig Platz auf der Diskette od. Festplatte! + 4 : Kann Archivdatei nicht ffnen! + 5 : Kann Scrptdatei nicht ffnen! + 6 : Kann Verzeichnis nicht finden! + 7 : Kann nicht in das Haupverzeichnis wechseln! + 8 : Kann Verzeichnis nicht anlegen! + 9 : Anwender brach mit Strg-Pause oder Strg-C ab! + 10 : Unbekannter Dateifehler! + 11 : Archiv-Verzeichnis ist beschdigt! + 100 : Verzeichnis ist zu lang! + 101 : Falsche Verzeichnisbezeichnung! + 102 : Verzeichnisse sind zu tief verschachtelt! + 103 : Fehler in Scriptdatei! + 104 : Dies ist kein HPACK-Archive! + 105 : Falsche Schlsseldatei! + 106 : Keine Optionen angegeben! + 107 : Unbekannter Befehl! + 108 : Unbekannte Option! + 200 : Falsches Password! + 201 : Kann Archiv nicht verndern! + 202 : Langes Argument-Format wird nicht untersttzt! + 203 : Falsche Platzhalter! + 204 : Passwortfehler! + 205 : Kann verschlsseltes Archive nicht entpacken! diff --git a/ERR/HYPER.ERR b/ERR/HYPER.ERR new file mode 100644 index 0000000..1da76dc --- /dev/null +++ b/ERR/HYPER.ERR @@ -0,0 +1,10 @@ + 1 : Keine Optionen angegeben! + 2 : Fehler in Archiv! + 3 : Unbekannte Komprimiermethode! + 4 : Nicht genug Hauptspeicher! + 5 : Falsche Checksumme! + 14 : Zu wenig Platz auf der Festplatte oder Diskette! + 98 : Fehler beim Anlegen des Archives! + 101 : Fehler beim Lesen der Input-Datei! + 102 : Ausgabefehler! + 255 : Anwender brach mit Strg-Pause oder Strg-C ab! \ No newline at end of file diff --git a/ERR/IOERROR.MSG b/ERR/IOERROR.MSG new file mode 100644 index 0000000..2c7a424 --- /dev/null +++ b/ERR/IOERROR.MSG @@ -0,0 +1,41 @@ + 1 : DOS-Fkt.-Nr. ist ungltig ! + 2 : Datei nicht gefunden ! + 3 : Pfad nicht gefunden ! + 4 : Zu viele Dateien geffnet ! + 5 : Datei-oder Verzeichniszugriff verweigert ! + 6 : Ungltiges Datei-Handle ! + 8 : Nicht genug Speicher ! + 12 : Ungltiger Datei-Zugriffscode ! + 15 : Fehlerhafte Laufwerksbezeichnung ! + 16 : Verzeichnis kann nicht gelscht werden ! + 17 : Umbenennen ber Laufwerke hinweg nicht erlaubt ! + 18 : Packer bzw. Entpacker nicht gefunden ! + 100 : Fehler beim Lesen von Diskette oder Platte ! + 101 : Fehler beim Schreiben auf Diskette oder Platte ! + 102 : Datei wurde nicht zugewiesen ! + 103 : Datei ist nicht offen ! + 104 : Datei fr Eingabe nicht geffnet ! + 105 : Datei fr Ausgabe nicht geffnet ! + 106 : Fehlerhaftes Zahlenformat ! + 150 : Diskette ist schreibgeschtzt ! + 151 : Peripheriegert nicht bekannt/nicht angeschlossen ! + 152 : Fehler beim Verzeichniswechsel ! + 154 : CRC-Fehler in Daten ! + 156 : Positionierfehler auf Laufwerk ! + 157 : Unbekannter Datentrger ! + 158 : Sektor nicht gefunden ! + 159 : Drucker hat kein Papier ! + 160 : Fehler beim Schreiben auf Peripheriegert ! + 161 : Fehler beim Lesen von einem Peripheriegert ! + 162 : Hardware-Fehler ! + 163 : Zu wenig Speicherplatz auf der Diskette ! + 203 : Heap berlauf ! + 221 : Programm konnte nicht ausgelagert werden ! + 222 : Es wurde keine Datei angewhlt ! + 223 : Es wurde kein Packer konfiguriert ! + 224 : Fehler in der Hilfedatei ! + 225 : Unbekanntes Archivformat ! + 226 : Kein Lschparameter fr Packer angegeben ! + 227 : Verzeichnis kann nicht im Archiv erstellt werden ! + 228 : Script im Archiv ausfhren nicht mglich ! + 229 : Diese Funktion ist in der DEMO nicht verfgbar ! \ No newline at end of file diff --git a/ERR/LHA.ERR b/ERR/LHA.ERR new file mode 100644 index 0000000..2779eea --- /dev/null +++ b/ERR/LHA.ERR @@ -0,0 +1,3 @@ + 1 : CRC-Fehler! + 2 : Fataler Fehler! + 3 : Fehler beim Anlegen der temporren Datei! \ No newline at end of file diff --git a/ERR/PAK.ERR b/ERR/PAK.ERR new file mode 100644 index 0000000..2c2b9e5 --- /dev/null +++ b/ERR/PAK.ERR @@ -0,0 +1,3 @@ + 1 : CRC-Fehler o. Datei nicht gefunden! + 2 : Zu wenig Speicher! + 7 : Laufwerksfehler! \ No newline at end of file diff --git a/ERR/PKUNZIP.ERR b/ERR/PKUNZIP.ERR new file mode 100644 index 0000000..6e5e223 --- /dev/null +++ b/ERR/PKUNZIP.ERR @@ -0,0 +1,14 @@ + 1 : Fehlerwarnung (wie z.B felerhafte CRC-Kontrolle)! + 2 : Fehler in .ZIP Datei! + 3 : Fehler in .ZIP Datei! + 4 : Zu wenig Hauptspeicher! + 5 : Zu wenig Hauptspeicher! + 6 : Zu wenig Hauptspeicher! + 7 : Zu wenig Hauptspeicher! + 8 : Zu wenig Hauptspeicher! + 9 : Datei nicht gefunden. Keine .ZIP Dateien gefunden! + 10 : Falsche Parameter! + 11 : Keine Dateien zum Entpacken/Anzeigen etc. gefunden! + 50 : Platte ist voll! + 51 : Falsche Endkennung der .ZIP Datei! + 255 : Anwender brach mit Strg-C oder Strg-Pause ab! diff --git a/ERR/PKZIP.ERR b/ERR/PKZIP.ERR new file mode 100644 index 0000000..da072d8 --- /dev/null +++ b/ERR/PKZIP.ERR @@ -0,0 +1,20 @@ + 1 : Fehlerhafter Dateiname! + 2 : Fehler in ZIP Datei! + 3 : Fehler in ZIP Datei! + 4 : Zu wenig Hauptspeicher! + 5 : Zu wenig Hauptspeicher! + 6 : Zu wenig Hauptspeicher! + 7 : Zu wenig Hauptspeicher! + 8 : Zu wenig Hauptspeicher! + 9 : Zu wenig Hauptspeicher! + 10 : Zu wenig Hauptspeicher! + 11 : Zu wenig Hauptspeicher! + 12 : Keine Dateien zum Archivieren od. Lschen gefunden! + 13 : ZIP Datei o. Dateiliste wurde nicht gefunden! + 14 : Platte ist voll! + 15 : ZIP Datei ist read-only und nicht vernderbar! + 16 : Falsche Parameter! + 17 : Zu viele Dateien! + 18 : Kann Datei nicht ffnen! + 27 : Nicht austauschbarer od. untersttzter Datentrger! + 255 : Anwender brach mit Strg-Pause oder Strg-C ab! \ No newline at end of file diff --git a/ERR/SQZ.ERR b/ERR/SQZ.ERR new file mode 100644 index 0000000..8e8a3fd --- /dev/null +++ b/ERR/SQZ.ERR @@ -0,0 +1,34 @@ + 1 : Zu wenig Speicher! + 2 : Fehler beim Schreiben in das Archiv! + 3 : Fehler beim Schreiben in temp. Archiv! + 4 : Fehler beim Schreiben der zu entp. Datei! + 5 : Fehler beim Lesen aus Archiv! + 6 : Fehler beim Lesen der zu packenden Datei! + 7 : Fehler beim ffnen der Archivdatei! + 8 : Fehler beim ffnen der zu packenden Datei! + 9 : Fehler beim ffnen der SFX/SFXjr.exe! + 10 : Fehler beim ffnen der Temp- oder Archivedatei! + 11 : Fehler beim Anlegen der Archivdatei! + 12 : Fehler beim Anlegen der temp. Archivdatei! + 13 : Fehler beim Anlegen der zu entp. Datei! + 14 : Fehler beim Erzeugen einer EXE-Archivdatei! + 15 : Fehler beim Schlieen der Archivdatei! + 16 : Fehler beim Schlieen der temp. Archivdatei! + 17 : Fehler beim Schlieen der zu entp. Archivdatei! + 18 : Fehler beim Schlieen der entp. Datei! + 19 : Archiv ist beschdigt! + 20 : Archiv ist beschdigt! + 21 : Zu viele Endungen zum kopieren (<= 16)! + 22 : Unbekannter Schalter angegeben! + 23 : Unerlaubte Kombination von Schaltern! + 24 : Anwender brach mit Strg-Pause oder Strg-C ab! + 25 : Unbekanntes Archivefomat! + 26 : Diese Optionen sind nicht mit dem SFX erlaubt! + 27 : Archivedatei war nicht fr MS-DOS! + 28 : CRC-Fehler beim Entpacken! + 29 : SQZ.EXE wurde manipuliert! + 30 : Beschdigte Archivedatei! + 31 : Kann gesichertes Archiv nicht hndeln! + 32 : Gesichertes Archiv kann nicht verndert werden! + 128 : Angewhlte Datei wurde nicht gefunden! + 129 : Konnte Dateien nicht bewegen! diff --git a/ERR/ZOO.ERR b/ERR/ZOO.ERR new file mode 100644 index 0000000..cba1fa5 --- /dev/null +++ b/ERR/ZOO.ERR @@ -0,0 +1 @@ + 1 : Fehler whrend der Ausfhrung! \ No newline at end of file diff --git a/HELP/HELP.TXT b/HELP/HELP.TXT new file mode 100644 index 0000000..fe8d712 --- /dev/null +++ b/HELP/HELP.TXT @@ -0,0 +1,803 @@ +. 1 ^wHilfe-Index zu TOP^w +^wInfo^w + {Support :2} + {Einfhrung :3} +^wBedienung^w + {TOP Fenster :4} + {Verzeichnisbaum :5} + {Dateiliste :6} + {Archivbetrachter :7} + {Dateien auswhlen :8} + {Laufwerk :9} +^wMenoptionen^w + {Optionen F2 :20} + {Script F3 :21} + {DatInfo F4 :22} + {Komprimieren F5 :23} + {Dekomprimieren F5 :24} + {Unterverzeichnis erstellen F7 :25} + {Lschen F8 :26} + {Packer konfigurieren F9 :27} + {Ende Alt X:28} +^wVerschiedenes^w + {Packer Fehlermeldungen :30} + {TOP Umgebung :31} +; +; +; +. 2 ^wSupport^w + + TOP - Toms Oberflche fr Packprogramme - Version 2.1 + Copyright (C) 1992-95 + + Eine Vollversion dieses Programmes erhalten Sie bei: + + ^wMultimedia-Service^w + ^wBurkhard Pabst^w + ^wMax-Josef-Metzger-Str. 25^w + ^w14772 Brandenburg^w + ^wTel./Fax (03381) 761598 + +; +; +; +. 3 ^wEinfhrung^w + + ^wTOP - Toms Oberflche fr Packprogramme - Version 2.1^w + ^wCopyright (C) 1992-94^w + + wurde entworfen und entwickelt von: ^wThomas Knfel^w + + Sehr geehrte Damen und Herren, + +endlich haben Sie ein Programm mit dem Sie unkompliziert +Backups durchfhren knnen. Der Wust an Packprogrammen +scheint unermelich zu sein, von denen die meisten keine +Benutzeroberflche besitzen. Die einzige Alternative war +bisher das Schreiben von unkomfortablen Batchdateien. +Mit diesem Archivmanager sind Sie in der Lage Ihre +Packprogramme unter einer einheitlichen Benutzeroberflche +zu nutzen. + +Bei der Programmierung und Entwicklung dieses Programmes +habe ich versucht, den umfangreichen Befehlsumfang der +Packprogramme mglichst detailiert zu bercksichtigen. + +Anregungen und Hinweise die zur Verbesserung des Programmes +fhren nehme ich gerne entgegen. Wenden Sie sich bitte an +meinen Distributor. + +Zustzliche Informationen zum Copyright werden Ihnen +angezeigt, wenn Sie die TOP berschrift mit der +linken Maustaste anklicken. + +; +; +; +. 4 ^wTOP Fenster^w + +In dem Fenster der linken Seite werden alle Dateien der + +Verzeichnisse angezeigt. Befinden Sie sich mit dem +Balkencursor in diesem Fenster so knnen Sie die +ausgewhlten Dateien mit {F5 Komprimieren:23}. + +In dem Fenster der rechten Seite werden nur die Archive +mit den von Ihnen unter {F9 Parameter:27} angegebenen +Endungen angezeigt. Aus diesem Fenster knnen Sie mit +{F5 Dekomprimieren:24}. + +Durch ein Doppelklicken oder Enter auf ein Archiv im +rechten Fenster besteht die Mglichkeit ein Archiv zu +ffnen, sofern das TOP-Programm dieses Archivformat lesen +kann. Es werden alle Dateien und Verzeichnisse im Archiv +angezeigt. + +; +; +; +. 5 ^wVerzeichnisbaum^w + +ber den Verzeichnisbaum hat der Benutzer die Mglickeit +in die Verzeichnisse der Festplatte zu wechseln. + + ^wTastenkrzel^w ^wAktion^w + + ^wCursortasten^w Ermglichen das Bewegen auf dem + Verzeichnisbaum. + Mit den Cursortasten Rechts und Links + knnen Sie zwischen den Verzeichnissen auf + einer Ebene wechseln. + (ebenfalls mglich Pos1,Ende,Bild,Bild,) + + ^wEnter^w Wechselt in das Verzeichnis unter dem + Cursor (ebenfalls mglich Doppelkick + mit linker Maustaste) + + ^w-^w Schliet die Unterverzeichnisse des + aktuellen Verzeichnisses. (das Verzeichnis + wird anschlieend andersfarbig dargestellt) + + ^w+^w Zeigt die Unterverzeichnisse des + aktuellen Verzeichnisses an. + +Die Anzahl der {markierte Dateien:8} wird neben dem +entsprechenden Verzeichnis angezeigt. + + ^w[ ]C:\^w + ^w [-] TEXTE^w + ^w5 [ ] SCHULE^w + ^w3 [ ] PRIVAT^w + +Sind alle Dateien des Verzeichnisses angewhlt, so wird +die Zahl wei dargestellt ansonsten grau. + + +Im unteren Fensterteil stehen zustzliche Informationen +ber Dateien und Speicherkapazitten. + + + Anzahl der angewhlten Summe der Dateien + Dateien auf dem Laufwerk auf Laufwerk in Byte + + ^w[-A-][=C=]ۺ^w + ^w Ausgew.: 5 360.720 B ^w + ^w Gesamtkapazitt: 834.534.143 B ^w + ^w freier Speicher: 291.320.945 B ^wĿ + ^wͼ^w + + Gesamtkapazitt Freier verfgbarer Speicher + des Laufwerkes in Byte des Laufwerkes in Byte + + +^wgeffnetes Archiv:^w + +Im Unterschied zum einfachen Verzeichnisbaum befindet +sich am Anfang der Name der Archivdatei. ber diesen +Namen knnen Sie durch doppelklicken oder Enter das +Archiv verlassen. + + ^wbackup.zip^w + ^w [-] TOOLS^w + ^w [ ] KOPIERER^w + ^w [ ] FORMAT^w + + Anzahl der angewhlten Summe der Dateien + Dateien im Archiv im Archiv in Byte + + ^w[-A-][=C=]ۺ^w + ^w Ausgew.: 5 360.720 B ^w +^w orig. G: 251.352 B Rat.: 35.59% ^wĿ + ^w komp. G: 89.456 B Form: PKZIP ^wĿ + ^wͼ^w + + komprimierte Gre aller Format des Archives + Dateien des Archives in Byte + + originale/entpackte Gre aller Komprimierrate aller + Dateien des Archives in Byte Dateien des Archives + +; +; +; +. 6 ^wDateiliste^w + +In der Dateiliste knnen die Dateien des aktuellen +Verzeichnisses in vier mglichen Arten angezeigt. +Das Umschalten ist mit {F4 Datinfo:22} mglich. + +Die Reihenfolge der Dateien kann nach verschiedenen +{Kriterien:20} sortiert werden. + +In die {Verzeichnisstruktur:5} gelangen Sie wieder durch +einen Doppelklick mit der linken Maustaste auf den am +Anfang der Liste befindlichen Punkt oder durch Enter, +wenn sich der Balkencursor auf diesem befindet. + +Im unteren Fensterteil stehen zustzliche Informationen ber +das Verzeichnis. + + + Anzahl der angewhlten Summe der Dateien + Dateien im Verzeichnis im Verzeichnis in Byte + + ^w[-A-][=C=]ۺ^w + ^w Ausgew.: 3 141.920 B ^w + ^w Gesamtkapazitt: 834.534.143 B ^w + ^w freier Speicher: 291.320.945 B ^wĿ + ^wͼ^w + + Gesamtkapazitt Freier verfgbarer Speicher + des Laufwerkes in Byte des Laufwerkes in Byte + +^wgeffnetes Archiv:^w + +Der untere Fensterteil des Archivfensters stellt sich +wie folgt dar. + + Anzahl der angewhlten Summe der Dateien + Dateien im Verzeichnis im Verzeichnis in Byte + + ^w[-A-][=C=]ۺ^w + ^w Ausgew.: 10 921.480B ^w +^w orig. G: 4.135.891 B Rat.: 41.62% ^wĿ + ^w komp. G: 1.721.358 B Form: HYPER ^wĿ + ^wͼ^w + + komprimierte Gre aller Format des Archives + Dateien des Archives in Byte + + originale/entpackte Gre aller Komprimierrate aller + Dateien des Archives in Byte Dateien des Archives + +; +; +; +. 7 ^wArchivbetrachter^w + +In ein Archiv gelangen Sie, wenn Sie eine Archivdatei im +rechten Fenster doppelt anklicken oder sich mit dem +Balkencursor auf diese bewegen und Enter eingeben. + +Ein leistungsfhiger Archivbetrachter ffnet Archive +der Komprimierer: +^wARC, ARJ, BSA, DWC, HYPER, LHA, LIMIT, PAK, PKZIP/PKUNZIP,^w +^wSTUFFIT, SQZ, TPZ, ZOO^w + +Weitere Einzelheiten ber die Darstellungsweise finden +Sie unter: +{Verzeichnisbaum:5} +{Dateiliste:6} + +; +; +; +. 8 ^wDateien auswhlen^w + +Fr ausgewhlte Dateien knnen Sie verschiedene Befehle +wie Komprimieren, Dekomprimieren und Lschen durchfhren. + + ^wTastenkrzel^w ^wAktion^w + + ^w+ Enter^w Dateigruppe anwhlen + + ^w- Enter^w Dateigruppe abwhlen + + ^w*^w Kehrt die Auswahl um. + Die aktuelle Auswahl der Dateien wird + aufgehoben und nicht ausgewhlte Dateien + markiert. + + ^wEinfg,^w In der Dateienliste knnen ^weinzelne^w + ^wLeertaste^w Dateien und im Verzeichnisbaum ^walle^w + Dateien an- oder abgewhlt werden + (ebenfalls mglich mit rechter Maustaste). + + +Die Dateigruppen werden mit ^wPlatzhaltern^w beschrieben. + + ^wPlatzhalter^w ^wmarkiert^w + + ^w*^w beliebige Zeichen mit beliebiger Anzahl + + ^w?^w ein beliebiges Zeichen + + ^w#^w eine beliebige Ziffer + + +Die Anweisung ?o*#.* whlt alle Dateien aus, +in deren Dateinamen an zweiter Stelle ein 'o' und an +letzter Stelle eine Ziffer ist, wie +z.B mouse1.com, core2.bat. + +^wHinweis:^w Sollten Sie zwischen verschiedenen Laufwerken + wechseln, so bleibt die Markierung bestehen. + Austauschbare Datentrger wie Disketten- und + CD-Laufwerke sind davon ausgenommen. + +; +; +; +. 9 ^wLaufwerk^w + +Das Wechseln der Laufwerke ist durch einen Mausklick auf +den Laufwerksbuchstaben der Laufwerksleiste im +entsprechenden Fenster mglich. +Ebenfalls knnen Sie durch die Eingabe des +Laufwerksbuchstaben auf der Tastatur das Laufwerk im +aktiven Fenster wechseln. + +Wollen Sie ein Laufwerk neu einlesen so geben Sie +^wStrg-R^w ein. + +; +; +; +. 20 ^wOptionen F2^w + +Dieses Fenster dient der Einstellung verschiedener Optionen. + + ^wSortieren nach^w + Hier knnen Sie die Reihenfolge bestimmen, in der die + Dateien in der Dateiliste angezeigt werden. + + ^wName^w + Die Dateien werden alphabetisch nach Namen sortiert. + Dateien mit gleichem Namen werden nach Erweiterungen + sortiert. + ^wErweiterung^w + Die Dateien werden alphabetisch nach Erweiterungen + sortiert. + Dateien mit gleichen Erweiterungen werden nach Namen + sortiert. + ^wZeit^w + Die Dateien werden nach dem Erstellungsdatum sortiert, + wobei die ltesten oben stehen. + Dateien mit gleichen Zeiten werden nach Namen und + Endungen sortiert. + ^wGre^w + Die Dateien werden nach der Gre sortiert, wobei die + kleinsten oben stehen. + Dateien mit gleicher Gre werden nach Namen und + Endungen sortiert. + ^wAttribut^w + Die Dateien werden nach Dateiattributen sortiert. + Die Reihenfolge wird folgendermaen bestimmt, zuerst + kommen die Attribute Nur-Lesen(^wR^w) ,Versteckt(^wH^w), + System(^wS^w) und zuletzt Archiv(^wA^w). + Dateien mit gleichen Attributen werden nach Namen und + Endungen sortiert. + ^wUnsortiert^w + Zeigt die Dateien in der gleichen Reihenfolge wie der + Dos-Befehl DIR an. + + ^wDateiattribute^w + Hier knnen Sie bestimmen welche Dateien mit ihren + entsprechenden Attributen angezeigt werden sollen. + + ^wArchiv^w + Es werden Dateien mit gesetztem Archivattribut angezeigt. + ^wNur-Lesen^w + Es werden schreibgeschtzte Dateien angezeigt. + ^wSystem^w + Es werden Systemdateien angezeigt. + ^wVersteckt^w + Es werden versteckte Dateien angezeigt. + + ^wFarbe^w + Es besteht die Mglichkeit zwischen drei Farbeinstellungen + zu whlen. + + ^wWeitere Optionen^w + Dieses Dialogfeld dient der Einstellung weiterer + Konfigurationsoptionen. + + ^wBack/Rest Erkennung^w + Diese Option ermglicht es TOP noch effektiver zu nutzen. + Wird TOP in einem Verzeichnis aufgerufen, in dem sich + Dateien befinden, so steht der Balkencursor nach dem + Start im entsprechenden Verzeichnis des linken Fensters, + um dieses zu komprimieren. + Wird TOP in einem leeren Verzeichnis aufgerufen, so + steht der Balkencursor nach dem Start im rechten Fenster, + um ein Archiv zu dekomprimieren. + ^wSofort Ende^w + Nach dem Komprimieren oder Dekomprimieren wird das + Programm sofort beendet. + ^wInteraktiver Modus^w + In diesem Modus wird die Ausgabe des Komprimierprogrammes + angezeigt. Bei einem Backup ber mehrere Disketten + empfiehlt es sich diesen Modus zu aktivieren, um der + Aufforderung eines Diskettenwechsels nachkommen zu + knnen. Falls der interaktive Modus deaktiviert ist, + wird die Ausgabe in die Datei STDOUT.RED geschrieben. + ^wVerify^w + Whrend des Packens und Entpackens wird berprft, ob + die Daten fehlerfrei auf den Datentrger + geschrieben werden. + + ^wPacker-Verzeichnis^w + Hier wird das Verzeichnis angegeben, in dem sich + die Packprogramme befinden. + Ein verndertes Packer-Verzeichnis wird erst nach einem + erneuten Programmstart aktiviert. + + ^wTemporres-Verzeichnis^w + Hier wird das Verzeichnis angegeben, in welches temporre + Auslagerungen durchgefhrt werden knnen. Sie sollten + hierfr mindestens 800 KByte bereitstellen. + Ein verndertes Temporres-Verzeichnis wird erst nach + einem erneuten Programmstart aktiviert. + +^wHinweis :^w Sollte ein fehlerhaftes Packer-Verzeichnis + oder Temporres-Verzeichnis angegeben worden + sein, so wird nach einem erneuten Start des + Programmes dieses nach einer Fehlermeldung + durch das aktuelle Verzeichnis ersetzt. + +; +; +; +. 21 ^wScript F3^w + +Sie knnen in diesem Fenster eine Scriptdatei erstellen, +welche Ihnen das regelmige Markieren von Dateigruppen +erleichtert. Dieser Befehl ermglicht es Dateien und +Verzeichnisse zu bercksichtigen, welche zu einem spteren +Zeitpunkt dazugekommen sind. + +Im oberen Fensterteil erhalten Sie die Mglichkeit eine +neue Scriptdatei zu erstellen oder eine bereits vorhandene +zu lschen. + +Die Buttons { Neu :40}/Einf, Lschen/Entf, Kopieren und +{Editiern:40} dienen zum Verndern des Inhaltes der Scriptdatei. + +Die Liste in der Scriptdatei beschreibt die Dateien, welche +nach dem Anwhlen des OK markiert werden. +Es werden nur Dateien auf der aktiven Fensterseite markiert. + +^wHinweis :^w Dieser Befehl ist nicht in einem geffnetem + Archiv ausfhrbar. + +; +; +; +. 40 ^wNeu/Editieren^w + +Das Laufwerk, der Pfad und die Datei beschreiben +die Datei(en) welche markiert werden sollen. +Die Dateien knnen durch Platzhalter beschrieben werden. +(siehe {Dateien markieren:8}) + +Die Auswahl zwischen Inklusiv und Exklusiv gibt an ob auch +Unterverzeichnisse in die Selektion einbezogen werden. + +; +; +; +. 22 ^wDatinfo F4^w + +Dieser Befehl stellt verschiedene Dateiinformationen dar. + + ^wModus1^w +(im einfachen Dateilisting und geffnetem Archiv) +Hier stehen nebeneinander der Dateiname, das Datum, +die Uhrzeit und die Gre der Dateien. + + ^wmouse com 18/08/93 6:30 55766^w + + + ^wModus2^w +(im einfachen Dateilisting) +Hier stehen nebeneinander der Dateiname,das Datum, +die Uhrzeit und das Dateiattribut der Dateien. + + ^wmouse com 18/08/93 6:30 A---^w + + ^wModus3^w +(im geffnetem Archiv) +Hier stehen nebeneinander der Dateiname, +die Komprimierrate, die komprimierte Gre und +die originale Gre der Dateien. + + ^wmouse com 51% 28983 55766^w + + ^wModus4^w +(im geffnetem Archiv) +Hier stehen nebeneinander der Dateiname, +die Komprimierart, die {CRC-Prfsumme:41} und +das Dateiattribut der Dateien. + + ^wmouse com DeflatX 62A7138D A---^w + +; +; +; +. 23 ^wKomprimieren F5^w + +Mit diesem Befehl knnen Dateien komprimiert werden. Dieser +Befehl kann nur aufgerufen werden, wenn sich der Balken im +linken Fenster befindet. + +In der oberen Zeile steht der Quellpfad aus dem komprimiert +wird und der Zielpfad in welchem das Archiv erzeugt wird. + + ^wC:\UTILITY\TOOLS  A:\^w + +In diesem Fenster stehen verschiedene Einstellungen, welche +unmittelbar den Komprimiervorgang beeinflussen. + + ^wPacken von:^w + Hier werden die Dateien beschrieben, die gepackt werden + sollen. Es gibt hier mehrere Darstellungen. Sollten + bereits Dateien markiert sein, wird hier die Anzahl + angezeigt. Sind keine Dateien markiert, so wird nur + die aktuelle Datei angezeigt, auf welche der + Balkencursor steht. + ^win Archiv :^w + Hier wird der Name des Archives angegeben, in welches + gepackt werden soll. Falls dieses Archiv in dem + selektierten Verzeichnis des rechten Fensters bereits + existiert, werden die Dateien diesem Archiv + hinzugefgt. Sollte dieses Verzeichnis nicht das + angegebene Archiv enthalten, wird dieses neu erzeugt. + ^wPasswort :^w + Es besteht die Mglichkeit durch Eingabe eines + Passwortes die zu packenden Dateien im Archiv zu + sichern und nur durch die erneute Eingabe + des Passwortes wieder zu entpacken. + ^wDateien verschieben :^w + Die zu packenden Dateien werden nach erfolgreichem + Komprimiervorgang aus dem Verzeichnis gelscht. + ^wmit Unterverzeichnissen :^w + Die zu packenden Dateien werden inklusive + Unterverzeichnissen in das Archiv komprimiert. Diese + Anweisung ist nur im Verzeichnisbaum anwhlbar. + ^wmit Verzeichnisstruktur :^w + Die zu packenden Dateien werden mit ihrer vollstndigen + Pfadangabe gepackt. Beim Dekomprimiervorgang werden + diese wieder in das Originalverzeichnis entpackt. + ^wSelbstentpacker :^w + Durch diese Option kann das Archiv durch Aufruf auf der + DOS-Shell ohne Dekomprimierer entpackt werden. + Es erhlt die Endung EXE. + ^wMultiple Volume :^w + Dies ermglicht es ein Backup ber mehrere Disketten + zu machen. + ^wPacker :^w + In diesem Dialogfenster kann der Komprimierer + ausgewhlt werden, welcher die Komprimierung + durchfhren soll. + ^wModus :^w + Der Modus gibt die Intensitt des Komprimierens an. + +^wHinweis :^w Die aufgelisteten Anweisungen werden nur + angezeigt, wenn fr den Komprimierer unter + der Menoption Parameter ein entsprechender + Befehl eingegeben wurde. + +; +; +; +; +. 24 ^wDekomprimieren F5^w + +Mit diesem Befehl knnen Dateien dekomprimiert werden. +Dieser Befehl kann nur aufgerufen werden, wenn sich +der Balken im rechten Fenster befindet. + +In der oberen Zeile steht der Quellpfad, aus dem das Archiv +dekomprimiert wird und der Zielpfad, in welchen die Dateien +geschrieben werden. + + ^wC:\UTILITY\TOOLS  A:\^w + +In diesem Fenster stehen verschiedene Einstellungen, welche +unmittelbar den Dekomprimiervorgang beeinflussen. + + ^wEntpacken von:^w + Hier werden die Dateien beschrieben, die entpackt + werden sollen. Dies erfolgt durch Platzhalter. + ^waus Archiv :^w + Sollten mehrere Archive markiert sein, wird hier + die Anzahl angezeigt, ansonsten nur das Archiv unter + dem Balkencursor. + ^wPasswort :^w + Falls Dateien mit einem Passwort komprimiert wurden mu + dieses wieder zum Dekomprimieren angegeben werden. + ^wmit Verzeichnissen^w + Dateien werden mit ihren ursprnglichen + Verzeichnissen entpackt. + ^mMultiple Volume^w + Dieser Befehl dient dem Entpacken eines Archives, welches + auf mehrere Disketten verteilt ist. + +^wHinweis:^w Das Programm weit dem Archiv an Hand seiner + Endung den entsprechenden Dekomprimierer zu. + +; +; +; +. 25 ^wUnterverzeichnis erstellen F7^w + +Dieser Befehl ermglicht es Ihnen Verzeichnisse anzulegen. +Das erstellte Verzeichnis wird ein Unterverzeichnis des +aktuellen Verzeichnisses. +Das Erstellen von Verzeichnissen innerhalb von Archiven +ist nicht mglich. + +; +; +; +. 26 ^wLschen F8^w + +Dieser Befehl ermglicht es, Dateien und Verzeichnisse +zu lschen. + +Einzelne Dateien werden gelscht, wenn sie sich unter dem +Balkencursor befinden. +Es knnen Dateigruppen gelscht werden, die vorher +{markiert:7} wurden. +Das Lschen von Dateien ist auch innerhalb der Archive +mglich, sofern der Packer dies untersttzt und Sie diesen +Befehl unter {F9 Parameter:27} eingegeben haben. + +Sind keine Dateien markiert so ist es mglich Verzeichnisse +mit ihren Unterverzeichnissen und Dateien zu lschen. + +^wHinweis:^w Dateien mit dem Dateiattribut Nur-Lesen knnen + nicht gelscht werden. + +; +; +; +. 27 ^wPacker konfigurieren F9^w + +In diesem Dialogfenster werden die DOS Parameter der +Pack- und Entpackprogramme angegeben. Diese Parameter +werden beim Aufruf der Packer und Entpacker von TOP +miteinander kombiniert. Da nicht alle Programme die +Vielzahl der aufgefhrten Optionen untersttzen, knnen +einige der entsprechenden Felder freigelassen werden. +Diese sind im folgenden mit 'optional' gekennzeichnet. +Andere Felder mssen bei Fehlen der Option durch hnliche +Anweisungen ausgefllt werden. + + ^wArchivendung^w + Die Archivendung wird vom Komprimierer automatisch an + den Dateinamen des Archives angehangen. Es ist mglich + mehrere Endungen anzugeben welche duch Kommatas + voneinander abgetrennt werden. Sie knnen bis zu drei + verschiedene Archivendungen fr einen Packer angeben. + Diese knnen auch durch Platzhalter beschrieben werden. + Nur Dateien mit den entsprechenden Endungen werden im + rechten Fenster angezeigt. + ^wPacker^w + Hier geben Sie den Dateinamen + des Komprimierprogrammes an. + ^wEntpacker (optional)^w + Hier geben Sie den Dateinamen des + Dekomprimierprogrammes an. + ^wPacken^w + Diese Option gibt dem Packer die Anweisung die + nachfolgenden Dateien in ein Archiv zu komprimieren. + ^wohne Verzeichnis:^w + Whrend des Packvorganges wird nur + der Dateiname in das Archiv + aufgenommen. + ^wmit Verzeichnis (optional):^w + Whrend des Packvorganges wird der + vollstndige Verzeichnispfad der + Datei zustzlich im Archiv abgelegt. + ^wVerschieben^w + Diese Option weist den Packer an, Dateien zu + komprimieren und auerdem anschlieend zu lschen. + ^wohne Verzeichnis (optional):^w + siehe Packen. + ^wmit Verzeichnis (optional):^w + siehe Packen. + ^wEntpacken^w + Gepackte Archive werden mit dieser Option wieder + entpackt. + ^wohne Verzeichnis:^w + Die Dateien werden in das aktuelle + oder angegebene Verzeichnis entpackt. + ^wmit Verzeichnis (optional):^w + Die Dateien werden beim Entpacken in + das gespeicherte Verzeichnis entpackt. + ^wKomprimierung^w + Gibt die Intensitt an, mit der die Dateien komprimiert + werden. + ^wSelbstentpacker (optional)^w + Erzeugt ein selbstentpackendes Archiv mit + der Dateiendung EXE. + ^wPacken mit UV (optional)^w + Komprimiert zustzlich zum aktuellen Verzeichnis + die Dateien der Unterverzeichnisse und die + dazugehrigen Verzeichnispfade. + ^wPasswort (optional)^w + Ermglicht es, beim Komprimieren die Dateien im Archiv + durch ein Passwort zu sichern. + Whrend des Dekomprimierens mu das Archiv mit + dieser Option und dem dazugehrigen Passwort + angegeben werden. + ^wMultiple Volume (optional)^w + Dieser Befehl untersttzt das Packen und Entpacken ber + mehrere Datentrger. + ^wLschen aus Archiv (optional)^w + Diese Option dient dem Lschen von Dateien aus dem + Archiv. + +^wHinweis^w : Sie knnen bis zu 99 Pack- und Entpackprogramme + in die TOP-Oberflche einbinden. Die Parameter + werden in der Datei PACKER.CFG gespeichert. + +; +; +; +. 28 ^wEnde Alt-X^w + +Dieser Befehl beendet das Programm. + +Es besteht auch die Mglichkeit nach dem Komprimieren oder +Dekomprimieren das Programm sofort beenden zu lassen. +(siehe {F2 Optionen:20}) + +^wHinweis:^w nderungen im {Optionsfenster:20} werden beim Beenden + des Programmes gespeichert. + +; +; +; +; +. 30 ^wPacker Fehlermeldungen^w + +Whrend des Komprimierens oder Dekomprimierens knnen +verschiedene Fehler auftreten, die von mehreren +Packprogrammen indirekt dokumentiert werden. + +Die Packprogramme geben nach Beendigung ihres Ablaufs einen +{Dosexitcode:42} an das System, der von TOP an den Benutzer +weitergeleitet wird. Um diesem Dosexitcode eine Nachricht +zuordnen zu knnen, mu fr jeden Packer und Entpacker eine +individuelle Datei angelegt werden. + +Diese Datei mu sich im Verzeichnis des TOP Programmes +befinden. Ihr Name mu sich aus dem Namen +des Pack- oder Entpackprogrammes und der Endung ERR +zusammensetzen. Fr das Programm pkzip.exe ist die +dazugehrige Fehlerdatei pkzip.err. +Der interne Dateiaufbau kann mit einem einfachen Dos-Editor +erstellt werden. Jeder Dosexitcode wird mit +der entsprechenden Fehlermeldung in eine eigene Zeile +geschrieben und durch einen Doppelpunkt getrennt. +Fr einen Dosexitcode wrde eine Zeile wie folgt aussehen. + + ^w5 : Diskette/Platte ist voll!^w + +Die Lnge einer Fehlermeldung kann maximal 51 Zeichen +betragen. + +; +; +; +. 31 ^wTOP Umgebung^w + +Vor dem Pack- und Entpackvorgang wird fr das externe +Pack- bzw. Entpackprogramm das TOP-Programm aus dem Speicher +ausgelagert. Fr diese Auslagerungsdatei sollten Sie +ausreichend ^wEMS Speicher^w bereitstellen. Im Falle, +da Sie keinen eingerichtet oder nicht gengend zur +Verfgung haben, wird eine temporre Auslagerungsdatei +in das unter {F2 Optionen:20} angegebene temporre +Verzeichnis geschrieben. Die Auslagerung auf die Festplatte +ist mit einer Zeitverzgerung verbunden. +Es besteht auch die Mglichkeit fr das Nutzen des +XMS Speicher. Dazu mssen Sie eine RAM-DISK einrichten und +das temporre Verzeichnis auf diese einstellen. + +; +; +; +. 41 ^wCRC (Cyclic Redundancy Check)^w + +Die CRC-Prfsumme dient der berprfung der inneren +Konsistenz von Daten. Sie wird beim Komprimieren erstmalig +erzeugt. Whrend des Dekomprimeren wird die CRC-Prfsumme +vom Entpacker erneut berechnet und mit der gespeicherten +verglichen. Sollte ein Unterschied auftreten, so ist ein +Fehler aufgetreten und die Datei kann nicht fehlerfrei +entpackt werden. + +; +; +; +. 42 ^wDosexitcode^w + +Nach dem Beenden eines Programmes wird ein Rckgabecode +an das DOS bergeben. Dieser kann innerhalb einer +Batch-Datei ber die Batch-Variable ^wERRORLEVEL^w +abgefragt werden. + +; \ No newline at end of file diff --git a/HELP/HELP_COM.PAS b/HELP/HELP_COM.PAS new file mode 100644 index 0000000..3800856 --- /dev/null +++ b/HELP/HELP_COM.PAS @@ -0,0 +1,110 @@ +{****************************************************************} +{ } +{ Helpcompiler } +{ Copyright 1994 by Thomas Knfel } +{ } +{****************************************************************} + +program HelpCompiler; +uses tkstring,tkstream,init; + +const MagicHeader : longint = $32504f54; {TOP2} + first : boolean = true; + + +type + + Helprec = record + Number : word; + Topic : record end; + TextCount : word; + Text : record end; + jump : word; + end; + + +var + fin : textstream; + fout : typedstream; + zeile : string; + z : byte; + tword : string[5]; + s : Helprec; + Code : Integer; + ZeileCop: string; + MPosTC : longint; + MHelp : Helprec; + jump_pos: byte; + +begin + If (paramstr(1)='') or (paramstr(2)='') then + begin + write('Syntax: help_com quelldatei zieldatei'); halt(1); + end; + + Fin.Init(paramstr(1)); + Fin.Open; + Fout.Init(paramstr(2), Sizeof(Byte) ); + Fout.Create; + + Fout.Write(Magicheader,0,SizeOf(Magicheader)); + while not Fin.EOF do + begin + Fin.Readln(zeile); Zeile:=Rtrim(Zeile); + case zeile[1] of + '.' : begin + delete(zeile,pos(Zeile,'.')+1,1); + Zeile:=trim(Zeile); + tword:=''; + for z:=1 to pos(' ',Zeile)-1 do { Number } + tword:=tword+Zeile[z]; + Val(tword, S.Number, Code); + If Code > 0 then + begin + Fout.close; Fin.close; + write('Keine Nummer in Topic angegeben; Zeile:',Zeile); halt(3); + end; + Fout.Write(S.Number,Fout.Pos,Sizeof(S.Number)); + delete(zeile,1,Pos(' ',Zeile)); + Zeile:=trim(Zeile); { Topic } + delete(Zeile,Sizeof(S.Topic),length(Zeile)-Sizeof(S.Topic)-1); + Fout.write(Zeile,Fout.Pos,length(Zeile)+1); + If not first then + Fout.write(S.TextCount,MPosTC, SizeOf(S.TextCount)); + S.Textcount:=0; MPosTC:=Fout.Size; + Fout.write(S.TextCount,MPosTC, SizeOf(S.TextCount)); + first:=false; + end; + ';' : begin end; + else begin + inc(S.TextCount); rtrim(Zeile); MHelp.jump:=0; + If (Pos('{',Zeile)>0) and (Pos('}',Zeile)>0) and (Pos(':',Zeile)>0) and + (Pos('{',Zeile) Pos(':',ZeileCop) do + ZeileCop[Pos(':',ZeileCop)]:=' '; + {EndWhile} + Jump_Pos:=Pos(':',ZeileCop)+1; + ZeileCop:=copy(ZeileCop,Jump_Pos,Pos('}',ZeileCop)-Jump_Pos); + ZeileCop:=trim(ZeileCop); + Val(ZeileCop,MHelp.Jump,Code); { Jump } + If Code > 0 then + begin + Fout.close; Fin.close; + write('Keine Zahl in Crossreferenz; Nr:',S.Number,' Linie:',S.TextCount); halt(4); + end; + z:=Pos('{',Zeile); { ^h einfgen } + delete(Zeile,z,1); Insert('^c',Zeile,z); + delete(Zeile,jump_pos,Pos('}',Zeile)-jump_pos); + z:=Pos('}',Zeile); + delete(Zeile,z,1); Insert('^c',Zeile,z); + end; + Fout.write(Zeile,-1,length(Zeile)+1); + Fout.write(MHelp.Jump,-1,SizeOf(MHelp.Jump)); + end; + end; + end; + Fout.write(S.TextCount,MPosTC, SizeOf(S.TextCount)); + Fin.Close; Fout.Close; +end. \ No newline at end of file diff --git a/HELP/TKVTEST.PAS b/HELP/TKVTEST.PAS new file mode 100644 index 0000000..ab7262a --- /dev/null +++ b/HELP/TKVTEST.PAS @@ -0,0 +1,38 @@ +program vv; +uses TKview,Tkview2,crt,Kbm,Tkstring,Tkvideo; + +var tH : Helpview1; + tH2 : SelectView1; + tl : Listview1; + i : byte; + s : string; + +begin + textbackground(black); textcolor(white); + clrscr; MouShowMouse; Cursor_OFF; + {tH2.init(50,15); tH2.SetMarkMode(false); + for i:=1 to 60 do + begin + str(i,s); + If i in [3,10,15,30,32,33,36,60] then + tH2.appendHelp('^chall^co '+s,5) else + tH2.appendHelp('hallo '+s,3); + end; + tH2.viewlines; + tH2.done;} + + {tL.init(5,5,50,20); + for i:=1 to 60 do + begin + str(i,s); + If i in [3,10,15,30,32,33,36,60] then + tL.appendLine('^hhall^ho '+s,3,5,i) else + tL.appendLine('hallo '+s,0,0,0); + end; + tL.viewlines; + tL.done;} + + tH.init(paramstr(1),$32504f54); + tH.viewpage(1); + tH.done; +end. \ No newline at end of file diff --git a/TKSTRING/ASM/HBBINARY.ASM b/TKSTRING/ASM/HBBINARY.ASM new file mode 100644 index 0000000..c73a7f1 --- /dev/null +++ b/TKSTRING/ASM/HBBINARY.ASM @@ -0,0 +1,58 @@ +;****************************************************** +; HBBINARY.ASM V 1.0 +; String handling routines +; Copyright (c) HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC Binary + +;-------------------------------------------------------- +;FUNCTION Binary(L : LongInt; Bits : Byte) : String; +; {-Die in BITS angegebene Anzahl Bits (Rechts beginnend) werden +; im String dargestellt} +Binary PROC FAR ;BEGIN + POP SI ; Rckkehradresse vom Stack nehmen + POP AX +;** Parameterbernahme ** + POP CX ; CX := Bits + MOV CH,0 + POP BX ; DX:BX := L + POP DX + POP DI ; ES:DI := @Output String + POP ES + PUSH ES + PUSH DI + PUSH AX ; Ruckkehradresse zurckspeichern + PUSH SI + + MOV ES:[DI],CL ; Binary[0] := char(Bits); + JCXZ BinE ; FOR I := Bits DOWNTO 1 DO BEGIN + STD ; Richtung fr STOSB = Rckwts + ADD DI,CX ; DI = Zeiger auf letztes Zeichen +Bin1: SHR DX,1 + RCR BX,1 ; L:=L SHR 1 => CY; + MOV AL,30H SHR 1 + RCL AL,1 + STOSB ; Binary[I] := char((L AND 1)+$30); + LOOP Bin1 ; END; +BinE: RET ;END; +Binary ENDP +;-------------------------------------------------------- + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBBM.ASM b/TKSTRING/ASM/HBBM.ASM new file mode 100644 index 0000000..a63cc1c --- /dev/null +++ b/TKSTRING/ASM/HBBM.ASM @@ -0,0 +1,201 @@ +;****************************************************** +; HBBM.ASM V. 1.0 +; String handling routines +; Copyright (c) Heiko Becker HB-Soft 1991. +; All rights reserved. +;****************************************************** + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC BMMakeTable, BMSearch, BMSearchUC + + EXTRN UpCase : FAR + +;****************************************************** UpC + +UC EQU Byte PTR SS:[BP-2] + +Upc Proc Near ;UpCase character in AL + CMP UC,1 + JNE Up_End + PUSH AX + CALL UpCase +Up_end: ret +UPC ENDP + +;****************************************************** BMMakeTable + +; procedure BMMakeTable(MatchString : string; var BT : BTable); +; Build Boyer-Moore link table +; BTable is array[0..255] of byte; + +MString EQU DWORD PTR SS:[BX+8] +BTable EQU DWORD PTR SS:[BX+4] + +BMMakeTable PROC FAR + + MOV BX,SP ;Set up stack frame + PUSH DS ;Save DS + CLD ;Go forward + + LDS SI,MString ;DS:SI => MatchString + LES DI,BTable ;ES:DI => BTabel + MOV BX,DI ;Save DI in BX + LODSB ;AL = length(MatchString) + MOV AH,AL ;Copy it to AH + MOV CX,128 ;Number of words in BT + REP STOSW ;Fill BT with length(MatchString) + CMP AL,1 ;Is length(MatchString) <= 1? + JBE MTDONE ;Yes, we're done + + MOV DI,BX ;Restore base of table from BX + MOV BH,CH ;BH = 0 + MOV CL,AL ;CX = length(MatchString) + DEC CX ;CX = length(MatchString)-1 + +MTnext: LODSB ;AL = MatchString[i] + MOV BL,AL ;BL = MatchString[i] + MOV ES:[BX+DI],CL ;BTable[char] = length(MatchString)-i + LOOP MTnext ;Repeat for all characters in MatchString + +MTDone: POP DS ;Restore DS from Stack + RET 8 ;Remove parameters and return + +BMMakeTable ENDP + +;****************************************************** BMSearch + +; function BMSearch(var Buffer; +; BufLength : Word; +; BT : BTable; +; MatchString : string) : Word; +; Search Buffer for MatchString +; Return FFFF for failure +; Else return number of bytes searched to find MatchString + +MString EQU DWORD PTR [BP+6] +BTable EQU DWORD PTR [BP+10] +BufSize EQU WORD PTR [BP+14] +Buffer EQU DWORD PTR [BP+16] +BufOfs EQU WORD PTR [BP+16] + +BMSearch PROC FAR + MOV AL,0 + JMP SHORT Search + +BMSearch ENDP + +;***************************************************** BMSearchUC + +; function BMSearchUC(var Buffer; +; BufLength : Word; +; BT : BTable; +; MatchString : string) : Word; +; Case-insensitive search of Buffer for MatchString +; Return FFFF for failure +; Else return number of bytes searched to find MatchString +; Assumes MatchString is already raised to uppercase + +BMSearchUC PROC FAR + MOV AL,1 +Search: PUSH BP + MOV BP,SP + PUSH AX ;BP-0 UpCase + PUSH DS ;Will wipe out DS + + MOV CX,BufSize ;CX = Buffer size + LES DI,Buffer ;ES:DI => Buffer + LDS BX,BTable ;DS:BX => BTable + MOV AX,DS ;Keep BTable segment in AX a moment + LDS SI,MString ;DS:SI => MatchString + PUSH AX ;Keep BTable segment in SS:BP-4 + + XOR AX,AX ;AX = 0 + MOV DX,AX ;DX = 0 + MOV DL,[SI] ;DL = length(MatchString) + OR DL,DL ;Check for trivial case + JZ BMSUnotFound ;Fail for empty string + +BMSUinit: + DEC DX ;DX = length(MatchString)-1 + ADD SI,DX ;DS:SI => MatchString[length(MatchString)-1] + ADD CX,DI ;CX = offset of last char in buffer + ADD DI,DX ;ES:DI => first position to search + MOV DH,[SI+1] ;DH = MatchString[length(MatchString)] + STD ;Go backwards + JMP SHORT BMSUcomp ;Skip link table first time + +BMSUnext: + PUSH DS ;Save DS a moment + MOV DS,SS:[BP-6] ;Get segment of link table + XLAT ;Get size of link at DS:[BX+AL] + POP DS ;Restore DS + ADD DI,AX ;Compute next place to search + +BMSUcomp: + CMP DI,CX ;At end of buffer? + JAE BMSUnotFound ;Done if so + MOV AL,ES:[DI] ;AL = next char to try + CALL Upc ;Raise it to uppercase + CMP DH,AL ;Does it match the end of MatchString? + JNE BMSUnext ;If not same, go back and try again + + PUSH CX ;Save end of buffer position + DEC DI ;Start comparing one character before + MOV CL,DL ;Compare length(MatchString)-1 characters + MOV CH,AH ;CH = 0 + JCXZ BMSUfound ;Completely matched if CX = 0 + +BMSUcomp2: + LODSB ;Next match character in AL + MOV AH,AL + MOV AL,ES:[DI] ;Next buffer character in AH + DEC DI ;Decrement buffer index + CALL Upc ;Uppercase it + CMP AH,AL ;A match? + LOOPE BMSUcomp2 ;Loop while AH=AL and CX<>0 + JE BMSUfound ;Matched! + + XOR AH,AH ;Restore SI,DI,AX + MOV AL,DL + SUB AL,CL + ADD SI,AX + ADD DI,AX + INC DI + MOV AL,DH ;Put matched char back in AL + POP CX ;Restore end of buffer + JMP SHORT BMSUnext ;Try again + +BMSUfound: ;DI points to start of match + INC SP ;End of buffer off stack + INC SP + SUB DI,BufOfs ;Subtract buffer start address + MOV AX,DI + INC AX ;Return 0 if found in first byte + JMP SHORT BMSUDone2 ;We're done + +BMSUnotFound: + MOV AX,0FFFFh ;Result = FFFF +BMSUDone: ;Result returned in AX +BMSUDone2: + CLD + POP DS + MOV SP,BP + POP BP + RET 14 + +BMSearchUC ENDP + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBCASE.ASM b/TKSTRING/ASM/HBCASE.ASM new file mode 100644 index 0000000..16557f0 --- /dev/null +++ b/TKSTRING/ASM/HBCASE.ASM @@ -0,0 +1,129 @@ +;****************************************************** +; HBCASE.ASM V 1.0 +; String handling routines +; Copyright (c) by HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC Upcase, Locase, UpString, LoString + + +UpUmlaut LABEL BYTE + DB 20h,'AZ' +LoUmlaut LABEL BYTE + DB 0E0h,'az' +Umlaut2 LABEL BYTE + DB 20h,'AZ' +AnzUmlaut EQU LoUmlaut-UpUmlaut + +;****************************************************** Upcase + +;funktion UpCase(c:Char); + +C EQU [BP+8] + +Upcase proc far + PUSH DI + MOV DI,Offset LoUmlaut+1 + +Case: PUSH BP + MOV BP,SP + PUSH ES + PUSH CS + POP ES + MOV AL,C + CLD + SCASB + JB NoChange + SCASB + JA UmlautChange + ADD AL,ES:[DI-3] + JMP SHORT NoUmlaut1 + +NoChange: + INC DI +UmlautChange: + PUSH CX + MOV CX,AnzUmlaut-3 ;Wieviel ?? + REPNE SCASB + JNE NoUmlaut + MOV AL,ES:[DI+AnzUmlaut-1] +NoUmlaut: + POP CX +NoUmlaut1: + POP ES + POP BP + POP DI + RET 2 +UpCase ENDP + +;****************************************************** Locase + +;funktion LoCase(c:Char); + +Locase proc far + PUSH DI + MOV DI,Offset UpUmlaut+1 + JMP SHORT Case +Locase ENDP + + +;****************************************************** StUpcase + +;function UpString(S : string) : string; +;Convert lower case letters in string to upper case. + +UpString PROC FAR + MOV DX,OFFSET Upcase + +UP_LO: + MOV BX,SP ;set up stack frame + CLD ;go forward + PUSH DS ;Save DS + LDS SI,SS:[BX+4] ;DS:SI => S + LES DI,SS:[BX+8] ;ES:DI => function result + LODSB ;AL = Length(S) + STOSB ;Set length of result + MOV CH,0 ;CH = 0 + MOV CL,AL ;CX = Length(S) + JCXZ SUDone ;Done if CX is 0 +SUNext: + LODSB ;Next char into AL + PUSH AX + PUSH CS + CALL DX + STOSB ;Store char in result + LOOP SUNext ;repeat +SUDone: + POP DS ;Restore DS + RET 4 ;remove parameter and return + +UpString ENDP + +;****************************************************** StLocase + +;function LoString(S : string) : string; +;Convert upper case letters in string to lower case + +LoString PROC FAR + MOV DX,OFFSET Locase + JMP SHORT UP_LO +LoString ENDP + + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBCLRSTR.ASM b/TKSTRING/ASM/HBCLRSTR.ASM new file mode 100644 index 0000000..516ae99 --- /dev/null +++ b/TKSTRING/ASM/HBCLRSTR.ASM @@ -0,0 +1,47 @@ +;****************************************************** +; HBCLRSTR.ASM V 1.0 +; String handling routines +; Copyright (c) by HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC ClrStr + +;****************************************************** ClrStr + +;procedure ClrStr(var S : String; LEN : Byte); + +ClrStr PROC FAR +;Prozedur zum lschen einer Zeichkette +;Zerstrt Register AL, BX, CX, DI,ES +S equ ss:[BX+6] +Len equ ss:[BX+4] + + MOV BX,SP + CLD + LES DI,S + XOR CX,CX + MOV AL,Len + MOV CL,AL + STOSB + MOV AL,' ' + REP STOSB + RET 6 +ClrStr ENDP + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBCOMP1.ASM b/TKSTRING/ASM/HBCOMP1.ASM new file mode 100644 index 0000000..1821a11 --- /dev/null +++ b/TKSTRING/ASM/HBCOMP1.ASM @@ -0,0 +1,144 @@ +;****************************************************** +; HBCOMP1.ASM V 1.0 +; String handling routines +; Copyright (c) HB-Soft 1991. +; All rights reserved. +;****************************************************** + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC CompString, CompUCString, CompStruct + + EXTRN UpCase : FAR + +;****************************************************** Comp1_UP + +Comp1_UP PROC NEAR + REPE CMPSB ;Compare until no match or CX = 0 + RET +Comp1_UP ENDP + +;****************************************************** Comp2_UP + +Comp2_UP PROC NEAR +Start: LODSB ;S1[?] into AL + PUSH AX + Call UpCase ;AL=upcase(AL) + MOV AH,AL + +Skip1: MOV AL,ES:[DI] ;S2[?] into AL + INC DI ;Point ES:DI to next char in S2 + PUSH AX + Call UpCase + +Skip2: CMP AH,AL ;Compare until no match + LOOPE Start + + RET +Comp2_UP ENDP + +;****************************************************** CompString + +; function CompString(s1, s2 : string) : CompareType; +; {-Return 0, 1, 2 if s1s2} + +CompString PROC FAR + MOV DX,OFFSET Comp1_UP +CompStr: + MOV BX,SP ;Set up stack frame + PUSH DS ;Save DS + + CLD ;Go forward + LES DI,SS:[BX+4] ;ES:DI points to S2 + LDS SI,SS:[BX+8] ;DS:SI points to S1 + + MOV AH,ES:[DI] ;AH = Length(S2) + INC DI ;DI points to S2[1] + LODSB ;AL = Length(S1) + ;SI points to S1[1] + + XOR BX,BX ;BX holds temporary result + XOR CX,CX ;CX holds count of chars to compare + + MOV CL,AL ;Length(S1) in CL + CMP AL,AH ;Compare lengths + JE EqLen ;Lengths equal ? + JB Comp ;Jump if S1 shorter than S2 + + INC BX ;S1 longer than S2 + MOV CL,AH ;Length(S2) in CL + +EqLen: INC BX ;Equal or greater + +Comp: JCXZ Done ;Done if either is empty + + CALL DX ;Call Compare Procedure + + JE Done ;If Equal, result ready based on length + + MOV BL,2 + JA Done ;S1 Greater? Return 2 + XOR BX,BX ;Else S1 Less, Return 0 + +Done: MOV AX,BX ;Result into AX + POP DS ;Restore DS + RET 8 ;Remove parameters and return + +CompString ENDP + +;****************************************************** CompUCString + +; function CompUCString(s1, s2 : string) : CompareType; +; {-Return 0, 1, 2 if s1s2} +; {-Comparison is done in uppercase} + +CompUCString PROC FAR + MOV DX,OFFSET Comp2_UP + JMP SHORT CompStr +CompUCString ENDP + + +;****************************************************** CompStruct + +; function CompStruct(var s1, s2; size : word) : CompareType; +; {-Compare two fixed size structures} + +CompStruct PROC FAR + + MOV BX,SP ;Set up stack frame + PUSH DS ;Save DS + MOV AX,1 ;BX holds temporary result (Equal) + + MOV CX,SS:[BX+4] ;Size in CX + JCXZ CSDone ;Make sure size isn't zero + + CLD ;Go forward + LES DI,SS:[BX+6] ;ES:DI points to S2 + LDS SI,SS:[BX+10] ;DS:SI points to S1 + + REPE CMPSB ;Compare until no match or CX = 0 + JE CSDone ;If Equal, result ready based on length + + INC AX ;Prepare for Greater + JA CSDone ;S1 Greater? Return 2 + XOR AX,AX ;Else S1 Less, Return 0 + +CSDone: POP DS ;Restore DS + RET 10 ;Remove parameters and return + +CompStruct ENDP + + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBCOMP2.ASM b/TKSTRING/ASM/HBCOMP2.ASM new file mode 100644 index 0000000..2b477f2 --- /dev/null +++ b/TKSTRING/ASM/HBCOMP2.ASM @@ -0,0 +1,243 @@ +;****************************************************** +; TPCOMP.ASM 4.03 +; String handling routines +; Copyright (c) TurboPower Software 1987. +; Portions copyright (c) Sunny Hill Software 1985, 1986 +; and used under license to TurboPower Software +; All rights reserved. +;****************************************************** + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + + EXTRN LetterValues : BYTE ;Table of letter values + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC Soundex, MakeLetterSet, CompareLetterSets + + EXTRN UpCase : FAR + +;****************************************************** Soundex + +; function Soundex(s : string) : string; +; {-Return 4 character soundex of input string} + +;256 byte lookup table ASCII ==> soundex code +SoundExTable label byte + db 65 dup(0) +; A B C D E F G H I J K L M N O P Q R S T U V W X Y Z + db 0,'1','2','3',0,'1','2',0,0,'2','2','4','5','5',0,'1','2','6','2','3',0,'1',0,'2',0,'2' + db 6 dup(0) +; a b c d e f g h i j k l m n o p q r s t u v w x y z + db 0,'1','2','3',0,'1','2',0,0,'2','2','4','5','5',0,'1','2','6','2','3',0,'1',0,'2',0,'2' + db 102 dup(0) +; behandle wie S + db '2' + db 30 dup(0) + +;Parameter and function result + Result EQU DWORD PTR [BP+10] + Input EQU DWORD PTR [BP+6] + +Soundex PROC FAR + + PUSH BP + MOV BP,SP + PUSH DS + CLD + + LES DI,Result ;ES:DI => function result + MOV AL,4 + STOSB ;Result will be 4 characters long + MOV BX,DI ;Store output position in BX + XOR AX,AX ;Store four '0's in output + STOSW + STOSW ;Initialize to zeros + MOV DI,BX ;Reset output position + + LDS SI,Input ;DS:SI => Input string + LODSB ;Length byte into AL + MOV CX,AX ;Length into CX + JCXZ SXDone ;We're done if null string + LODSB ;Get first character of input + PUSH AX + CALL UpCase ;Uppercase it + STOSB ;Store first output character + DEC CX ;One input character used + JCXZ SXDone ;Done if one character string + + MOV AH,AL ;Save previous character + MOV DX,0401h ;DL has output length, DH max output length + XOR BH,BH ;Prepare BX for indexing + +SXNext: + LODSB ;Next character into AL + MOV BL,AL ;Set up base register + MOV AL,CS:SoundexTable[BX] ;Get soundex code into AL + OR AL,AL ;Null soundex code? + JZ SXNoStore ;Don't store it + CMP AH,AL ;Code same as previous output? + JZ SXNoStore ;Don't store it + STOSB ;Store to output + INC DL ;Output length increased by one + CMP DL,DH ;Check output length + JAE SXDone ;Stop at four chars of output + MOV AH,AL ;Store previous output character + +SXNoStore: + LOOP SXNext + +SXDone: + POP DS + POP BP + RET 4 ;Leave result pointer on stack + +Soundex ENDP + +;****************************************************** MakeLetterSet + +;function MakeLetterSet(S : string) : LongInt; +;Return a bit-mapped long storing the individual letters contained in S. + +MLSstr EQU DWORD PTR SS:[BX+4] + +MakeLetterSet PROC FAR + + MOV BX,SP ;Set up stackframe + PUSH BP ;Save BP + PUSH DS ;Save DS + XOR DI,DI ;DI = 0 + MOV AX,DI ;AX = 0 + CLD ;Go forward + LDS SI,MLSstr ;DS:SI => string + LODSB ;AX = Length(S) + MOV CX,AX ;CX = Length(S) + MOV BX,DI ;DI:BX = 0 + JCXZ MLSexit ;Done if CX is 0 + +MLSnext: + MOV AH,0 ;AH = 0 + LODSB ;AL has next char in S + PUSH AX + Call UpCase + CMP AX,142 ;Check + JNE MLSF1 + MOV AX,26 + JMP MLSFound +MLSF1: CMP AX,153 ;Check + JNE MLSF2 + MOV AX,27 + JMP MLSFound +MLSF2: CMP AX,154 ;Check + JNE MLSF3 + MOV AX,28 + JMP MLSFound +MLSF3: CMP AX,225 ;Check + JNE MLSF4 + MOV AX,29 + JMP MLSFound +MLSF4: + SUB AX,'A' ;Convert to bit number + CMP AX,'Z'-'A' ;Was char in range 'A'..'Z'? + JA MLSskip ;Skip it if not + +MLSFound: + XCHG CX,AX ;CX = bit #, AX = loop count + XOR DX,DX ;DX:AX = 1 + MOV BP,1 + JCXZ MLSnoShift ;don't shift if CX is 0 + +MLSshift: ;DX:BP = 1 shl BitNumber + SHL BP,1 ;shift low word + RCL DX,1 ;shift high word + LOOP MLSshift ;repeat + +MLSnoshift: + OR DI,DX ;DI:BX = DI:BX or DX:BP + OR BX,BP + MOV CX,AX ;Restore CX from AX + +MLSskip: + LOOP MLSnext ;Get next character + +MLSexit: + MOV DX,DI ;DX:AX = DI:BX + MOV AX,BX + JMP SHORT SXDONE +; POP DS ;Restore DS +; POP BP ;Restore BP +; RET 4 ;Remove parameter and return + +MakeLetterSet ENDP + +;****************************************************** CompareLetterSets + +;function CompareLetterSets(Set1, Set2 : LongInt) : Word; +;Returns the sum of the values of the letters common to Set1 and Set2. + +Set1 EQU DWORD PTR SS:[BX+4] +Set2Hi EQU WORD PTR SS:[BX+6] +Set2Lo EQU WORD PTR SS:[BX+8] + +CompareLetterSets PROC FAR + + MOV BX,SP ;Set up stack frame + PUSH BP ;Save BP + + LES DI,Set1 ;Set1 in ES:DI + MOV SI,ES ;Set1 in SI:DI + AND DI,Set2Lo ;SI:DI = Set1 and Set2 + AND SI,Set2Hi + + XOR BP,BP ;BP = 0 + MOV CX,('Z'-'A')+1+4 ;Loop count (incl. Umlaute) + +CLSnext: + MOV BX,CX ;save CX in BX + XOR DX,DX ;DX:AX = 1 + MOV AX,1 + DEC CX ;subtract 1 to get bit number + JZ CLSnoShift ;don't shift if CX is 0 + +CLSshift: ;DX:AX = 1 shl BitNumber + SHL AX,1 ;shift low word + RCL DX,1 ;shift high word + LOOP CLSshift ;repeat + +CLSnoshift: + MOV CX,BX ;restore CX from BX + AND AX,DI ;DX:AX = DX:AX and SI:DI + AND DX,SI + OR AX,DX ;DX:AX = 0? + JNZ CLSadd ;if not, add letter value + LOOP CLSnext ;else, next element + JMP SHORT CLSexit ;done + +CLSadd: + ;AX has value of the letter + MOV AX,CX ;AL = loop count + DEC AX ;convert to index into table + MOV BX,Offset LetterValues ;DS:BX points to LetterValues + XLAT ;AL has value of the letter + ADD BP,AX ;add to result + LOOP CLSnext ;next element + +CLSexit: + MOV AX,BP ;Function result into AX + POP BP ;Restore BP + RET 8 ;Remove parameters and return + +CompareLetterSets ENDP + + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBDATEST.ASM b/TKSTRING/ASM/HBDATEST.ASM new file mode 100644 index 0000000..fa53859 --- /dev/null +++ b/TKSTRING/ASM/HBDATEST.ASM @@ -0,0 +1,73 @@ +;****************************************************** +; HBDATEST.ASM V 1.0 +; String handling routines +; Copyright (c) HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC DateStr + +;-------------------------------------------------------- +;FUNCTION DateStr : String; + +DateStr PROC FAR + MOV BX,SP + +;** Parameterbernahme ** + LES DI,SS:[BX+4] ;ES:DI := @Output-String + CLD + + MOV AL,8 + STOSB ;DateStr[0] := Stinglnge + +;** Datum ber DOS ermitteln ** + MOV AH,2AH + INT 21H + +;** Werte in Zeichkette wandeln ** +;** DL = Tage, DH = Monat, CX = Jahr + MOV AL,DL + CALL DateUP + MOV AL,'.' + STOSB + MOV AL,DH + CALL DateUP + MOV AL,'.' + STOSB + MOV AX,CX + MOV BL,100 + DIV BL + MOV AL,AH + CALL DateUP + + RET + + +DateUP PROC NEAR + MOV AH,0 + MOV BL,10 + DIV BL + OR AX,3030H + STOSW + RET +DateUP ENDP + +DateStr ENDP + + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBHEX.ASM b/TKSTRING/ASM/HBHEX.ASM new file mode 100644 index 0000000..102ca69 --- /dev/null +++ b/TKSTRING/ASM/HBHEX.ASM @@ -0,0 +1,92 @@ +;****************************************************** +; HBHEX.ASM V 1.0 +; String handling routines +; Copyright (c) HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC HexB, HexW, HexL, HexPtr + +;-------------------------------------------------------- +;FUNCTION HexW(W : Word) : String; +HexW PROC FAR + MOV AL,4 +HexW1: MOV BX,8 + CALL HexUP + RET 2 +HexW ENDP + +;-------------------------------------------------------- +;FUNCTION HexPtr(P : Pointer) : String; +HexPtr PROC FAR + MOV AL,9 +HexP1: MOV BX,10 + CALL HexUP + RET 4 +HexPtr ENDP + +;------------------------------------------------------ +;FUNCTION HexB(B : Byte) : String; +HexB PROC FAR + MOV AL,2 + JMP SHORT HexW1 +HexB ENDP + +;-------------------------------------------------------- +;FUNTION HexL(L : LongInt) : String; +HexL PROC FAR + MOV AL,8 + JMP SHORT HexP1 +HexL ENDP + +;-------------------------------------------------------- +HexUP PROC NEAR + ADD BX,SP ;BX = Pointer auf Parameter + LES DI,SS:[BX] ;ES:DI := Adresse Output-String +HexUPB: CLD ;Stringoperationen vorwrts + STOSB ;Stringlnge => Output-String + MOV CH,AL ;CH: zhlt auszugebende Hex-Digits + CMP AL,2 ;HexB ? + JNZ HexUP0 + DEC BX ; ja => Pointer-1 +HexUP0: CMP CH,5 ;IF HexPtr ? + JNZ HexUP3 ; THEN + MOV AL,':' ; ':' ausgeben + STOSB + DEC CH +HexUP3: DEC BX ;Pointer-1 + MOV AL,SS:[BX] ;zu konvertierendes Byte lesen + MOV AH,AL + MOV CL,4 + SHR AH,CL ;AH := hherwertigem Halbbyte + AND AL,0FH ;AL := niederwertigem Halbbyte + OR AX,3030H ;AH u. AL in Zeichen wandeln + CMP AL,'9' ;AL > '9' ? + JBE HexUP1 + ADD AL,'A'-3AH ; ja => in Zeichen von 'A' bis 'F' +HexUP1: XCHG AL,AH + CMP AL,'9' ;AH > '9' ? + JBE HexUP2 + ADD AL,'A'-3AH ; ja => in Zeichen von 'A' bis 'F' +HexUP2: STOSW + SUB CH,2 + JNZ HexUP0 ;Byte-Anz = 0 ?, ja=>Ende, nein=>weiter + RET +HEXUP ENDP + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBLEFTP.ASM b/TKSTRING/ASM/HBLEFTP.ASM new file mode 100644 index 0000000..d3b6b85 --- /dev/null +++ b/TKSTRING/ASM/HBLEFTP.ASM @@ -0,0 +1,82 @@ +;****************************************************** +; HBLEFTP.ASM V 1.0 +; String handling routines +; Copyright (c) by HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC LeftPadCh, LeftPad + +;****************************************************** + +LeftPad_Up PROC NEAR + MOV CL,[BP+6] ;CL := LEN + CLD + LODSB ;S => OUTPUT STRING, AL := LENGTH(S) + MOV CH,0 + MOV AH,CL ;AH := LEN + XCHG AL,AH ;AL := LEN, AH := LENGTH(S) + SUB CL,AH ;CL := LEN - LENGTH(S) + JNBE LPADCH + MOV CL,0 + MOV AL,AH +LPADCH: STOSB + MOV AL,BL ;AL := C + REP STOSB + + MOV CL,AH + REP MOVSB + + RET +LeftPad_Up ENDP + +;****************************************************** PadCh + +;function LeftPadCh(S : String; C : Char; Len : Byte) : String; + +LeftPadCh PROC FAR + PUSH BP + MOV BP,SP + PUSH DS + LES DI,[BP+14] ;ES:DI := OUTPUT STRING + LDS SI,[BP+10] ;DS:SI := S + MOV BL,[BP+8] ;BL := C + CALL LeftPad_UP + POP DS + POP BP + RET 8 +LeftPadCh ENDP + +;****************************************************** Pad + +;function LeftPad(S : String; Len : Byte) : String; + +LeftPad PROC FAR + PUSH BP + MOV BP,SP + PUSH DS + LES DI,[BP+12] ;ES:DI := Output String + LDS SI,[BP+8] ;DS:SI := S + MOV BL,' ' + CALL LeftPad_Up + POP DS + POP BP + RET 6 +LeftPad ENDP + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBPAD.ASM b/TKSTRING/ASM/HBPAD.ASM new file mode 100644 index 0000000..210e08a --- /dev/null +++ b/TKSTRING/ASM/HBPAD.ASM @@ -0,0 +1,80 @@ +;****************************************************** +; HBPAD.ASM V 1.0 +; String handling routines +; Copyright (c) by HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC PadCh, Pad + +;****************************************************** + +Pad_Up PROC NEAR + MOV CL,[BP+6] ;CL := LEN - LENGTH(S) + CLD + LODSB ;S => OUTPUT STRING + MOV CH,0 + XCHG CL,AL + MOV AH,AL + SUB AH,CL + JNBE PADCH1 + MOV AH,0 +PADCH1: STOSB + REP MOVSB + + MOV CL,AH + MOV AL,BL ;AL := C + REP STOSB + RET +Pad_Up ENDP + +;****************************************************** PadCh + +;function PadCh(S : String; C : Char; Len : Byte) : String; + +PadCh PROC FAR + PUSH BP + MOV BP,SP + PUSH DS + LES DI,[BP+14] ;ES:DI := OUTPUT STRING + LDS SI,[BP+10] ;DS:SI := S + MOV BL,[BP+8] ;BL := C + CALL Pad_UP + POP DS + POP BP + RET 8 +PadCh ENDP + +;****************************************************** Pad + +;function Pad(S : String; Len : Byte) : String; + +Pad PROC FAR + PUSH BP + MOV BP,SP + PUSH DS + LES DI,[BP+12] ;ES:DI := Output String + LDS SI,[BP+8] ;DS:SI := S + MOV BL,' ' + CALL Pad_Up + POP DS + POP BP + RET 6 +Pad ENDP + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBSEARCH.ASM b/TKSTRING/ASM/HBSEARCH.ASM new file mode 100644 index 0000000..fb40f30 --- /dev/null +++ b/TKSTRING/ASM/HBSEARCH.ASM @@ -0,0 +1,153 @@ +;****************************************************** +; HBSEARCH.ASM V 1.0 +; String handling routines +; Copyright (c) Heiko Becker, HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC Search, SearchUC + + EXTRN UpCase : FAR + +Upc PROC NEAR + PUSH AX + CALL UpCase + RET +Upc ENDP + +;****************************************************** Search + +;function Search(var Buffer; BufLength : Word; +; var Match; MatLength : Word) : Word; + +;Search through Buffer for Match. +;BufLength is length of range to search. +;MatLength is length of string to match. +;Returns number of bytes searched to find Match, 0FFFFh if not found. + +;equates for parameters: +MatLength EQU WORD PTR [BP+6] +Match EQU DWORD PTR [BP+8] +BufLength EQU WORD PTR [BP+12] +Buffer EQU DWORD PTR [BP+14] + +Search PROC FAR + MOV BL,0 + JMP SHORT SUp +Search ENDP + +;****************************************************** SearchUC + +;function SearchUC(var Buffer; BufLength : Word; +; var Match; MatLength : Word) : Word; + +;Search through Buffer for Match (CASE-INSENSITIVE) +;BufLength is length of range to search. +;MatLength is length of string to match. +;Returns number of bytes searched to find Match, 0FFFFh if not found. + +SearchUC PROC FAR + MOV BL,1 + +SUp: PUSH BP ;Save BP + MOV BP,SP ;Set up stack frame + PUSH DS ;Save DS + CLD ;Go forward + + MOV CX,BufLength ;CX = Length of range to scan + MOV DX,MatLength ;DX = Length of match string + + LDS SI,Match ;DS:SI => Match buffer + LES DI,Buffer ;ES:DI => Buffer + MOV BP,DI ;BP = Ofs(Buffer) + + OR DX,DX ;Length(Match) = 0? + JZ Error ;If so, we're done + + LODSB ;AL = Match[1]; DS:SI => Match[2] + OR BL,BL ;IF SearchUC ? + JZ NotUC1 + CALL Upc ;Uppercase it + MOV AH,AL +NotUC1: + DEC DX ;DX = MatLength-1 + SUB CX,DX ;CX = BufLength-(MatLength-1) + JBE Error ;No match if BufLength is less + +;Search for first character in Match +Next: OR BL,BL ;IF SearchUC (BL<>0) + JZ NotUC2 +SUCNext:MOV AL,ES:[DI] ;Get next character of buffer + INC DI ;To next position + CALL Upc ;Uppercase it + CMP AH,AL ;A match? + LOOPNE SUCNext ;Loop while CX<>0 and AH<>AL + JMP SHORT Next1 +NotUC2: REPNE SCASB ;Search forward for Match[1] +Next1: JNE Error ;Done if not found + OR DX,DX ;If Length = 1 (DX = 0) ... + JZ Found ; the "string" was found + + ;Search for remainder of Match + + PUSH AX ;Save AX + PUSH CX ;Save CX + PUSH DI ;Save DI + PUSH SI ;Save SI + + MOV CX,DX ;CX = Length(Match) - 1 + + OR BL,BL ;IF SearchUC (BL<>0) ? + JZ NotUC3 +SUCNextM: + LODSB ;Next match character in AL + CALL Upc ;Uppercase it + MOV AH,AL + MOV AL,ES:[DI] ;Next buffer character in AH + INC DI ;Increment index + CALL Upc ;Uppercase it + CMP AH,AL ;A match? + LOOPE SUCNextM ;Loop while AH=AL and CX<>0 + JMP SHORT Next2 +NotUC3: REPE CMPSB + +Next2: POP SI ;Restore SI + POP DI ;Restore DI + POP CX ;Restore CX + POP AX ;Restore AX + + JNE Next ;Try again if no match + +;Calculate number of bytes searched and return +Found: DEC DI ;DX = Offset where found + MOV AX,DI ;AX = Offset where found + SUB AX,BP ;Subtract starting offset + JMP SHORT Done ;Done + +;Match was not found +Error: XOR AX,AX + DEC AX ;Return FFFF + +Done: POP DS ;Restore DS + POP BP + RET 12 + +SearchUC ENDP + + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBTAB.ASM b/TKSTRING/ASM/HBTAB.ASM new file mode 100644 index 0000000..5ca0d9d --- /dev/null +++ b/TKSTRING/ASM/HBTAB.ASM @@ -0,0 +1,174 @@ +;****************************************************** +; HBTAB.ASM V 1.1 +; String handling routines +; Copyright (c) HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC Entab, Detab + +RS EQU DWORD PTR [BP+12] ;Result string +TS EQU DWORD PTR [BP+8] ;Input string +TabSize EQU BYTE PTR [BP+6] ;TabSize + +;****************************************************** Entab_Up + +Entab_Up PROC NEAR + XOR BX,BX ;Initial SpaceCount = 0 + INC CH ;Current input position=1 + +ETNext: OR BL,BL ;Compare SpaceCount to 0 + JE ETNoTab ;If SpaceCount=0 then no tab insert here + MOV AL,CH ;Ipos to AL + XOR AH,AH ;AX has Ipos + DIV DH ;Ipos DIV TabSize + DEC AH ;Ipos MOD TabSize = 1 ? + JNZ ETNoTab ;If not, no tab insert here + SUB DL,BL ;Reduce Olen by SpaceCount + SUB DI,BX ;Remove unused characters from output string + MOV AL,09 + STOSB ;Store a tab + INC DX ;Add one to output length + XOR BX,BX ;Reset SpaceCount +ETNoTab: + LODSB ;Get next input character + INC BX ;Increment SpaceCount + CMP AL,32 ;Is character a space? + JZ ETstore ;Yes, store it for now + XOR BX,BX ;Reset SpaceCount + CMP AL,39 ;Is it a quote? + JZ ETquotes ;Yep, enter quote loop + CMP AL,34 ;Is it a doublequote? + JNZ ETstore ;Nope, store it + +ETquotes: + MOV AH,AL ;Save quote start +ETnextQ: + STOSB ;Store quoted character + INC DX ;Increment output length + LODSB ;Get next character + INC CH ;Increment Ipos + CMP CH,CL ;At end of line? + JAE ETstore ;If so, exit quote loop + CMP AL,AH ;Matching end quote? + JNZ ETnextQ ;Nope, stay in quote loop + CMP AL,39 ;Single quote? + JZ ETstore ;Exit quote loop + CMP BYTE PTR [SI-2],'\' ;Previous character an escape? + JZ ETnextQ ;Stay in if so + +ETstore: + STOSB ;Store last character + INC DX ;Increment output length + INC CH ;Increment input position + JZ ETstoreLen ;Exit if past 255 + CMP CH,CL ;Compare Ipos to Ilen + JBE ETNext ;Repeat while characters left + +ETstoreLen: + JMP SHORT TstoreLen +Entab_Up ENDP + +;****************************************************** Detab_UP + +Detab_Up PROC NEAR + MOV AH,09 ;Store tab in AH + MOV BL,255 ;Maximum length of output + +DTNext: LODSB ;Next input character + CMP AL,AH ;Is it a tab ? + JE DTTab ;Yes, compute next tab stop + STOSB ;No, store to output + INC DL ;Increment output length + CMP DL,BL ;255 characters max + LOOPNE DTNext ;Next character while Olen <= 255 + JMP SHORT DTStoreLen ;Loop termination + +DTTab: MOV BH,CL ;Save input counter + MOV AL,DL ;Current output length in AL + XOR AH,AH ;Clear top byte + DIV DH ;OLen DIV TabSize in AL + INC AL ;Round up to next tab position + MUL DH ;Next tab position in AX + OR AH,AH ;AX > 255? + JNE DTStoreLen ;Can't store it + SUB AL,DL ;Count of blanks to insert + ADD DL,AL ;New output length in DL + MOV CL,AL ;Loop counter for blanks + MOV AX,0920h ;Tab in AH, Blank in AL + REP STOSB ;Store blanks + MOV CL,BH ;Restore input position + LOOP DTNext ;Back for next input + +DTStoreLen: + JMP SHORT TstoreLen +Detab_Up ENDP + +;****************************************************** Entab + +; function Entab(S : string; TabSize : Byte) : string; +; {-Convert blanks in a string to tabs on spacing TabSize} + + +Entab PROC FAR + MOV BX,OFFSET Entab_Up +TabPr: PUSH BP + MOV BP,SP + PUSH DS + CLD + + XOR CX,CX ;Default input length = 0 + XOR DX,DX ;Default output length = 0 in DL + MOV DH,TabSize ;DH will hold TabSize + + LDS SI,TS ;DS:SI => input string + LES DI,RS ;ES:DI => output string + LODSB ;Get input length + OR DH,DH ;TabSize = 0 ? + JNZ TDefLength + XOR AL,AL ;Return zero length string if TabSize = 0 +TDefLength: + MOV CL,AL ;Store length in counter + STOSB ;Store default output length + JCXZ Tdone ;Done if empty input string + + JMP BX ;Select Tab Procedure + +TstoreLen: + LDS DI,RS ;ES:DI => output string + MOV [DI],DL ;Store final length + +Tdone: + POP DS + MOV SP,BP + POP BP + RET 6 ;Leave result pointer on stack +Entab ENDP + +;****************************************************** Detab + +; function Detab(S : string; TabSize : Byte) : string; +; {-Expand tabs in a string to blanks on spacing TabSize} + +Detab PROC FAR + MOV BX,OFFSET Detab_Up + JMP SHORT TabPr +Detab ENDP + + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBTIMEST.ASM b/TKSTRING/ASM/HBTIMEST.ASM new file mode 100644 index 0000000..73da464 --- /dev/null +++ b/TKSTRING/ASM/HBTIMEST.ASM @@ -0,0 +1,116 @@ +;****************************************************** +; HBTIMEST.ASM V 1.0 +; String handling routines +; Copyright (c) HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC TimeStr + +;-------------------------------------------------------- +;FUNCTION TimeStr(TimeMS:LongInt; hmsh:Byte) : String; +; {-Gibt TimeMs (Zeit in Millisekunden) formatiert aus +; hmsh=1: nur Stunden +; 2: HH:MM +; 3: HH:MM:SS +; 4: HH:MM:SS.hh } +TimeStr PROC FAR + PUSH BP ;BEGIN {FUNCTION TimeStr} + MOV BP,SP + +;** Parameterbernahme ** + MOV AL,[BP+6] ; CL := HMSH + LES BX,[BP+8] ; DX:BX := TimeMS + MOV DX,ES + LES DI,[BP+12] ; ES:DI := @Output-String + +;** Prfung des Parameters HMSH + CLD + CMP AL,4 + JBE TS2 + MOV AL,0 +TS2: MOV CL,AL + SHL AL,1 + ADD AL,CL + JZ TS1 + DEC AX +TS1: STOSB ; TimeStr[0]:=Stringlnge + JZ TEnd + +;** Stunden berechnen ** + XOR AX,AX ; AX = Stundenzhler + MOV SI,0EE80H +SB1: INC AX + SUB BX,SI + SBB DX,0036H + JNC SB1 + ADD BX,SI + ADC DX,0036H + DEC AX + PUSH BX + MOV CH,':' + CALL TUP1 + POP AX + +;** Minuten berechen ** + MOV BX,60000 + CALL TUP + +;** Sekunden berechnen ** + MOV BX,1000 + MOV CH,'.' + CALL TUP + +;** Hundertstel berechnen ** + MOV BX,10 + CALL TUP + +TEnd: MOV DI,[BP+12] + INC DI + CMP BYTE PTR ES:[DI],'0' + JNE SB2 + MOV AL,' ' + STOSB +SB2: MOV SP,BP + POP BP + RET 6 + +TUP PROC NEAR + DIV BX + CALL TUP1 + MOV AX,DX + XOR DX,DX + RET +TUP ENDP + +TUP1 PROC NEAR + MOV BH,10 + DIV BH + OR AX,3030H + STOSW + DEC CL + JZ TEnd + MOV AL,CH + STOSB + RET +TUP1 ENDP + +TimeStr ENDP + + +CODE ENDS + + END diff --git a/TKSTRING/ASM/HBTRIM.ASM b/TKSTRING/ASM/HBTRIM.ASM new file mode 100644 index 0000000..d68e460 --- /dev/null +++ b/TKSTRING/ASM/HBTRIM.ASM @@ -0,0 +1,124 @@ +;****************************************************** +; HBTRIM.ASM V 1.0 +; String handling routines +; Copyright (c) by HB-Soft 1991. +; All rights reserved. +;****************************************************** + + +;****************************************************** Data + +DATA SEGMENT WORD PUBLIC + +DATA ENDS + +;****************************************************** Code + +CODE SEGMENT BYTE PUBLIC + + ASSUME CS:CODE,DS:DATA + + PUBLIC LTrim, RTrim, Trim + +;****************************************************** + +LT_UP PROC NEAR +;DS:SI - Quell String +;ES:DI - Ziel String + LES DI,[BP+6] ;ES:DI := S + MOV CL,ES:[DI] ;CX := LENGTH(S) + MOV CH,0 + INC DI + JCXZ LT_UP1 + CLD + MOV AL,' ' + REPE SCASB ;suchen bis kein Leerzeichen + JE LT_UP1 + INC CX + MOV AL,CL + DEC DI + MOV SI,DI ;DS:SI := S + PUSH ES + POP DS +LT_UP1: LES DI,[BP+10] ;ES:DI := Output String + MOV AL,CL + STOSB ;Output String := Lnge + REP MOVSB ;String kopieren + RET +LT_UP ENDP + +;****************************************************** + +RT_UP PROC NEAR + LES DI,[BP+10] + PUSH DI + MOV CL,ES:[DI] + MOV CH,0 + ADD DI,CX + JCXZ RT_UP1 + MOV AL,' ' + STD + REPE SCASB + JE RT_UP1 + INC CX +RT_UP1: POP DI + MOV ES:[DI],CL + RET +RT_UP ENDP + +;****************************************************** LTrim + +;function LTrim(S : String) : String; + +LTrim PROC FAR + PUSH BP + MOV BP,SP + PUSH DS + CALL LT_UP + POP DS + POP BP + RET 4 +LTrim ENDP + +;****************************************************** RTrim + +;function RTrim(S : String) : String; + +RTrim PROC FAR + PUSH BP + MOV BP,SP + PUSH DS + LES DI,[BP+10] ;ES:DI := Output String + LDS SI,[BP+6] ;DS:SI := S + LODSB + MOV CL,AL + MOV CH,0 + STOSB + REP MOVSB + CALL RT_UP + POP DS + POP BP + RET 4 +RTrim ENDP + +;****************************************************** Trim + +;function Trim(S : String) : String; + +Trim PROC FAR + PUSH BP + MOV BP,SP + PUSH DS + CALL LT_UP + CALL RT_UP + POP DS + POP BP + RET 4 +Trim ENDP + +;****************************************************** + + +CODE ENDS + + END diff --git a/TKSTRING/HBBINARY.OBJ b/TKSTRING/HBBINARY.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..b533f32cb7214cd6b49e295a3c4e7e8be09e412d GIT binary patch literal 102 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+P-I{NvKFW^FflO1MMQ38 zh>nV9XA2JqQ|sV;%=ef1=fzhSZ*P#eaADP>ucxO^;ALQ7VsrBJa}0`PU|^Wm1=Ljn E0JfeS0RR91 literal 0 HcmV?d00001 diff --git a/TKSTRING/HBBM.OBJ b/TKSTRING/HBBM.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..a80ad7c1e6a8cf083195f502de18559dee0dd452 GIT binary patch literal 333 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+*vG)c$XMRP$-ovG;OrRe z%CKa?AqFM}hK9O-jHPS=vlxKjaQ7X#KW0bEIn0jKvvl8I)Ae9y1H>3Wo!Y)2f8nGiEv#i z3H4(B#C)FlS62z+-`5;+eR038%QOG5{#k6J*2VgQfx+rS>8n8hu2Wra9xDKC0}A?s zL?1l-R3c#Xr0bB@LFNz4Kis>HMZP}d;-XzA(0$zDHS>=D|NqE$KaD-b#}F__fZ+@W z8xvzoH476{%S0d%JVA(ofr;D6*Vob8HN?@$$Ca0XL4N{2P>{pPH`vuN$l1e+f#Jpk UL7)g1OeECVj)B3V3m70J01lUS0RR91 literal 0 HcmV?d00001 diff --git a/TKSTRING/HBCASE.OBJ b/TKSTRING/HBCASE.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..dfaed900a8b81d0b993f6d0a0f5c9cc8371188de GIT binary patch literal 263 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+$YWq)WIVp0h=GZLLBTPq zZ|1BAiB&CA8X@fP{R|AD-EY|V*t^^~{;VtFTvyJn#^n0q=SFx?EW! z*<<5RF)@HtzrL`GfuZ}(A33w5N(b|+RD&%;xWgX0KWg1Rz3P5e~N_xsO0tS zjdNrfj)*WYF|jioaRO3|3`g97ln}#_EFk5;aBKoE0|OJAkH52Hu&V nKR6`F)6YGVfuRPXA~XP`LWqH(1EL}{0HVT;fnjPF&|4({)E-O$ literal 0 HcmV?d00001 diff --git a/TKSTRING/HBCLRSTR.OBJ b/TKSTRING/HBCLRSTR.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..44ed0a167a61f99222ecd3a3e07d1fcd6637fcf3 GIT binary patch literal 92 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+5NBXwWRzPV&A`OK(0%8R u*^zoSzOU7~-fngPp;Hfq|KkQ3S}+s9<1XWZc`s$-ovG;OrRe z%CKZX4FeMc!{=p(*96RB0D`UuYF(`E5VqBWhc6HBVqoaLBlpMbNIi?$(Q*#8E>-t6 z#rq;@ow{`7zi3OC@ZZnaY`rZ+9P-KgGcS)b;uVP~Q$l2D5H|md8RM z1K5BDaD84@!s-B2ctHLX7sKf};tXfl*q9j42my&BGAv9?M}iobn3x&bCI~VxFmXBi t`vwGu1bO>sBQ2_t| literal 0 HcmV?d00001 diff --git a/TKSTRING/HBCOMP2.OBJ b/TKSTRING/HBCOMP2.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..15ac59e3a4f0ed86e7080693ad7e9c1eede4ffb8 GIT binary patch literal 567 zcmaKpPiPZC6o-GaS+{M{7KDiZw`dSVsNk;ILuC&`veMGV#BL%5>A@a)@Fs4}L9pJ0 zol@3|Xz>s{rV%`Ns1>2s#FpAia%dEkrW*^=)k}}H7-vx8O@;^GyvO(6Fz^$p*1W*uu zz$08xAyMFhrt<(a?P5I6$q;vF&~6FiI+V7tBa9pWF|G>ZE+*T?&B6glThK0xf)BM_ z7%qf}1d?Ol)&26l@C&)fHua_XdG@n%M=7z@W`8L&$DfJfQ1i6gSR}I6D!CueyAOcy zlG8KLaJq`WmIpR&%WlKp?i*i|!9M3yy~S4cjY?kTJ=kW`eu=+*%vnq+3&#+g^UNm# zk0a>w%sGK45JWw5OW;WaU0y$hc@+8RL%sHfps7^1t2KWwvKRTnR{iI!&fW#He3((5 zmS^4@vFT1DmRIy2uT-#4dToJV$Wf{d;jj;}mDomPc}n)b1`+ml@HJ2mee>(AGQQS{ zv8RWyt}2pL)@4arpA@vK5HjH%0i=V8bSgtftv~Cut*pIB;CNA9>PgYzfB6)_8LyY8 SJM47sO41tR->kWO+0Ji!K&=4) literal 0 HcmV?d00001 diff --git a/TKSTRING/HBDATEST.OBJ b/TKSTRING/HBDATEST.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..c48a942c250e93327d8788b7bef0d2fefb0cc9d3 GIT binary patch literal 148 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+FlAt3WMo)i$-u>B#425!Kn*qM+pEPA}Rp@ literal 0 HcmV?d00001 diff --git a/TKSTRING/HBHEX.OBJ b/TKSTRING/HBHEX.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..dfff9e24b0170ead5f062f53a08762d0d47f4df3 GIT binary patch literal 219 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+h+<%3WW2o~j)94RVFSx< z4u%&D45yeFHgN9d0y9|{HZZ+@v4P|Dd*(Z4N9_Ns>Uv?rRLbbx@Rzleb%WKae`meT zy4brOY-G9gMunf(z`(|`jERN4?FfWk-SC#F^zvb$Is6PQYz$0HattkkVCvHZZUzP> s77y15Cou*FB{-00y?z>02)R)0RR91 literal 0 HcmV?d00001 diff --git a/TKSTRING/HBLEFTP.OBJ b/TKSTRING/HBLEFTP.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..81e937eebeccfb20d3da912e3e6a5fbf3e83b44b GIT binary patch literal 173 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+aARO%WPHECi-C!Oq05i$ z&zh|aT@TxiXq_o%*~rj!WL4MU&#Su5d|q-mwEKzOU7~-fngPp;Hfq|KkQ3S}+aA9C#Wc;|mgMo>Gq05i$ z&zh|aZ6~@OXgw@v+QP8v^OCMJU57ufIvm>lM(#)*-_bIzt~ibt3=HzIr#KiOf;>md zI5sOl#Ml@b=5RB#XtFRdwb%lQ+Y`7L7?_v?99;|;7-A*>9m2#4zOU7~-fngPp;Hfq|KkQ3S}+XkcJsWZc@r$-ovG;OrRe z%CKZX3j-4aL%=KsAUM34;Wg7{#?bCJa(}x0c)G*bj+Sv8spIQ@&wZ&RWDVEt64n|}0(rb@U99dv5vvCezP@Jqw64?us7^H?Fg&dL6i`}t4Olf?(ZlzznLaOz zi;s*bJ>=hgT>I#2X5#}M^0B9Q7lbgAR-Y+s7&BxU|?bk fc6AJL_F!jVm^XnR$mf9YL!G%982)tu{ZIk`r!`Lj literal 0 HcmV?d00001 diff --git a/TKSTRING/HBTAB.OBJ b/TKSTRING/HBTAB.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..cede6674ac0ffe1b67f1324443a7f3de6febfa4a GIT binary patch literal 283 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+*ulWW$XL5z4+9eegYoTu zN4aj7h;$t_dh+etzcZy=T9>tdZ{S?zWPE##vyDQDvhi&j^%52vrBcbR2dkXc{5xv( zvY5~6Na<&wFk3^-znGGjtDOEFEn%^GS+@0c*cQ&s|JPU@DdAl8?~v8y2VY*xcm3=- z1UCG@w`W{WO8K=8FAbN6R>l)bXt0 z`c}$hbfD|Rs>kgAA0Msb=@6Cgej0mzOU7~-fngPp;Hfq|KkQ3S}+s9|7YWZb!+fq{vEA+-BV zmmAxWIF6n}N9uU~*szo_ZD8m+ap3{e!4gJ~RV8}H2lh3*bI`ume9Nr(2lKt=OJ*Ly zTdiI&FhuN5cmF{>0 zZ{K+h3|9X;S#rJW=&Hjib5s~wEEt%Wau{0dfm9Mhi#vq!g;1$rIjsqN3=B-{A)daj Q!688m3=D={K!=wA0L8UU0RR91 literal 0 HcmV?d00001 diff --git a/TKSTRING/HBTRIM.OBJ b/TKSTRING/HBTRIM.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..8fae82483ad9852cef5afcc2bde46498ac4992c7 GIT binary patch literal 239 zcmZo*W?*!*p2ow#z~b!h;>zOU7~-fngPp;Hfq|KkQ3S}+C}Ln@WIVi}jDd-P;Yb~u zS{LtD2KUGOe>Nz5URT25*mcmq`#YQbkvgufgR4F-ISgckgViwqe9W;y;V)1Tqhq{U z2k+s~?l*ET7#QSZPq8q7*g%y>%h=X*o!H6%)QBttWW%_ob0isBoLHEcT4ETOn3Ne> xGC=HXFgs@g(A`X|J|RJ#zP1buGa%d`5Z9A|p=|;;P?iP6OJ-m=&;@jU2>^8HNC5x< literal 0 HcmV?d00001 diff --git a/TKSTRING/TKSTRING.PAS b/TKSTRING/TKSTRING.PAS new file mode 100644 index 0000000..be79d71 --- /dev/null +++ b/TKSTRING/TKSTRING.PAS @@ -0,0 +1,1129 @@ + +(*{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}*) + + {*********************************************************} + {* TKSTRING.PAS V 1.0 *} + {* Copyright (c) TK-Soft, Thomas Knfel 1994. *} + {* Createt with Turbo-Pascal 7.0 by Borland Inc. *} + {* All rights reserved. *} + {* *} + {*********************************************************} + +UNIT TKString; + {-grundlegende Routinen zur Stringmanipulation} + +INTERFACE + +USES CRT,DOS; + + +CONST + MessLange = 52; + {used by CompareLetterSets for estimating word similarity} + LetterValues : ARRAY[1..30] OF Byte = + (3 {A}, 6 {B}, 5 {C}, 4 {D}, 3 {E}, 5 {F}, 5 {G}, 4 {H}, 3 {I}, + 8 {J}, 7 {K}, 4 {L}, 5 {M}, 3 {N}, 3 {O}, 5 {P}, 7 {Q}, 4 {R}, + 3 {S}, 3 {T}, 4 {U}, 6 {V}, 5 {W}, 8 {X}, 8 {Y}, 9 {Z}, + 5 {}, 5 {}, 5 {}, 6 {}); + + +TYPE + Message = string[MessLange]; + BTable = ARRAY[0..255] OF Byte; {For Boyer-Moore searching} + FileNameStr = String[12]; + + + {------------------------- Numerik-Konvertierung -------------------------} + +FUNCTION HexB(B : Byte) : String; + {-Return: Hex-String des Bytes} + +FUNCTION HexW(W : Word) : String; + {-Return: Hex-String des Wortes} + +FUNCTION HexL(L : LongInt) : String; + {-Return: Hex-String des LongInteger-Wertes} + +FUNCTION HexPtr(P : Pointer) : String; + {-Return: Hex-String des Pointers} + +FUNCTION Binary(L : LongInt; Bits : Byte) : String; + {-Die in BITS angegebene Anzahl Bits (Rechts beginnend) werden + im String dargestellt} + +FUNCTION Form(Maske : String; R: Real) : String; + { Wandelt reelle Zahl r in einen formatierten String um. + Die Maske darf folgende Zeichen enthalten: + '#' : Vornullen werden an dieser Stelle nicht ausgegeben + '@' : Vornullen werden mit dargestellt + '*' : Vornullen werden als '*' dargestellt + '=' : Vornullen werden als '=' dargestellt + '%' : Vornullen werden als '%' dargestellt + '-', + '+' : das Vorzeichen wird an dieser Stelle ausgegeben, '+' steht fr die + expliziete Ausgabe von + als positives Vorzeichen + '.', + ',' : Legen die Position des Dezimalpunktes fest. + + Alle anderen Zeichen in der Maske werde unverndert bernommen} + +FUNCTION TimeStr(TimeMS:LongInt; hmsh:Byte) : String; + {-Gibt TimeMs (Zeit in Millisekunden) formatiert aus + hmsz=1: nur Stunden + 2: HH:MM + 3: HH:MM:SS + 4: HH:MM:SS.hh } + +FUNCTION DateStr: String; +{ Datum im Format DD.MM.JJ } + + {----------------- einfache Stringmanipulationen -----------------} + +FUNCTION Upcase(C : Char) : Char; + { Bercksichtigt Umlaute} + +FUNCTION LoCase(C : Char) : Char; + {-Return Kleinbuchstabe von C, bercksichtigt auch Umlaute} + +FUNCTION UpString(S : String) : String; + {-Konvertiert einen String in Groschreibung} + { Bercksichtigt Umlaute} + +FUNCTION LoString(S : String) : String; + {-Konvertiert einen String in Kleinbuchstaben} + { Bercksichtigt Umlaute} + +PROCEDURE ClrStr(var S : String; Len : Byte); + {-Fllt einen String der Lnge Len mit Leerzeichen} + +FUNCTION PadCh(S : String; C : Char; Len : Byte) : String; + {-Return: String S der rechts mit C aufgefllt wird bis er Len Zeichen + lang ist} + +FUNCTION Pad(S : String; Len : Byte) : String; + {-wie PadCh, es wird mit Leerzeichen aufgefllt} + +FUNCTION LeftPadCh(S : String; C : Char; Len : Byte) : String; + {-Return: String S der links mit C aufgefllt wird bis er Len Zeichen + lang ist} + +FUNCTION LeftPad(S : String; Len : Byte) : String; + {-wie LeftPadCh, es werden Leerzeichen voran gestellt} + +FUNCTION LTrim(S : String) : String; + {-Leerzeichen am Ende des Strings werden entfernt} + +FUNCTION RTrim(S : String) : String; + {-entfernt fhrende Leerzeichen} + +FUNCTION Trim(S : String) : String; + {-Entfernt Leerzeichen am Beginn und am Ende eines Strings} + +FUNCTION CenterCh(S : String; Ch : Char; Len : Byte) : String; + {-Return: String in dem S zentriert ist und von Ch eingeschlossen wird. + Die Gesamtlnge ergibt sich aus Len.} + +FUNCTION Center(S : String; Len : Byte) : String; + {-Wie CenterCh, es werden Leerzeichen aufgefllt} + +FUNCTION Entab(S : String; TabSize : Byte) : String; + {-Konvertiert Leerzeichen in einem string zu Tabs, TAB=' '*TabSize} + +FUNCTION Detab(S : String; TabSize : Byte) : String; + {-Erweitert Tabs in einem String zu Leerzeichen} + +FUNCTION SpNumber (N : Longint) : String; + {-Zahlen werden mit TausenderPunkten dargestellt} + +FUNCTION Crypt(S: String) : String; + {-Ver- und Entschlsselt einen String} + + {------------- Zeichenkettenvergleich und Zeichenkettensuche ------------} +TYPE + CompareType = (Less, Equal, Greater); + +FUNCTION CompString(S1, S2 : String) : CompareType; + {-Return: less, equal, greater if s1s2} + +FUNCTION CompUCString(S1, S2 : String) : CompareType; + {-Compare two strings in a case insensitive manner} + { Bercksichtigt deutsche Umlaute bei der Umwandlung in Grobuchstaben} + +FUNCTION CompStruct(VAR S1, S2; Size : Word) : CompareType; + {-Compare two fixed size structures} + +FUNCTION CompName (S1,S2 : PathStr) : boolean; + {-Compare just then Name of two FileNames} + +FUNCTION CompExtension (S1,S2 : PathStr) : boolean; + {-Compare the Extension of two Filenames} + +FUNCTION CompFileName (S1,S2 : PathStr) : boolean; + {-Compare two whole Filenames} + +FUNCTION Search(VAR Buffer; BufLength : Word; + VAR Match; MatLength : Word) : Word; + {-Search through Buffer for Match. BufLength is length of range to search. + MatLength is length of string to match. Returns number of bytes searched + to find Match, $FFFF if not found.} + +FUNCTION SearchUC(VAR Buffer; BufLength : Word; + VAR Match; MatLength : Word) : Word; + {-Search through Buffer for Match, CASE-INSENSITIVE. + Otherwise same as Search.} + { Bercksichtigt Umlaute} + +PROCEDURE BMMakeTable(MatchString : String; VAR BT : BTable); + {-Build Boyer-Moore link table} + +FUNCTION BMSearch(VAR Buffer; BufLength : Word; + BT : BTable; MatchString : String) : Word; + {-Search Buffer for MatchString. BufLength is length of range to search. + Returns number of bytes searched to find MatchString, $FFFF if not found} + +FUNCTION BMSearchUC(VAR Buffer; BufLength : Word; + BT : BTable; MatchString : String) : Word; + {-Search Buffer for MatchString, CASE-INSENSITIVE. + Assumes MatchString is already in uppercase. + Otherwise same as BMSearch} + +FUNCTION Soundex(S : String) : String; + {-Return 4 character soundex of input string} + +FUNCTION MakeLetterSet(S : String) : LongInt; + {-Return a bit-mapped long storing the individual letters contained in S} + +FUNCTION CompareLetterSets(Set1, Set2 : LongInt) : Word; + {-Returns the sum of the values of the letters common to Set1 and Set2} + + + {----- dynamische Stringablage auf dem Heap ------} + +FUNCTION StringToHeap(S : String) : Pointer; + {-S wird auf den Heap gelegt, der Pointer wird zurckgegeben} + +FUNCTION StringFromHeap(P : Pointer) : String; + {-Rckgabe des Strings auf der Adresse P} + +PROCEDURE DisposeString(P : Pointer); + {-Freigabe des Platzes ab P} + + + {--------------- DOS pathname parsing -----------------} + +FUNCTION DefaultExtension(Path : PathStr; Exten : ExtStr) : PathStr; + {-Return a file name with a default extension attached} + +FUNCTION ForceExtension(Path : PathStr; Exten : ExtStr) : PathStr; + {-Force the specified extension onto the file name} + +Function JustName(Path : PathStr) : NameStr; + {-Return just the name of a filename} + +FUNCTION JustFilename(Path : PathStr) : FileNameStr; + {-Return just the filename and extension of a pathname} + +FUNCTION JustExtension(Path : PathStr) : ExtStr; + {-Return just the extension of a pathname} + +FUNCTION JustPathname(Path : PathStr) : DirStr; + {-Return just the drive:directory portion of a pathname} + +FUNCTION AddBackSlash(Dir : DirStr) : DirStr; + {-Add a default backslash to a directory name} + +FUNCTION CleanPathName(Path : String) : PathStr; + {-Return a pathname cleaned up as DOS will do it} + +FUNCTION GenNewPathName(PathOld, PathIn : DirStr) : DirStr; + {-create a new pathname from old pathname and pathin} + +FUNCTION ShrinkPath(Path:PathStr; Plength:byte) : Pathstr; + {-compress the pathname with dots} + +PROCEDURE Beep(k:byte); + {-gibt ein akustisches Signal} + + {----------------- Integer manipulation ----------------} +FUNCTION Upword (Wort:word) : word; + +PROCEDURE Reverse(Var l:LongInt); + + + + + + +Var + OldDir : DirStr; + FullPathName : FUNCTION (FName : PathStr) : PathStr; + Regs : Registers; + {-Given FName (known to exist), return a full pathname} + + {==========================================================================} + +IMPLEMENTATION + + + +TYPE + Long = RECORD + LowWord, HighWord : Word; + END; +CONST + Digits : ARRAY[0..$F] OF Char = '0123456789ABCDEF'; + DosDelimSet : SET OF Char = ['\', #0]; + + +{------------------------- Numerik-Konvertierung -------------------------} +{$L HBHEX.OBJ} + FUNCTION HexB(B : Byte) : String; EXTERNAL; {HBHEX.OBJ} + {-Return: Hex-String des Bytes} +(* BEGIN + HexB[0] := #2; + HexB[1] := Digits[B SHR 4]; + HexB[2] := Digits[B AND $F]; + END;*) + +{------------------------------------------------------------------} + FUNCTION HexW(W : Word) : String; EXTERNAL; {HBHEX.OBJ} + {-Return: Hex-String des Wortes} +(* BEGIN + HexW[0] := #4; + HexW[1] := Digits[hi(W) SHR 4]; + HexW[2] := Digits[hi(W) AND $F]; + HexW[3] := Digits[lo(W) SHR 4]; + HexW[4] := Digits[lo(W) AND $F]; + END;*) + +{------------------------------------------------------------------} + FUNCTION HexL(L : LongInt) : String; EXTERNAL; {HBHEX.OBJ} + {-Return: Hex-String des LongInt-Wertes} +(* BEGIN + WITH Long(L) DO + HexL := HexW(HighWord)+HexW(LowWord); + END;*) + +{------------------------------------------------------------------} + FUNCTION HexPtr(P : Pointer) : String; EXTERNAL; {HBHEX.OBJ} + {-Return: Hex-String des Pointers} +(* BEGIN + HexPtr := HexW(Seg(P^))+':'+HexW(Ofs(P^)); + END;*) + +{------------------------------------------------------------------} +{$L HBBINARY.OBJ} + FUNCTION Binary(L : LongInt; Bits : Byte) + : String; EXTERNAL; {HBBINARY.OBJ} + {-Die in BITS angegebene Anzahl Bits (Rechts beginnend) werden + im String dargestellt} +(* VAR + I : Byte; + BEGIN + Binary[0] := char(Bits); + FOR I := Bits DOWNTO 1 DO BEGIN + Binary[I] := char((L AND 1)+$30); {0 or 1} + L:=L SHR 1; + END; + END;*) + +{------------------------------------------------------------------} +FUNCTION Form(Maske : String; R: Real) : String; + { Wandelt reelle Zahl r in einen formatierten String um. + Die Maske darf folgende Zeichen enthalten: + '#' : Vornullen werden an dieser Stelle nicht ausgegeben + '@' : Vornullen werden mit dargestellt + '*' : Vornullen werden als '*' dargestellt + '=' : Vornullen werden als '=' dargestellt + '%' : Vornullen werden als '%' dargestellt + '-', + '+' : das Vorzeichen wird an dieser Stelle ausgegeben, '+' steht fr die + expliziete Ausgabe von + als positives Vorzeichen + '.', + ',' : Legen die Position des Dezimalpunktes fest. + + Alle anderen Zeichen in der Maske werde unverndert bernommen} + +LABEL Ende,Exit,Exit1; + +CONST + FZch = '#@*=%.,'; + Ziffer = '#'; + VorNull = '@'; + VNZ1 = '*'; + VNZ2 = '='; + VNZ3 = '%'; + DP1 = '.'; + DP2 = ','; + PlusZ = '+'; + MinusZ = '-'; + +VAR + S: String; + Plus, Minus, NeedMinus, Negativ: Boolean; + BegFld, EndFld, PosPkt, AnzDig, Stellen, PosVZ: Byte; + I, J: Word; + + +BEGIN + IF LENGTH(Maske) = 0 THEN + GOTO EXIT1; + + PosPkt := 0; + Stellen := 0; + AnzDig := 0; + BegFld := 1; + NeedMinus := False; + + Negativ:=(R<0); + PosVZ:=POS(MinusZ,Maske); + IF PosVZ=0 THEN BEGIN + PosVZ:=POS(PlusZ,Maske); + NeedMinus:=PosVZ=0 + END; + IF not NeedMinus then R:=ABS(R); + WHILE (BegFld<=LENGTH(Maske)) AND (POS(Maske[BegFld],FZch)=0) DO + Inc(BegFld); + IF BegFld > LENGTH(Maske) THEN + GOTO EXIT; + FOR EndFld:=BegFld TO LENGTH(Maske) DO + CASE Maske[EndFld] OF + Ziffer, + VorNull, + VNZ1, + VNZ2, + VNZ3 : Inc(AnzDig); + DP1, + DP2 : PosPkt:=EndFld; + ELSE + GOTO ENDE; + END; + Inc(EndFld); + +ENDE: + Dec(EndFld); + IF PosPkt>0 THEN BEGIN + Stellen:=EndFld-PosPkt; Inc(AnzDig) + END; + + Str(R:AnzDig:Stellen, S); + + IF (LENGTH(S) > AnzDig) THEN { To Big } + BEGIN + FOR I:=BegFld TO EndFld DO + CASE Maske[I] OF + Ziffer, + VorNull, + VNZ1, + VNZ2, + VNZ3 : Maske[I] := '*'; + END; + GOTO EXIT; + END + ELSE BEGIN + J:=1; + FOR I := BegFld TO EndFld DO + CASE Maske[I] OF + Ziffer : BEGIN Maske[I]:=S[J]; Inc(J) END; + VorNull: BEGIN + IF S[J]=' ' THEN Maske[I]:='0' ELSE Maske[I]:=S[J]; + Inc(J) + END; + VNZ1, + VNZ2, + VNZ3 : BEGIN + IF S[J]<>' ' THEN Maske[I]:=S[J]; + Inc(J) + END; + DP1, + DP2 : IF S[J]='.' THEN Inc(J); + END; + END; +EXIT: + IF not NeedMinus THEN + IF Maske[PosVZ]=PlusZ THEN + IF Negativ THEN Maske[PosVZ] := '-' ELSE Maske[PosVZ] := '+' + ELSE + IF Negativ THEN Maske[PosVZ] := '-' ELSE Maske[PosVZ] := ' '; +EXIT1: + Form := Maske; +END; + +{------------------------------------------------------------------} +{$L HBTIMEST.OBJ} +FUNCTION TimeStr(TimeMS:LongInt; hmsh:Byte) : String; + EXTERNAL; {HBTIMEST.OBJ} + {-Gibt TimeMs (Zeit in Millisekunden) formatiert aus + hmsz=1: nur Stunden + 2: HH:MM + 3: HH:MM:SS + 4: HH:MM:SS.hh } +(* +CONST + Trennzeichen:ARRAY[1..4] OF Char=(' ',':',':','.'); + Divisor:ARRAY[0..4] OF Longint=(24,60,60,100,10); + +VAR + HStr: String[12]; + WStr: String[2]; + P : Byte; + +BEGIN {FUNCTION TimeStr} + HStr:=''; + FOR P:=4 DOWNTO 1 DO BEGIN + TimeMS:=TimeMS DIV Divisor[P]; + Str(TimeMS MOD Divisor[P-1]:2,WStr); + IF (WStr[1]=' ') AND (P<>1) THEN WStr[1]:='0'; + IF P<=hmsh THEN HStr:=Trennzeichen[P]+WStr+HStr; + END; + DELETE(HStr,1,1); TimeStr:=HStr +END; {FUNCTION TimeStr}*) + {------------------------------------------------------------------} +{$L HBDATEST.OBJ} +FUNCTION DateStr: String; EXTERNAL;{HBDATEST.OBJ} +{ Datum im Format DD.MM.JJ } +(*VAR MonDay,Year,loop: Word; + S2: String[2]; + S: String; +BEGIN + INLINE($B4/$2A / $CD/$21 / + $89/$8E/>Year / $89/$96/>MonDay); {GETDATE(Year,Mon,Day,Wkd);} + Str(lo(MonDay):2,S); + Str(hi(MonDay):2,S2); + S := S + '.' + S2; + Str((Year MOD 100):2,S2); + S := S + '.' + S2; + FOR loop := 1 TO 8 DO IF S[loop] = ' ' THEN S[loop] := '0'; + DateStr := S; +END;*) + {------------------------------------------------------------------} + +{--------------------- einfache Stringmanipulationen --------------------} +{$L HBCASE.OBJ} + + FUNCTION Upcase(C : Char) : Char; external {HBCASE} ; +(* + BEGIN + CASE C OF + '': Upcase:=''; + '': Upcase:=''; + '': Upcase:=''; + ELSE Upcase:=System.Upcase(C) + END + END;*) + +{------------------------------------------------------------------------} + FUNCTION LoCase(C : Char) : Char; external {HBCASE} ; + {-Return Kleinbuchstabe von Ch, bercksichtigt auch Umlaute} +(* + BEGIN + CASE C OF + '': Locase:=''; + '': Locase:=''; + '': Locase:=''; + ELSE + IF (C>='A') AND (C<='Z') + THEN LoCase:=Char(ord(C)+32) + ELSE LoCase:=C; + END + END;*) + + +{------------------------------------------------------------------} + FUNCTION UpString(S : String) : String; EXTERNAL {HBCASE} ; +(* VAR I : Byte; + BEGIN + UpString[0]:=S[0]; + FOR I:=1 TO LENGTH(S) DO UpString[I]:=Upcase(S[I]); + END;*) + +{------------------------------------------------------------------} + FUNCTION LoString(S : String) : String; EXTERNAL {HBCASE} ; +(* VAR I : Byte; + BEGIN + LoString[0]:=S[0]; + FOR I:=1 TO LENGTH(S) DO LoString[I]:=Locase(S[I]); + END;*) + +{------------------------------------------------------------------} +{$L HBCLRSTR.OBJ} + PROCEDURE ClrStr(var S : String; Len : Byte); External {HBCLRSTR.OBJ} ; +(* + BEGIN + FillChar(S[1],Len,' '); + S[0]:=Char(Len) + END;*) + +{------------------------------------------------------------------} +{$L HBPAD.OBJ} + FUNCTION PadCh(S : String; C : Char; Len : Byte) : String; + External {HBPAD.OBJ} ; + {-Return: String S der rechts mit C aufgefllt wird bis er Len Zeichen + lang ist} +(* VAR + o : String; + BEGIN + IF LENGTH(S) >= Len THEN + PadCh := S + ELSE BEGIN + o[0] := Char(Len); + Move(S[1], o[1], LENGTH(S)); + FILLCHAR(o[Succ(LENGTH(S))], Len-LENGTH(S), C); + PadCh := o; + END; + END;*) + +{------------------------------------------------------------------} + FUNCTION Pad(S : String; Len : Byte) : String; + EXTERNAL {HBPAD.OBJ} ; + {-wie PadCh, es wird mit Leerzeichen aufgefllt} +(* BEGIN + Pad := PadCh(S, ' ', Len); + END;*) + +{------------------------------------------------------------------} +{$L HBLEFTP.OBJ} + FUNCTION LeftPadCh(S : String; C : Char; Len : Byte) : String; + EXTERNAL {HBLEFTP.OBJ} ; + {-Return: String S der links mit C aufgefllt wird bis er Len Zeichen + lang ist} +(* VAR + o : String; + BEGIN + IF LENGTH(S) >= Len THEN + LeftPadCh := S + ELSE BEGIN + o[0] := Char(Len); + Move(S[1], o[Succ(Len)-LENGTH(S)], LENGTH(S)); + FILLCHAR(o[1], Len-LENGTH(S), C); + LeftPadCh := o; + END; + END;*) + +{------------------------------------------------------------------} + FUNCTION LeftPad(S : String; Len : Byte) : String; + EXTERNAL {HBLEEFTP.OBJ} ; + {-wie LeftPadCh, es werden Leerzeichen voran gestellt} +(* BEGIN + LeftPad := LeftPadCh(S, ' ', Len); + END;*) + +{------------------------------------------------------------------} +{$L HBTRIM.OBJ} + FUNCTION LTrim(S : String) : String; EXTERNAL {HBTRIM.OBJ} ; + {-Leerzeichen am Ende des Strings werden entfernt} +(* BEGIN + WHILE (LENGTH(S) > 0) AND (S[1] = ' ') DO + Delete(S, 1, 1); + LTrim := S; + END;*) + +{------------------------------------------------------------------} + FUNCTION RTrim(S : String) : String; EXTERNAL {HBTRIM.OBJ} ; + {-Leerzeichen am Ende des Strings werden entfernt} +(* BEGIN + WHILE (LENGTH(S) > 0) AND (S[LENGTH(S)] = ' ') DO + DEC(S[0]); + RTrim := S; + END;*) + +{------------------------------------------------------------------} + FUNCTION Trim(S : String) : String; EXTERNAL {HBTRIM.OBJ} ; + {-Return a string with leading and trailing white space removed} +(* BEGIN + WHILE (LENGTH(S) > 0) AND (S[LENGTH(S)] = ' ') DO + DEC(S[0]); + + WHILE (LENGTH(S) > 0) AND (S[1] = ' ') DO + Delete(S, 1, 1); + + Trim := S; + END;*) + +{------------------------------------------------------------------} + FUNCTION CenterCh(S : String; Ch : Char; Len : Byte) : String; + {-Return: String in dem S zentriert ist und von Ch eingeschlossen wird. + Die Gesamtlnge ergibt sich aus Len.} + VAR + o : String; + BEGIN + IF LENGTH(S) >= Len THEN + CenterCh := S + ELSE BEGIN + o[0] := Chr(Len); + FILLCHAR(o[1], Len, Ch); + Move(S[1], o[Succ((Len-LENGTH(S)) SHR 1)], LENGTH(S)); + CenterCh := o; + END; + END; + +{------------------------------------------------------------------} + FUNCTION Center(S : String; Len : Byte) : String; + {-Wie CenterCh, es werden Leerzeichen aufgefllt} + BEGIN + Center := CenterCh(S, ' ', Len); + END; + +{------------------------------------------------------------------} + {$L HBTAB.OBJ} + FUNCTION Entab(S : String; TabSize : Byte) : String; + EXTERNAL {HBTAB} ; + +{------------------------------------------------------------------} + FUNCTION Detab(S : String; TabSize : Byte) : String; + EXTERNAL {HBTAB} ; + +{-------------------------------------------------------------------------} +function Potenz(bas,ex:longint):longint; +var temp: real; +begin + temp:=ex*ln(bas); + potenz:=trunc(Exp(temp)); +end; + + +FUNCTION SpNumber (N:Longint) : String; +var s:string; + z:integer; +begin + str(N,s); + for z:=1 to 3 do + If ( N Div potenz(10,(3*z)) )>=1 then + Insert('.', S,length(S)-(z*3+z-2)); + SpNumber:=s; +end; + + +{-------------------------------------------------------------------------} +FUNCTION Crypt(S: String) : String; +var I : byte; + st: string; + zahl : byte; +begin + st:=''; + For I := 1 To Length(S) Do + begin + zahl:= (Byte(S[I]) xor lo(I)); + st:= concat( st, chr(zahl) ); + end; + crypt:=st; +end; + + +{-------------------- Zeichkettenvergleiche -----------------------------} +{$L HBCOMP1.OBJ} + FUNCTION CompString(S1, S2 : String) : CompareType; + EXTERNAL {HBCOMP1.OBJ} ; + +{------------------------------------------------------------------} + FUNCTION CompUCString(S1, S2 : String) : CompareType; + EXTERNAL {HBCOMP1.OBJ} ; + { Bercksichtigt Umlaute bei der Umwandlung von Klein- in Groschreibung } + +{------------------------------------------------------------------} + FUNCTION CompStruct(VAR S1, S2; Size : Word) : CompareType; + EXTERNAL {HBCOMP1.OBJ} ; + + +{-------------------------------------------------------------------------} +Function sCheck(Mask,Name:String):Boolean; +Var i,j,k:Byte; + Pile :Array[1..9] of Record a,b:Byte; End; + PileP:Byte; + lm:Byte absolute Mask; + ln:Byte absolute Name; + Impasse:Boolean; +Begin + i:=1; j:=1; sCheck:=False; PileP:=0; Impasse:=False; + Repeat + if Mask[i]<>'*' then + if (j<=ln) and ((Mask[i]='?') or (Mask[i]=Name[j]) or + ((Mask[i]='#') and (Name[j]>='0') and (Name[j]<='9'))) then + Begin + Inc(i); Inc(j); + End else + Impasse:=True + else + Begin + if i=lm then Begin sCheck:=True; Exit; End else + Begin + k:=j; + While (k<=ln) and (Name[k]<>Mask[i+1]) and + (Mask[i+1]<>'?') and + ((Mask[i+1]<>'#') or not (Name[k] in ['0'..'9'])) + do Inc(k); + if k<=ln then + Begin + Inc(PileP); + With Pile[PileP] do + Begin + a:=i; b:=Succ(k); + End; + Inc(i,2); j:=Succ(k); + if j>ln then + if (i=lm) and (Mask[i]='*') + then Inc(i) else Impasse:=True; + End else Impasse:=True; + End; + End; + + if (i>lm) then if (j>ln) then + Begin + sCheck:=True; Exit; + End else + Impasse:=True; + + if Impasse then + if PileP>0 then + Begin + With Pile[PileP] do + Begin + i:=a; j:=b; + End; + Dec(PileP); + Impasse:=False; + if j>ln then Exit; + End else Exit; + {EndIF} + Until false; +End; + + + + + +{-------------------------------------------------------------------------} +FUNCTION CompExtension (S1,S2:PathStr):boolean; +begin + CompExtension:=Scheck(upstring(justextension(S1)),upstring(justextension(S2))); +end; + +{-------------------------------------------------------------------------} +FUNCTION CompName (S1,S2:PathStr):boolean; +begin + CompName:=Scheck(upstring(justname(S1)),upstring(justname(S2))); +end; + +{-------------------------------------------------------------------------} +FUNCTION CompFileName(S1,S2:PathStr):boolean; +begin + CompFileName:=Scheck(upstring(justFilename(S1)),upstring(justFilename(S2))); +end; + + +{------------------------------------------------------------------} +{$L HBSEARCH.OBJ} + FUNCTION Search(VAR Buffer; BufLength : Word; + VAR Match; MatLength : Word) : Word; + EXTERNAL {HBSEARCH} ; + +{------------------------------------------------------------------} + FUNCTION SearchUC(VAR Buffer; BufLength : Word; + VAR Match; MatLength : Word) : Word; + EXTERNAL {HBSEARCH} ; + { Bercksichtigt Umlaute} + +{------------------------------------------------------------------} +{$L HBBM.OBJ} + PROCEDURE BMMakeTable(MatchString : String; VAR BT : BTable); + EXTERNAL {HBBM} ; + +{------------------------------------------------------------------} + FUNCTION BMSearch(VAR Buffer; BufLength : Word; + BT : BTable; MatchString : String) : Word; + EXTERNAL {HBBM}; + +{------------------------------------------------------------------} + FUNCTION BMSearchUC(VAR Buffer; BufLength : Word; + BT : BTable; MatchString : String) : Word; + EXTERNAL {HBBM}; + +{------------------------------------------------------------------} +{$L HBCOMP2.OBJ} + FUNCTION Soundex(S : String) : String; + EXTERNAL {HBCOMP2}; + +{------------------------------------------------------------------} + FUNCTION MakeLetterSet(S : String) : LongInt; + EXTERNAL {HBCOMP2}; + +{------------------------------------------------------------------} + FUNCTION CompareLetterSets(Set1, Set2 : LongInt) : Word; + EXTERNAL {HBCOMP2}; + + +{------------ String dynamically allocated on the heap -------------} + FUNCTION StringToHeap(S : String) : Pointer; + {-Allocate space for s and return pointer} + VAR + L : Word; + P : Pointer; + BEGIN + L := Succ(LENGTH(S)); + IF MaxAvail < L THEN + StringToHeap := NIL + ELSE BEGIN + GetMem(P, L); + String(P^) := S; + StringToHeap := P; + END; + END; + +{------------------------------------------------------------------} + FUNCTION StringFromHeap(P : Pointer) : String; + {-Return string at p} + BEGIN + IF P = NIL THEN + StringFromHeap := '' + ELSE + StringFromHeap := String(P^); + {ENDIF} + END; + +{------------------------------------------------------------------} + PROCEDURE DisposeString(P : Pointer); + {-Deallocate space for string at p} + BEGIN + IF P <> NIL THEN + FreeMem(P, Succ(Byte(P^))); + {ENDIF} + END; + + +{---------------------- DOS pathname parsing ------------------------} + FUNCTION DefaultExtension(Path : PathStr; Exten : ExtStr) : PathStr; + {-Return a pathname with the specified extension attached} + VAR + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + BEGIN + FSplit(Path, Dir, Name, Ext); + IF Ext <> '' THEN + DefaultExtension := Path + ELSE + DefaultExtension := concat(Path,Exten); + END; + +{------------------------------------------------------------------} + FUNCTION ForceExtension(Path : PathStr; Exten : ExtStr) : PathStr; + {-Return a pathname with the specified extension attached} + VAR + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + BEGIN + FSplit(Path, Dir, Name, Ext); + ForceExtension := concat(Dir,Name,Exten); + END; + +{------------------------------------------------------------------} + Function JustName(Path : PathStr) : NameStr; + {-Return just then name of a filename} + VAR + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + BEGIN + If Path[1]<>'.' then + begin + FSplit(Path, Dir, Name, Ext); + JustName := Name; + end else + JustName := Path; + END; + +{------------------------------------------------------------------} + FUNCTION JustExtension(Path : PathStr) : ExtStr; + {-Return just the extension of a pathname} + VAR + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + BEGIN + FSplit(Path, Dir, Name, Ext); + delete(Ext,1,1); + JustExtension := Rtrim(Ext); + END; + +{------------------------------------------------------------------} + FUNCTION JustFileName(Path : PathStr) : FileNameStr; + {-Return just then filename of a pathname} + VAR + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + BEGIN + FSplit(Path, Dir, Name, Ext); + JustFilename := concat(Name,Ext); + END; + +{------------------------------------------------------------------} + FUNCTION JustPathname(Path : PathStr) : DirStr; + {-Return just the drive:directory portion of a pathname} + VAR + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + BEGIN + FSplit(Path, Dir, Name, Ext); + JustPathname := Dir; + END; + +{------------------------------------------------------------------} + FUNCTION AddBackSlash(Dir : DirStr) : DirStr; + {-Add a default backslash to a directory name} + BEGIN + IF Dir[LENGTH(Dir)] IN DosDelimSet Then + AddBackSlash := Dir + ELSE + AddBackSlash := concat(Dir,'\'); + END; + +{------------------------------------------------------------------} + FUNCTION CleanPathName(Path : String) : PathStr; + {-Return a pathname cleaned up as DOS will do it} + VAR + I : Word; + oname : String; + Dir : DirStr; + Name : NameStr; + Ext : ExtStr; + Begin + oname := ''; + I := Succ(LENGTH(Path)); + + REPEAT + {Get the next directory or drive portion of pathname} + REPEAT + DEC(I); + UNTIL (I <=0) OR (Path[I] IN DosDelimSet); + + {Clean it up and prepend it to output string} + FSplit(Copy(Path, Succ(I), 64), Dir, Name, Ext); + oname := concat(Dir,Name,Ext,oname); + IF I > 0 THEN BEGIN + oname := concat(Path[I],oname); + Delete(Path, I, 255); + END{IF}; + UNTIL I <= 0; + CleanPathName := oname; + END; + +{------------------------------------------------------------------} + FUNCTION GenNewPathName(PathOld, PathIn : DirStr) : DirStr; + {-create a new pathname from old pathname and pathin} + VAR + MerkDir : DirStr; + OldDrive : DirStr; + NewDrive : DirStr; + Ret : DirStr; + I : Byte; + BEGIN + GetDir(0, MerkDir); {aktuelles Verz. merken} + Ret := ''; OldDrive := ''; NewDrive := ''; {clear strings} + I := Pos(':', PathOld); {Lw PathOld ermitteln} + IF I > 0 Then Begin + OldDrive := Copy(PathOld, 1, I); + PathOld := Copy(PathOld, Succ(I), 67); + End{I}; + I := Pos(':', PathIn); {Lw PathIn ermitteln} + IF I > 0 Then Begin + NewDrive := Copy(PathIn, 1, I); + PathIn := Copy(PathIn, Succ(I), 67); + End{IF}; + {------ Drive test ---------------------} + IF NewDrive = '' Then Begin + Ret := OldDrive; + IF PathIn[1] = '\' Then + Ret := concat(Ret,PathIn) + Else + Ret := concat(Ret,AddBackSlash(PathOld),PathIn) + {EndIF} + End + Else + IF PathIn[1] = '\' Then + Ret := concat(NewDrive,PathIn) + Else Begin + ChDir(NewDrive); + GetDir(0, Ret); + Ret := concat(AddBackSlash(Ret),PathIn); + End{IF}; + {EndIF} + ChDir(MerkDir); {ursprngl. Verz. setzen} + GenNewPathName := Ret; + End; + +{-------------------------------------------------------------------------} +FUNCTION ShrinkPath(Path:PathStr; Plength:byte) : Pathstr; +var en:PathStr; + begin + Path:=trim(Path); + if length(Path)>Plength then + begin + If Path[2]=':' then + begin + en:=copy(Path,4,length(Path)-3); + delete(en,1,length(en)-(Plength-6)); + delete(Path,4,length(Path)-3); + ShrinkPath:=concat(Path,'...',en); + end else + begin + delete(Path,1,length(Path)-(Plength-3)); + ShrinkPath:=concat('...',Path); + end; + end else + ShrinkPath:=Path; + end; + + + +{-------------------------------------------------------------------------} +PROCEDURE Beep(k:byte); +var s:word; +begin + case k of + 1: begin + for s:=10 to 1000 do + begin + sound(trunc(sin(s)+1)*s); + if s/100=trunc(s/100) then + delay(1); + end; + for s:=1000 downto 10 do + begin + sound(trunc(sin(s)+1)*s); + if s/100=trunc(s/100) then + delay(1); + end; + end; + end; + nosound; +end; + + +{-------------------------------------------------------------------------} +function upword (Wort:word): word; +begin + If (Wort<123) and (Wort>96) then + begin + upword:=byte(upcase(char(Wort))); + end else + upword:=Wort; +end; + + +{-------------------------------------------------------------------------} +Procedure Reverse(Var l:LongInt); +Var l1:LongInt; +Begin + l1:=((l and $FF000000) shr 24) or ((l and $00FF0000) shr 8) or + ((l and $0000FF00) shl 8) or ((l and $000000FF) shl 24); + l:=l1; +End; + + + + +BEGIN +END. \ No newline at end of file diff --git a/TOP.PAS b/TOP.PAS new file mode 100644 index 0000000..0098764 --- /dev/null +++ b/TOP.PAS @@ -0,0 +1,497 @@ +{$A+,B-,D+,E-,F+,G+,I+,L+,N-,O-,P+,Q-,R+,S+,T-,V+,X+} +program Top; +{$M 45000,0,300000} + + +uses Crt,Dos,KBM,Tkwin,{Fenster}Archive,Init,Tkstring, + Tpinst,Tkdisk,Tkstream,Tksaa,Tkvideo,Swap,Tctrl2; + + + + + procedure Ende; + var T :text; + begin + textcolor(Lightgray);textbackground(black); + window(1,1,crtxmax,crtymax); winclrscr; + tpibegin; + + tpiput(604,1,m_sort); + tpiput(605,1,m_attrib); + tpiput(606,1,m_color); + tpiput(607,1,m_prgend); + tpiput(608,1,m_auto); + tpiput(609,1,m_flashend); + tpiput(610,1,m_ver); + tpiput(611,1,m_interM); + tpiput(612,51,m_packverz); + tpiput(664,51,m_tempverz); + If (RFenster^.dat.ver[1].name<>addbackslash(restlauf+':')) and auto then + tpiput(715,1,RFenster^.dat.ver[1].name[1]); + tpiput(716,1,m_pack); + tpiput(717,1,m_komp); + tpiput(718,41,Name); + tpiput(760,41,Strasse); + tpiput(802,41,Ort); + tpiput(844,6 ,Liznr); + + If not Test then + tpiend(((RFenster^.dat.ver[1].name<>addbackslash(restlauf+':')) and auto) or + (m_pack<>pack) or + (m_komp<>komp) or + (m_packverz<>packverz) or + (m_tempverz<>tempverz) or + (m_prgend<>prgend) or + (m_sort<>sort) or + (m_color<>color) or + (m_attrib<>attrib) or + (m_auto<>auto) or + (m_flashend<>flashend) or + (m_ver<>ver) or + (m_interM<>interM)); + + RFenster^.Done; + LFenster^.Done; + AFenster^.Done; + Drive.DelFile;Drive.Done; + Pdat.Delfile; Pdat.Done; + Packer_File.Done; Hilfe.Done; + setverify(ver);chver(merkdir);cursor_on; + textcolor(Lightgray);textbackground(black); + writeXY(1,1, + {crypt('TOP - Toms Oberflche fr Packprogramme - V2.1, Copyright 1992-95, Thomas Knfel'));} +crypt('UMS$(&Sgdy+Cok}v}p|p6qk:K}~uoRNEQEHKB'#8#4#10'}'#30#3#31#3#16'r]CMG_PPM'#26#10#5#4#12#18'ytnc'#16'-)*):j'#0'"(*<')); + If not Demo then + begin + writeXY(1,3,crypt('Mkyakunm{~+j|5')); {Lizensiert fr:} + WinFrame(19,4,61,8,true); + writeXY(20,5,center(crypt(Name),40)); + writeXY(20,6,center(crypt(Strasse),40)); + writeXY(20,7,center(crypt(Ort),40)); + gotoXY(1,9); + end; + halt(0); + end; + + + + + procedure Back_o_Rest; + var paverz : string; + veranz : word; + begin + + new(RFenster); new(LFenster); new(AFenster); + + If (RFenster=NIL) or (LFenster=NIL) or (AFenster=NIL) then + begin + HErrorMsg; halt(1); + end; + + Rahmen; + + If Demo then Hilfe.ViewPage(2); + + Drive.Init (concat(addbackslash(m_tempverz),Drivename),SizeOf(Dtemp)); + + Pdat.Init (concat(addbackslash(m_tempverz),Pdatname)); + + paverz:=concat(addbackslash(readprogdir(paramstr(0))),Packername); + + Packer_File.Init (paverz,SizeOf(Dparam)); + + + Findfirst(paverz,$27,Dirinfo); + If (Dirinfo.Name='') then + begin + Packer_File.Create; Packer_File.Close; Doserror:=0; + end; + + Drive.Create; Drive.Close; + Pdat.Create; Pdat.Close; + + lw.Dr:=restlauf; + DriveKind(lw); + + + If auto and (lw.ch<>'') then + begin + LFenster^.dat.ver[1].name :=merkdir[1]+':\'; + RFenster^.dat.ver[1].name :=restlauf+':\'; + FindFirst(concat(addbackslash(merkdir),'*.*'), $35, DirInfo); + repeat + Findnext(DirInfo); + until ((DirInfo.Name<>'.') and (DirInfo.Name<>'..')) or (Doserror>0); + If Doserror=0 then + begin + RFenster^.dat.ver_dat:=true; + FensterM:=Links; + end else + begin + RFenster^.dat.ver_dat:=false; + FensterM:=Rechts; Doserror:=0; + end; + end else + begin + FensterM:=Links; + LFenster^.dat.ver[1].name:=merkdir[1]+':\'; + RFenster^.dat.ver[1].name:=merkdir[1]+':\'; + RFenster^.dat.ver_dat:=true; + end; + + + LFenster^.dat.vpos:=1;LFenster^.dat.sanf:=1; LFenster^.dat.ver_dat:=true; + LFenster^.dat.aktverz:=''; + RFenster^.dat.vpos:=1;RFenster^.dat.sanf:=1; RFenster^.dat.aktverz:=''; + + ev1.Ereignis:=0; ArcOpen:=false; + + If FensterM=Links then + begin + LFenster^.Init; + RFenster^.Init; + AFenster^.Init; + end else + begin + RFenster^.Init; + LFenster^.Init; + AFenster^.Init; + end; + + + repeat + case FensterM of + Links : begin + LFenster^.Fenster; + case Ftaste of + TAB : begin + FensterM:=Rechts; + end; + CTRL_R: begin + Drive.Open; Lver.Drive:=' '; + While (Lver.Drive <> LFenster^.dat.ver[1].name[1]) and + not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + If Lver.Drive = LFenster^.dat.ver[1].name[1] then + Drive.Remove(Drive.Pos-1,1); + end; + Drive.Close; + LFenster^.VerzNeu; + If not ArcOpen and + (LFenster^.dat.ver[1].name[1] = RFenster^.dat.ver[1].name[1]) then + begin + RFenster^.UnselectAll; + RFenster^.Fenakt(False,True,True); + end; + LFenster^.UnselectAll; + LFenster^.Fenakt(True,False,True); + end; + F3 : begin + LFenster^.Fenakt(True,False,False); + end; + F5 : begin + If m_flashend then ende; + If ArcOpen then + begin + AFenster^.UnselectAll; + AFenster^.Fenakt(False,True,True); + end else + begin + RFenster^.UnselectAll; + RFenster^.Fenakt(False,False,True); + end; + If Kom.ver then + begin + If Kom.ausw then + begin + Lfenster^.Drivedelete; + Lfenster^.VerzNeu; + end else + Lfenster^.VerzAkt; + end else + Lfenster^.UnselectAll; + LFenster^.Fenakt(True,False,True); + end; + F7: begin + If not Arcopen then + begin + RFenster^.Fenakt(False,True,False); + end; + LFenster^.Fenakt(True ,False,False); + end; + F8: begin + If ArcOpen then + begin + AFenster^.UnselectAll; + AFenster^.Fenakt(False,True,True); + end; + + If Verzdel then + begin + If not ArcOpen then + begin + Rfenster^.Fenakt(False,True,False); + end; + Lfenster^.Fenakt(True,True,False); + end else + begin + If not ArcOpen then + begin + Rfenster^.UnselectAll; + Rfenster^.Fenakt(False,False,True); + end; + LFenster^.UnselectAll; + Lfenster^.Fenakt(True,False,True); + end; + + end; + F2: begin + AFenster^.Laufwerk(true); + RFenster^.Laufwerk(true); + If ArcOpen then + begin + AFenster^.ClrUnterF; + If ch_dat then + AFenster^.UnselectAll; + AFenster^.Fenakt(False,True,ch_dat); + end else + begin + RFenster^.ClrUnterF; + If ch_dat then + RFenster^.UnselectAll; + RFenster^.Fenakt(False,False,ch_dat); + end; + LFenster^.Laufwerk(true); + LFenster^.ClrUnterF; + If ch_dat then + LFenster^.UnselectAll; + LFenster^.Fenakt(True,False,ch_dat); + end; + F9: begin + RFenster^.Readendg; + If ArcOpen then + begin + AFenster^.UnselectAll; + AFenster^.Fenakt(False,True,True); + end else + begin + RFenster^.UnselectAll; + RFenster^.Fenakt(False,False,True); + end; + LFenster^.UnselectAll; + LFenster^.Fenakt(True,False,True); + end; + end; + end; + Rechts: begin + If ArcOpen then + AFenster^.Fenster + else + RFenster^.Fenster; + case Ftaste of + TAB : FensterM:=Links; + CR : begin + If ArcOpen then + RFenster^.Fakt + else + AFenster^.Fakt; + end; + CTRL_R: begin + Drive.Open; Lver.Drive:=' '; + While (Lver.Drive <> RFenster^.dat.ver[1].name[1]) and not ArcOpen and + not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + If Lver.Drive = RFenster^.dat.ver[1].name[1] then + Drive.Remove(Drive.Pos-1,1); + end; + Drive.Close; + If ArcOpen then + begin + AFenster^.UnselectAll; + AFenster^.Fenakt(True,True,True); + end else + begin + RFenster^.VerzNeu; + If LFenster^.dat.ver[1].name[1] = RFenster^.dat.ver[1].name[1] then + begin + LFenster^.UnselectAll; + LFenster^.Fenakt(False,True,True); + end; + RFenster^.UnselectAll; + RFenster^.Fenakt(True,False,True); + end; + end; + F3 : begin + RFenster^.Fenakt(True,False,False); + end; + F5 : begin + If m_flashend then ende; + If Kom.path then + Lfenster^.VerzAkt else + Lfenster^.UnselectAll; + Lfenster^.Fenakt(False,False,True); + If ArcOpen then + begin + AFenster^.UnselectAll; + AFenster^.Fenakt(True,True,True); + end else + begin + RFenster^.UnselectAll; + RFenster^.Fenakt(True,False,True); + end; + end; + F7: begin + LFenster^.Fenakt(False,True,False); + If not ArcOpen then + RFenster^.Fenakt(True ,False,False); + end; + F8: begin + + If Verzdel and not ArcOpen then + begin + Lfenster^.Fenakt(False,True,False); + If not ArcOpen then + begin + Rfenster^.Fenakt(True,True,False); + end; + end else + begin + LFenster^.UnselectAll; + Lfenster^.Fenakt(False,False,True); + If not ArcOpen then + begin + Rfenster^.UnselectAll; + Rfenster^.Fenakt(True,False,True); + end; + end; + If ArcOpen then + begin + AFenster^.UnselectAll; + AFenster^.Fenakt(True,True,True); + end; + + end; + F2: begin + LFenster^.Laufwerk(true); + LFenster^.ClrUnterF; + If ch_dat then + LFenster^.UnselectAll; + LFenster^.Fenakt(False,False,ch_dat); + AFenster^.Laufwerk(true); + RFenster^.Laufwerk(true); + If ArcOpen then + begin + AFenster^.ClrUnterF; + If ch_dat then + AFenster^.UnselectAll; + AFenster^.Fenakt(True,True,ch_dat); + end else + begin + RFenster^.ClrUnterF; + If ch_dat then + RFenster^.UnselectAll; + RFenster^.Fenakt(True,False,ch_dat); + end; + end; + F9: begin + RFenster^.Readendg; + LFenster^.UnselectAll; + LFenster^.Fenakt(False,False,True); + If ArcOpen then + begin + AFenster^.UnselectAll; + AFenster^.Fenakt(True,True,True); + end else + begin + RFenster^.UnselectAll; + RFenster^.Fenakt(True,False,True); + end; + end; + end; + end; + end; + until Ftaste=ALT_X; + end; + + + +begin + getverify(m_ver); + + m_pack := pack; + m_komp := komp; + + m_packverz:= packverz; + m_tempverz:= tempverz; + m_prgend := prgend; + m_sort := sort; + m_color := color; + m_attrib := attrib; + m_auto := auto; + m_flashend:= flashend; + m_ver := ver; + m_interM := interM; + + If not getver(0,merkdir) then halt(1); + setverify(ver); + + getver(DrvLet_Num(tempverz[1]),Verz); + If chver(tempverz) then + begin + m_tempverz:=tempverz; + end else + begin + writeln('Fehlerhaftes Temporres-Verzeichnis !');delay(400); + m_tempverz:=justpathname(paramstr(0)); + end; + + SwapPath := m_tempverz; + RedoutPath:= m_tempverz; + chver(Verz); + + top_verz:=addbackslash(justpathname(paramstr(0))); + + getver(DrvLet_Num(packverz[1]),Verz); + If chver(packverz) then + begin + m_packverz:=packverz; + end else + begin + write('Fehlerhaftes Packer-Verzeichnis !');delay(400); + m_packverz:=justpathname(paramstr(0)); + end; + + chver(Verz); + + + If upstring(paramstr(1))=crypt('UGPP517:>:') then { TEST } + test:=true else test:=false; + + If upstring(paramstr(1))=crypt('MKYAKU') then { LIZENS } + begin + writeln(crypt(Name)); + writeln(crypt(Strasse)); + writeln(crypt(Ort)); + writeln(crypt(Liznr)); halt; + end; + + If (Name='EGNK') and not test then { DEMO } + begin + Demo:=true; + end; + + cursor_off; + + case m_color of + 1 : Farbe1; + 2 : Farbe2; + 3 : Monochrome; + end; + + Hilfe.init(addbackslash(readprogdir(paramstr(0)))+'top.hlp',$32504f54); + + Back_o_Rest; + Ende; +end. \ No newline at end of file diff --git a/UNITS/ARCVIEW.INC b/UNITS/ARCVIEW.INC new file mode 100644 index 0000000..3a0959b --- /dev/null +++ b/UNITS/ARCVIEW.INC @@ -0,0 +1,1072 @@ +Procedure Copystream.read(var R; P: Longint; Anz: Word); +begin + If P = -1 then P:=Pos; {sequentielles Lesen} + If OK then + repeat + seek(P); + {$I-} Blockread (F, R, Anz, Result); {$I+} + Ok := Inoutres=0; + until testerror(readmsg); + {EndIf} +end; + + + + + + + +Function ArchivFenster.ArcViewer(Ver_dat : boolean; vpos:word) : boolean; +const + MaxTampon = 200; + + DateMini : LongInt = 0; + DateMaxi : LongInt = $7FFFFFFF; + TailleMini: LongInt = 0; + TailleMaxi: LongInt = $7FFFFFFF; + + ZooId = $FDC4A7DC; +Type ZooHdrTyp = Record + Zoo_Text : Array[1..20] of Char; { Nom du compacteur } + Zoo_Tag : LongInt; { Identifie une archive Zoo } + Zoo_Start : LongInt; { Dbut des donnes } + Zoo_Minus : LongInt; { Vrification de concordance } + Zoo_Major : Char; { Version n } + b1 : byte; { ? } + Zoo_Minor : Char; { Sous-version n } + b2 : array[1..7] of Char; { ? } + End; + + DwcHdrType =Record + Dwc_Sign : Char; { Esc } + Dwc_Unkn : Array[1..15] of Char; + Dwc_Date : Longint; { Zeit der letzte nderung } + Dwc_File : Longint; { Anzahl der Dateien } + Dwc_Text : Array[1..3] of Char; { DWC } + End; + + LimHdrType=Record + Lim_Sign : Array[1..3] of Char; + Lim_Start: Byte; + b1 : Char; + Lim_Major: Char; + Lim_Minor: Char; + b2 : Char; + End; + + + Arctype = (ZIP,LHA,ARJ,HYPER,ZOO,ARC{PAK},DWC,SQZ,LIMIT,BSA,SIT,TPZ,UNKNOWN); + +var Tampon : Array[1..MaxTampon] of Byte; + Lu : word; + Arcfile : CopyStream; + Count : longint; + Cmt : boolean; + + j1,j2 : Word; + Flusher : LongInt; + d1,d2 : LongInt; + + + + i : Byte; + w : Word; + Li : LongInt; + St : String; + St2 : String; + + NomFic : String; + Algo : String[7]; + PSize : LongInt; { Packed Size } + USize : LongInt; { Unpacked (real) size } + Attr : Byte; + CRC : Longint; + + ZooHdr : ZooHdrTyp; + DwcHdr : DwcHdrType; + LimHdr : LimHdrType; + + aktverz : pathstr; + NomficPath: Dirstr; + NomficName: FileNameStr; + Arcformat : Arctype; + +label Fin; + + + + + procedure VEinordnen(Path:Pathstr; Name:FileNameStr; Psize,Usize:longint; anfang:word; ebene :byte); + var stop : boolean; + Nom : FileNameStr; + + procedure Einsetzen; + var k : word; + begin + For k:=dat.veranz downto anfang do + dat.ver[k+1]:=dat.ver[k]; + dat.ver[anfang].name :=Nom; + dat.ver[anfang].select :=false; + dat.ver[anfang].files :=0; + dat.ver[anfang].selgr :=0; + dat.ver[anfang].pos :=ebene; + dat.ver[anfang].Vopen :=true; + dat.ver[anfang].Vart :=Verzeichnis; + inc(dat.veranz); + end; + + begin + If Path[1]<>'\' then + Nom:=copy(Path,1,pos('\',Path)-1) else + Nom:=Path; + delete(Path,1,pos('\',Path)); + + If (Nom='\') then + begin + If Name<>'' then + begin + inc(dat.arcorig,Usize); + inc(dat.arckomp,Psize); + dat.ver[anfang].select:=true; + end; + stop:=true; + end else + begin + inc(anfang); stop:=false; + While ((not stop) or (Path>'')) and (not stop) do + begin + If (dat.veranz'' then + begin + VEinordnen(Path,Name,PSize,USize,anfang,ebene+1); + dat.ver[anfang].select:=false; + end else + If Name<>'' then + begin + inc(dat.arcorig,Usize); + inc(dat.arckomp,Psize); + dat.ver[anfang].select:=true; + end; + stop:=true; + end else + begin + If (dat.ver[anfang].name=Nom) then + If (Path='') then + begin + If Name<>'' then + begin + inc(dat.arcorig,Usize); + inc(dat.arckomp,Psize); + dat.ver[anfang].select:=true; + end; + stop:=true; + end else + begin + VEinordnen(Path,Name,PSize,USize,anfang,ebene+1); + stop:=true; + end; + {EndIf} + If (dat.ver[anfang].posanfang) then + begin + Einsetzen; + If Path>'' then + begin + VEinordnen(Path,Name,PSize,USize,anfang,ebene+1); + dat.ver[anfang].select:=false; + end else + If Name<>'' then + begin + inc(dat.arcorig,Usize); + inc(dat.arckomp,Psize); + dat.ver[anfang].select:=true; + end; + stop:=true; + end;{IF} + {EndIF} + end;{EndIf} + inc(anfang); + end{While}; + end{IF}; + end; + + + procedure DEinordnen(Name :filenamestr); + begin + inc(dat.filanz); + dat.fil[dat.filanz].name :=Lostring(Name); + dat.fil[dat.filanz].attr :=attr; + dat.fil[dat.filanz].time :=Li; + dat.fil[dat.filanz].size :=Usize; + dat.fil[dat.filanz].uns :=dat.filanz; + dat.fil[dat.filanz].select:=false; + + dat.fil[dat.filanz].Crc :=CRC; + dat.fil[dat.filanz].Psize :=Psize; + dat.fil[dat.filanz].Algo :=Algo; + + end; + + + + function Arctest : Arctype; + var Ext : string[3]; + begin + Arctest:=Unknown; + Arcfile.Read(Tampon[1],Count,MaxTampon); + If not Arcfile.OK then exit; + Ext:=upstring(justextension(Arcname)); + Move(Tampon[1],w,2); {ZIP} + If w=$4b50 then + begin + dat.arckind:='PKZIP'; + Move(Tampon[3],w,2); + If w=$0807 then + Count:=4; + Arctest:= ZIP; exit; + end; + + Move(Tampon[1],w,2); {ARJ} + If (w=$EA60) and (Tampon[11]=2) then + begin + dat.arckind:='ARJ'; + Move(Tampon[3],w,2); + Count:=4+w+4+2; + Arctest:= ARJ; exit; + end; + + st[0]:=Chr(3); + Move(Tampon[1],st[1],3); {Hyper} + If (st = Chr($1A)+'HP') or (st = Chr($1A)+'ST') then + begin + dat.arckind:='HYPER'; + Arctest:= HYPER; exit; + end; + + st[0]:=Chr(3); + Move(Tampon[3],st[1],3); {LHA} + If st = '-lh' then + begin + dat.arckind:='LHA'; + Arctest:=LHA; exit; + end; + + If Arcfile.result>SizeOf(ZooHdr) then {ZOO} + begin + Move(Tampon[1],ZooHdr,SizeOf(ZooHdr)); + st[0]:=Chr(3); + Move(ZooHdr.Zoo_text[1],st[1],3); + IF st='ZOO' then + begin + dat.arckind:='ZOO'; + Count:=ZooHdr.Zoo_Start; + Arctest:=ZOO; exit; + end; + end; + + Move(Tampon[1],i,1); {ARC} + If i = $1A then + begin + dat.arckind:='ARC/PAK'; + Arctest:=ARC; exit; + {Arctest:=PAK} + end; + + st[0]:=Chr(5); + Move(Tampon[1],st[1],5); {SQZ} + If st='HLSQZ' then + begin + dat.arckind:='SQZ'; + Count:=8; + Arctest:=SQZ; exit; + end; + + If Arcfile.result>SizeOf(LimHdr) then {LIMIT} + begin + Move(Tampon[1],LimHdr,SizeOf(LimHdr)); + If LimHdr.Lim_Sign = 'LM'+CHR($1A) then + begin + dat.arckind:='LIMIT'; + Count:=LimHdr.Lim_Start; + Arctest:=LIMIT; exit; + end; + end; + + Move(Tampon[1],Li,4); {BSA} + If Li = $475342FF then + begin + dat.arckind:='BSA'; + Count:=6; + Arctest:=BSA; exit; + end; + + If Arcfile.result>SizeOf(DwcHdr) then {DWC} + begin + Li:=Arcfile.Size-SizeOf(DwcHdr); + Arcfile.Read(DwcHdr,Li,SizeOf(DwcHdr)); + If DwcHdr.Dwc_Text = 'DWC' then + begin + dat.arckind:='DWC'; + Count:=Li-34*DwcHdr.Dwc_File; + Arctest:=DWC; exit; + end + end; + + if Ext='SIT' then {SIT-StuffIt} + Begin + dat.arckind:='STUFFIT'; + Count:=150; + Arctest:=SIT; exit; + End; + + If Ext='TPZ' then {TPZ} + begin + dat.arckind:='TPZ'; + Arctest:=TPZ; exit; + end; + + + + end; + + + +begin + If ver_dat then + begin + for w:=0 to 10 do + begin + dat.ver[w].name:=''; + dat.ver[w].files:=0; + end; + dat.arcorig:=0; {Summe von orig. Gre} + dat.arckomp:=0; {Summe von packed. Gre} + dat.ver[1].name:=justfilename(Arcname); + dat.ver[1].pos:=0; + dat.ver[1].select:=false; + dat.ver[1].files :=0; + dat.ver[1].Vopen:=true; + dat.ver[1].Vart :=Packer; + dat.veranz :=1; + end else + begin + aktverz:=fullpath(vpos); + If aktverz<>'\' then + delete(aktverz,1,1); + aktverz:=addbackslash(aktverz); + dat.fil[1].name:='.'; + dat.fil[1].select:=false; + dat.filanz:=1; dat.fanf:=1; + dat.fpos:=1; + end; + + FindFirst(Arcname, $27, Dirinfo); + If ((Dirinfo.name='') or (Doserror>0)) then + begin + Arcviewer:=false; + Doserror:=0; exit; + end; + + If ver_dat then + begin + dat.ver[2].name:='\'; + dat.ver[2].pos:=0; + dat.ver[2].select:=false; + dat.ver[2].files :=0; + dat.ver[2].Vopen :=true; + dat.ver[2].Vart :=Verzeichnis; + dat.veranz :=2; + end; + + Arcfile.Init(Arcname,1); + + FileMode:=0; {Nur zum Lesen ffnen} + Arcfile.Open; + FileMode:=2; + + Lu:=0; Count:=0; + + Arcviewer:=true; + If not Arcfile.Ok then + begin + Arcviewer:=false; Goto Fin; + end; + + Arcformat := Arctest; + If Arcformat=Unknown then + begin + IO_Error(concat('Archiv: ', Shrinkpath(Arcname,20)),'IOERROR.MSG',225,AR1); + Arcviewer:=false; Goto Fin; + end; + + + If Demo and not (Arcformat in [Unknown,ARJ]) then + begin + St:=concat('Archivbetrachter ''',dat.arckind,''':'); + IO_Error(St,'IOERROR.MSG',229,AR1); + Arcviewer:=false; Goto Fin; + end; + + + repeat + Cmt:=False; + Arcfile.Read(Tampon[1],Count,MaxTampon); + If (Arcfile.result<26) then Goto Fin; + + If not Arcfile.Ok then + begin + Arcviewer:=false; Goto Fin; + end; + + + if Arcformat = ZIP then + Begin + Move(Tampon[1],Li,4); if Li=$02014B50 then Goto Fin; + Move(Tampon[9],w,2); + Case w of + 0: Algo:='Stored '; + 1: Algo:='Shrunk '; + 2..5: Algo:='Reduce'+Chr(w-1); + 6: Algo:='Implode'; + 7: Algo:='Token '; + 8: Algo:='DeflatX'; + else Algo:='Unknown'; + End; + Move(Tampon[13],w,2); Li:=LongInt(w) shl 16; + Move(Tampon[11],w,2); Li:=Li+w; + Move(Tampon[15],Crc,4); + Attr:=0; + Move(Tampon[19],PSize,4); + Move(Tampon[23],USize,4); + Move(Tampon[27],w,2); if w>255 then w:=255; + NomFic[0]:=Chr(w); Move(Tampon[31],NomFic[1],w); + Flusher:=30+w+PSize; + Move(Tampon[29],w,2); + Attr:=0; + Flusher:=Flusher+w; + End else + if Arcformat = ARJ then + Begin + Move(Tampon[17],PSize,4); + Move(Tampon[21],USize,4); + Move(Tampon[25],Crc,4); + Move(Tampon[31],Attr,1); + i:=35; NomFic:=''; + While (Tampon[i]<>0) and (i'-lh' then Goto Fin; + Move(Tampon[22],NomFic,Tampon[22]+1); + Algo[0]:=#5; Move(Tampon[3],Algo[1],5); + Move(Tampon[8],PSize,4); + Move(Tampon[12],USize,4); + Move(Tampon[18],w,2); Li:=LongInt(w) shl 16; + Move(Tampon[16],w,2); Li:=Li+w; + Move(Tampon[20],Attr,1); + Move(Tampon[Tampon[22]+1],w,2); Crc:=w; + + i:=Tampon[Tampon[1]+1]; st:=''; {Verzeichnis lesen} + If i > 0 then + begin + i:=Tampon[1]+5; + While (Tampon[i]<>5 ) and (iZooId then Goto Fin; + Flusher:=0; Move(Tampon[7],Count,4); + If Count=0 then Goto Fin; + Case Tampon[6] of + 0: Algo:='Stored'; + 1: Algo:='Lzw'; + else Begin Str(Tampon[6]:3,Algo); Algo:='? '+Algo; End; + End; + Move(Tampon[20],w,2); Crc:=w; + Move(Tampon[25],PSize,4); + Move(Tampon[21],USize,4); + i:=39; NomFic:=''; + While (Tampon[i]<>0) and (i0) do Begin {Verzeichnis} + st:=st+UpCase(Chr(Tampon[i])); Inc(i); End; + Nomfic:=concat(addbackslash(st),Nomfic); + Move(Tampon[15],w,2); Li:=LongInt(w) shl 16; + Move(Tampon[17],w,2); Li:=Li+w; + Attr:=0; + End else + If Arcformat = ARC then + begin + Case Tampon[2] of + 0: Goto Fin; + 1: Algo:='Stor1'; + 2: Algo:='Stor2'; + 3: Algo:='Packd'; + 4: Algo:='Squzd'; + 5: Algo:='Crun1'; + 6: Algo:='Crun2'; + 7: Algo:='Crun3'; + 8: Algo:='Crun4'; + 9: Algo:='Sqash'; + 10: Algo:='Crushed'; + 11: Algo:='Distill'; + else Algo:='Unknown'; + End; + i:=3; NomFic:=''; + While Tampon[i]<>0 do Begin NomFic:=NomFic+Chr(Tampon[i]); Inc(i); End; + Move(Tampon[16],PSize,4); + if Tampon[2]=1 then USize:=PSize + else Move(Tampon[26],USize,4); + if Tampon[2]=1 then Flusher:=25+PSize + else Flusher:=29+Psize; + Move(Tampon[20],Li,2); Li:=LongInt(Li) shl 16; + Move(Tampon[22],w,2); Li:=Li+w; + Move(Tampon[24],w,2); Crc:=w; + Attr:=0; + End else + If Arcformat = DWC then + Begin + If DwcHdr.Dwc_File=0 then Goto Fin; + dec(DwcHdr.Dwc_File); + i:=1; Nomfic:=''; + While Tampon[i]<>0 do Begin NomFic:=NomFic+Chr(Tampon[i]); Inc(i); End; + Move(Tampon[16],PSize,4); + Move(Tampon[14],Usize,4); + {Move(Tampon[18],Li,4);} Li:=0; + Move(Tampon[22],Psize,4); + case Tampon[27] of + 1: Algo:='Crunche'; + 2: Algo:='Stored'; + else Algo:='Unknown'; + end; + Move(Tampon[29],w,2); Crc:=w; + Attr:=0; + Flusher:=34; + End else + If Arcformat = SQZ then + begin + Nomfic:=''; + If Tampon[1]>18 then + begin + case Tampon[3] of + 0 : Algo:='Stored'; + 1..7: Algo:='Comp-'+Chr($30+Tampon[3]); + else Algo:='Unknown'; + end; + Move(Tampon[4],PSize,4); + Move(Tampon[8],USize,4); + Move(Tampon[12],Li,4); + Move(Tampon[16],Attr,1); + Move(Tampon[17],Crc,4); + Nomfic[0]:=Chr(Tampon[1]-18); + Move(Tampon[21],Nomfic[1],Tampon[1]-18); + Flusher:=Tampon[1]+PSize+2; + end else + case Tampon[1] of + 0 : Goto Fin; + else Flusher:=Tampon[2]+3; + End; + NomFic:=justfilename(NomFic); {kein Verzeichnislschen !!!!} + End else + If Arcformat = LIMIT then + begin + Move(Tampon[1],w,2); + If w=$F813 then Goto Fin; + If w=$D180 then {Verzeichnis} + begin + i:=5; st:=''; + While Tampon[i]<>0 do Begin st:=st+Chr(Tampon[i]); Inc(i); End; + Flusher:=Tampon[3]; + Nomfic:=''; + end; + If w=$F123 then {Datei} + begin + Move(Tampon[7],Li,4); + Move(Tampon[11],Attr,1); + Move(Tampon[14],Usize,4); + Move(Tampon[18],Psize,4); + Move(Tampon[22],Crc,4); + i:=26; NomFic:=''; + While (Tampon[i]<>0) and ($10<>(Attr and $10)) do + Begin NomFic:=NomFic+Chr(Tampon[i]); Inc(i); End; + Nomfic:=concat(addbackslash(st),Nomfic); + Algo:=' '; {??} + Flusher:=Tampon[3]+PSize; + end; + end else + If Arcformat = BSA then + begin + Move(Tampon[11],Li,4); Reverse(Li); + i:=15; NomFic:=''; + While (Tampon[i]<>0) do Begin NomFic:=NomFic+Chr(Tampon[i]); Inc(i); End; + Move(Tampon[Tampon[6]-5],Usize,4); Reverse(Usize); + Move(Tampon[Tampon[6]-1],PSize,4); Reverse(Psize); + Move(Tampon[Tampon[6]+3],Crc,4); + Attr:=0; + Algo:=' '; {??} + Flusher:=Tampon[6]+Psize+10 + end else + If Arcformat = SIT then + Begin + Move(Tampon[3],NomFic,64); + Move(Tampon[85],USize,4); Reverse(USize); + Move(Tampon[93],PSize,4); Reverse(PSize); + Move(Tampon[89],d1,4); Reverse(d1); + Move(Tampon[97],d2,4); Reverse(d2); + PSize:=PSize+d2; USize:=USize+d1; + if Tampon[1]=0 then i:=Tampon[2] else i:=Tampon[1]; + Case i of + 0: Algo:='Stored'; + 2: Algo:='Lzw'; + else Algo:='Unknown'; + End; + Crc :=0; + Attr:=0; + Li:=0; + Flusher:=100+PSize+12; + End else + if Arcformat = TPZ then + Begin + Case Tampon[25] of + 0: Algo:='inclu'; + 1: Algo:='implo'; + End; + Move(Tampon[26],USize,4); + Move(Tampon[30],PSize,4); + NomFic:=''; + i:=56; + While (Tampon[i]<>32) And (i<56+67) do + Begin + NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i); + End; + i:=43; + While (Tampon[i]<>32) And (i<43+12) do + Begin + NomFic:=NomFic+UpCase(Chr(Tampon[i])); Inc(i); + End; + Crc :=0; + Attr:=0; + Flusher:=PSize+122; + Move(Tampon[36],Li,4); + End; + + + + While Pos('/',NomFic)<>0 do NomFic[Pos('/',NomFic)]:='\'; + + + i:=0; + + If Nomfic<>'' then + begin + If pos('\',Nomfic)=1 then delete(Nomfic,1,1); + If pos('\',Nomfic)=0 then Nomfic:=concat('\',Nomfic); + end; + + Nomfic:=upstring(nomfic); + NomficName:= justfilename(NomFic); + If (pos('.',NomficName)=0) and (length(NomficName)>0) then + NomficName:=concat(NomficName,'.'); + NomficPath := justpathname(Nomfic); + + If (Li>=DateMini) and (Li and $FFFF0000<=DateMaxi) and + (USize>=TailleMini) and (USize<=TailleMaxi) then + If (NomFic<>'') and not Cmt then + Begin + If ver_dat then + VEinordnen(NomficPath, NomficName,PSize,USize,2,1) else + If (aktverz=NomficPath) and CompFilename('*.*',NomFicName) and + (Attr<>Directory) and (((Attr and m_attrib)>0) + and (not ((Attr and $18) in[$10,$8])) or (Attr=0)) then + DEinordnen(NomficName); + end; + + Inc(Count,Flusher); + + until false; + + + Fin : + + Arcfile.Close; + +End; + + + + + + +Function Archivfenster.VerzNeu : boolean; +begin + VerzNeu:=ArcViewer(true,0); + If fullpath(dat.vpos)<>dat.aktverz then dat.ver_dat:=true; +end; + +function Archivfenster.Dateilesen (vpos:word): boolean; +begin + Dateilesen:=Arcviewer(false,vpos); +end; + +procedure Archivfenster.Fakt; +begin + {RFenster^.Drivewrite(False);} + Arcname:=concat(addbackslash(RFenster^.dat.aktverz),RFenster^.dat.fil[RFenster^.dat.fpos].name); + If VerzNeu then + begin + dat.vpos:=1; dat.sanf:=1; dat.wanf:=1; einmal:=false; dat.ver_dat:=true; + LaBu:=RFenster^.LaBu; + ClrUnterf; + UnselectAll; + Fenakt(True,False,False); + Arcopen:=true; + end; +end; + + +function Archivfenster.Packen_EntPacken : boolean; +begin + Packen_EntPacken:=EntPacken; +end; + + +function Archivfenster.Entpacken:boolean; +const M : Message = 'Fehler beim Dekomprimieren :'; +var tas,fun : char; + entpack : byte; + i : byte; + Vp : Dparam; + ausw : boolean; + Bu : Button; + Sb : SelButton; + Ed2 : Edit; + zahl : string[10]; + weiter : boolean; + entp : boolean; + + +begin + Entpacken:=false; Packer_File.Open; + If not dat.ver_dat and (dat.filanz>1) then Packdateiwrite(dat.vpos); + Listendatei(Kom.sel,ausw); + entpack:=0; Packer_File.Seek(entpack); + If Kom.sel=0 then + begin + IO_Error(concat(M),'IOERROR.MSG',222,AR1); exit; + end; + Kom.datei:=upstring(Rfenster^.dat.fil[Rfenster^.dat.fpos].name); + Vp.Arcend:=''; + while not Packer_File.EoF and not CompArcend(Vp.Arcend,Kom.datei) do + Packer_File.Read(Vp,-1,1); + Kom.pack:=Packer_File.Pos-1; + Packer_File.Close; + Kom.pas:=''; + If (trim(Vp.EmitV)>'') then + Kom.path:=true else Kom.path:=false; + + If not openwindow(60,9,fenfo,fenba,'Dekomprimieren') then exit; + + writeXY(3,2,'Entpacken von :'); + + If (Kom.sel>0) and ausw then + begin + str(Kom.sel,zahl); + If Kom.sel>1 then + writeXY(19,2,concat(zahl,' Dateien')) else + writeXY(19,2,concat(zahl,' Datei')); + end else + writeXY(19,2,concat(upstring(dat.fil[dat.fpos].name))); + + writeXY(3,4,concat('aus Archiv : ',Kom.datei)); + + If (trim(Vp.passw)>'') then + Initeditor(Ed2,45,4,'Passwort :',true,Kom.pas,12); + + InitSelButton(Sb,3,7,'Mit Verzeichnissen',Kom.path,1); Sb.Anz:=1; + + InitButton(Bu,10 ,9,' ~Dekomprimieren ',ALT_D,1); + InitButton(Bu,38,9, ' ~Abbruch ', ALT_A,2); Bu.Anz:=2; + + I:=4;weiter:=false; entp:=false; + repeat + + + If (trim(Vp.EmitV)>'') then + SetSelButton(Sb); + If (trim(Vp.passw)>'') then + SetEditor(Ed2); + + SetButton(Bu); + case I of + 2: ActiveEditor(Ed2); + 3: ActiveSelButton(Sb); + 4: ActiveButton(Bu); + end; + + case EventThisButton(Bu) of + 1: begin + If (trim(Vp.passw)>'') then + Kom.pas :=Ed2.T; + If (trim(Vp.EmitV)>'') then + Kom.path :=Sb.Sb[1].S; + entp:=true; + weiter:=true; + end; + 2: begin + weiter:=true; + end; + end; + + If (trim(Vp.passw)>'') then + If EventEditor(Ed2) then I:=2; + If (trim(Vp.EmitV)>'') then + If EventSelButton(Sb) then I:=3; + + case ev.key of + CUP, + BACKTAB: begin + If I>1 then dec(I) else I:=4; + If (trim(Vp.EmitV)='') and (I=3) then dec(I); + If ((trim(Vp.passw)='') or ausw ) and (I=2) then dec(I); + end; + CDOWN, + TAB : begin + If I<4 then inc(I) else I:=1; + If ((trim(Vp.passw)='') or ausw ) and (I=2) then inc(I); + If (trim(Vp.EmitV)='') and (I=3) then inc(I); + end; + ESC : weiter:=true; + F1 : Hilfe.ViewPage(24); + end; + until weiter; + closewindow; + If entp then Dekomprimieren; + Entpacken:=entp; +end; + + + procedure ArchivFenster.Dekomprimieren; + const M = 'Fehler beim Dekomprimieren :'; + var Cmdline,progdir : pathstr; + tstr : pathstr; + Vp : Dparam; + ex : byte; + + begin + Dosexitcode; + Packer_File.Open; + Packer_File.read(Vp,kom.pack,1); + Packer_File.Close; + If trim(Vp.entp)='' then Vp.entp:=Vp.verp; + Progdir:=concat(addbackslash(m_packverz),Vp.entp,' '); + FindFirst(Progdir, $27, DirInfo); + If ((Dirinfo.name='') or (Doserror>0)) then + begin + execend(Vp.verp,concat(M,' ',Vp.entp),Ar1); MouShowMouse; + Doserror:=0;exit; + end; + + chver(LFenster^.dat.aktverz); + If m_interM then + begin + If not savewin(2,2,crtxmax-ShadowX,crtymax-ShadowY) then exit; + MouHideMouse; Ausblenden; + end else + begin + If not openwindow(31,4,fenfo,fenba,'Dekomprimieren') then exit; + textcolor(MessageCol); + If Kom.sel>1 then + writeXY(9,2,'Entpacke Dateien...') else writeXY(9,2,'Entpacke Dateien...'); + MouHideMouse;redout; + end; + + Cmdline:=''; + If Kom.path then + Cmdline:=Vp.EmitV else Cmdline:=Vp.EohneV; + If Kom.pas>'' then + Cmdline:=concat(Cmdline,' ',Vp.passw,Kom.pas); + + Cmdline:=concat(CmdLine,' ',addbackslash(Rfenster^.dat.aktverz),Kom.datei); + + If trim(Vp.packdat)>'' then + begin + Cmdline:=concat(Cmdline,' ',Vp.packdat,addbackslash(m_tempverz),'PDAT.LST'); + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline)); + until execend(Vp.verp,M,Ar2)=2; + end else + begin + Pdat.Open; ex:=0; + while not Pdat.EOF and (ex<>3) do + begin + Pdat.Readln(tstr); + If not m_InterM then + begin + textcolor(fenfo); textbackground(fenba); + writeXY(1,4,center(justfilename(tstr),31)); + end; + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline,' ',tstr)); + ex:=execend(Vp.verp,M,Ar3); + until ex in [2,3]; + end; + Pdat.Close; + + end; + + If not m_interM then + begin + redback; closewindow + end else + If not m_flashend then + begin + Blackscreen; restwindow; Einblenden; + end; + MouShowMouse; + + end; + + +procedure Archivfenster.Floschen; +const M : Message = 'Fehler beim Lschen '; + +var Vp : Dparam; + Progdir, + CmdLine: pathstr; + fhohe : byte; + ex : byte; + tstr : pathstr; + +begin + Dosexitcode; + Kom.arc:=RFenster^.dat.fil[RFenster^.dat.fpos].name; + Vp.arcend:=''; + Packer_File.Open; + while not Packer_File.EOF and not CompArcend(Vp.Arcend,Kom.arc) do + Packer_File.Read(Vp,-1,1); + Packer_File.Close; + + Progdir:=concat(addbackslash(m_packverz),Vp.verp,' '); + FindFirst(Progdir, $27, DirInfo); + If ((Dirinfo.name='') or (Doserror>0)) then + begin + execend(Vp.verp,concat(M,' ',Vp.verp),Ar1); MouShowMouse; + Doserror:=0;exit; + end; + + Cmdline:=concat(Vp.datdel,' ',addbackslash(RFenster^.dat.aktverz),Kom.arc); + + If m_interM then + begin + If not savewin(2,2,crtxmax-ShadowX,crtymax-ShadowY) then exit; + MouDefBereich(2,Map); + MouHideMouse; Ausblenden; + end else + begin + If trim(Vp.packdat)>'' then fhohe:=2 else fhohe:=4; + If not openwindow(31,fhohe,fenfo,fenba,'Lschen') then exit; + textcolor(MessageCol); + If Kom.sel=1 then + writeXY(10,2,'Lsche Datei...') else writeXY(10,2,'Lsche Dateien...'); + MouHideMouse; redout; + end; + + + + If Kom.sel=0 then + begin + Cmdline:=Cmdline+' '+Kom.datei; + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline)); + until execend(Vp.verp,M,Ar2)=2; + end else + begin + If trim(Vp.packdat)>'' then + begin + Cmdline:=concat(Cmdline,' ',Vp.packdat,addbackslash(m_tempverz),'PDAT.LST'); + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline)); + until execend(Vp.verp,M,Ar2)=2; + end else + begin + Pdat.Open; ex:=0; + while not Pdat.EOF and (ex<>3) do + begin + Pdat.Readln(tstr); + If not m_InterM then + begin + textcolor(fenfo); textbackground(fenba); + writeXY(1,4,center(justfilename(tstr),31)); + end; + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline,' ',tstr)); + ex:=execend(Vp.verp,M,Ar3); + until ex in [2,3]; + end; + Pdat.Close; + end; + end; + + If not m_interM then + begin + redback; + closewindow; + end else + If not m_flashend then + begin + Blackscreen; restwindow; Einblenden; + end; + MouShowMouse; +end; diff --git a/UNITS/EMS.PAS b/UNITS/EMS.PAS new file mode 100644 index 0000000..6464f84 --- /dev/null +++ b/UNITS/EMS.PAS @@ -0,0 +1,262 @@ +{*************************************************************************** +* E M S : eine Unit, die als Schnittstellte zwischen einem Programm und * +* dem Expanded Memory Manager (EMM) fungiert und dadurch die * +* Mglichkeit zum Zugriff auf den EMS-Speicher bietet. * +**------------------------------------------------------------------------** +* Autor : MICHAEL TISCHER * +* entwickelt am : 9.06.1989 * +* letztes Update am: 9.06.1989 * +***************************************************************************} + +unit Ems; + +interface +uses Dos; + +{-- Deklaration der Funktionen und Prozeduren, die von einem anderen ------} +{-- Programm aufgerufen werden knnen ------} + +function EmsGetFreePage : integer; +function EmsGetPtr ( PhysPage : byte ) : pointer; +function EmsAlloc ( Anzahl : integer ) : integer; +procedure EmsMap ( Handle, LogPage : integer; PhysPage : byte ); +procedure EmsFree ( Handle : integer ); +procedure EmsRestoreMapping( Handle : integer ); +procedure EmsSaveMapping ( Handle : integer ); + +{-- Konstanten, ffentlich ------------------------------------------------} + +const {--------------------------------------------- EMS-Fehlercodes ------} + + EmsErrOk = $00; { alles o.k., kein Fehler } + EmsErrSw = $80; { Fehler im EMM (Software) } + EmsErrHw = $81; { EMS-Hardware-Fehler } + EmsErrInvHandle = $83; { ungltiges EMS-Handle } + EmsErrFkt = $84; { aufgerufene Funktion ungltig } + EmsErrNoHandles = $85; { keine Handles mehr frei } + EmsErrSaResMap = $86; { Fehler beim Sichern oder Zurckspeichern } + { des Mappings } + EmsErrToMany = $87; { mehr Seiten angefordert, als physikalisch } + { vohanden sind } + EmsErrNoPages = $88; { mehr S. angefordert, als noch frei sind } + EmsErrNullPages = $89; { Null Seiten angefordert } + EmsErrLogPInv = $8A; { logische Seite gehrt nicht zum Handle } + EmsErrPhyPInv = $8B; { ungltige physikalische Seitennummer } + EmsErrMapFull = $8C; { Mapping-Speicherbereich ist voll } + EmsErrMapSaved = $8D; { Mapping wurde bereits gesichert } + EmsErrMapRes = $8E; { Zurckspeichern des Mappings ohne vorher- } + { gehendes Sichern } + +{-- globale Variable, die auch anderen Programmen zugnglich sind ---------} + +var EmsInst : boolean; { ist TRUE, wenn EMS-Speicher verfgbar } + EmsPages : integer; { Gesamtanzahl der EMS-Pages } + EmsVersion, { EMS-Versionsnummer (32 = 3.2, 40 = 4.0) } + EmsError : byte; { nimmt EMM-Fehlernummer auf } + +implementation + +{-- Konstanten, modulintern -----------------------------------------------} + +const EMS_INT = $67; { Interrupt-Vektor zum Zugriff auf EMM } + +{-- globale Variablen, modulintern ----------------------------------------} + +var EmsFrameSeg : word; { Segmentadresse des EMS-Page-Frames } + +{*************************************************************************** +* EmsInit : Initialisiert die Unit. * +***************************************************************************} + +procedure EmsInit; + +type EmmName = array [1..8] of char; { Name des EMM im Treiber-Kopf } + EmmNaPtr = ^EmmName; { Zeiger auf Namen im Treiber-Kopf } + +const Name : EmmName = 'EMMXXXX0'; { Name des EMS-Treibers } + +var Regs : Registers; { Prozessorregs. fr Interruptaufruf } + +begin + {-- zunchst feststellen, ob EMS-Speicher und ein zugehriger EMM -------} + {-- installiert sind -------} + + Regs.ax := $35 shl 8 + EMS_INT; { Interruptvektor $67 ber } + msdos( Regs ); { DOS-Funktion 35h holen } + + EmsInst := ( EmmNaPtr(Ptr(Regs.ES,10))^ = Name ); { Treiber-Name vergl. } + + if ( EmsInst ) then { ist ein EMM installiert? } + begin { Ja } + + {-- Gesamtanzahl der EMS-Pages ermitteln ----------------------------} + Regs.AH := $42; { Funktionsnr. fr "Anzahl Pages ermitteln" } + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsPages := Regs.DX; { Gesamtanzahl der Pages merken } + + {-- Segmentadresse des EMS-Page-Frames ermitteln --------------------} + Regs.AH := $41; {Funktionsnr. fr "Segmentad. des Page-Frames laden"} + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsFrameSeg := Regs.BX; { Segmentadresse merken } + + {-- Versionsnummer des EMM ermitteln --------------------------------} + Regs.AH := $46; { Funktionsnr. fr "Versionsnummer ermitteln" } + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsVersion := ( Regs.AL and 15 ) + ( Regs.AL shr 4 ) * 10; + + EmsError := EmsErrOk; { bisher kein Fehler } + + end; +end; + +{*************************************************************************** +* EmsGetPtr : Liefert einen Zeiger auf eine der vier physikalischen * +* Pages im EMS-Page-Frame. * +**------------------------------------------------------------------------** +* Eingabe : PhysPage = Nummer der physikalischen Page * +* Ausgabe : Zeiger auf diese Page * +***************************************************************************} + +function EmsGetPtr( PhysPage : byte ) : pointer; + +begin + EmsGetPtr := ptr( EmsFrameSeg, PhysPage shl 14 ); +end; + +{*************************************************************************** +* EmsGetFreePage : Ermittelt die Anzahl der noch nicht belegten EMS- * +* Pages. (1 Page entspricht 16 KByte) * +**------------------------------------------------------------------------** +* Ausgabe : Die Anzahl freier Pages. * +***************************************************************************} + +function EmsGetFreePage : integer; + +var Regs : Registers; { Prozessorregs. fr den Interruptaufruf } + +begin + Regs.AH := $42; { Funktionsnr. fr "Anzahl Pages ermitteln" } + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsGetFreePage := Regs.BX; { Anzahl freier Pages zurckliefern } +end; + +{*************************************************************************** +* EmsAlloc : Allokiert eine bestimme Anzahl von EMS-Pages. * +**------------------------------------------------------------------------** +* Eingabe : Anzahl = Anzahl zu allokierender Pages * +* Ausgabe : Handle zum weiteren Zugriff auf die allokierten Pages * +* Info : Tritt ein Fehler auf, enthlt die Variable EmsError nach dem * +* Funktionsaufruf einen Wert ungleich 0 und gibt damit einen * +* Fehlercode an. * +***************************************************************************} + +function EmsAlloc( Anzahl : integer ) : integer; + +var Regs : Registers; { Prozessorregs. fr den Interruptaufruf } + +begin + Regs.AH := $43; { Funktionsnr. fr "Pages allokieren" } + Regs.BX := Anzahl; { Anzahl Pages wird in BX bergeben } + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsAlloc := Regs.DX; { das Handle wird in DX bergeben } + EmsError := Regs.AH; { Fehler? } +end; + +{*************************************************************************** +* EmsMap : Bildet ein der allokierten Pages auf eine der 4 physika- * +* lischen Pages im EMS-Page-Frame ab. * +**------------------------------------------------------------------------** +* Eingabe : Handle = Handle, unter dem die angesprochene Page allo- * +* kiert wurde. * +* LogPage = Nummer der abzubildenen (logischen) Page * +* PhysPage = Nummer der physikalischen Page * +* Info : Tritt ein Fehler auf, enthlt die Variable EmsError nach dem * +* Funktionsaufruf einen Wert ungleich 0 und gibt damit einen * +* Fehlercode an. * +***************************************************************************} + +procedure EmsMap( Handle, LogPage : integer; PhysPage : byte ); + +var Regs : Registers; { Prozessorregs. fr den Interruptaufruf } + +begin + Regs.AH := $44; { Funktionsnr. fr "Map expanded Memory Page" } + Regs.DX := Handle; { die Parameter in die Register laden } + Regs.BX := LogPage; + Regs.Al := PhysPage; + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsError := Regs.AH; { Fehler? } +end; + +{*************************************************************************** +* EmsFree : Gibt zuvor ber die Funktion EmsAlloc allokierte EMS-Pages * +* wieder frei. * +**------------------------------------------------------------------------** +* Eingabe : Handle = Das Handle, unter dem die Pages allokiert wurden. * +* Info : Tritt ein Fehler auf, enthlt die Variable EmsError nach dem * +* Funktionsaufruf einen Wert ungleich 0 und gibt damit einen * +* Fehlercode an. * +***************************************************************************} + +procedure EmsFree( Handle : integer ); + +var Regs : Registers; { Prozessorregs. fr den Interruptaufruf } + +begin + Regs.AH := $45; { Funktionsnr. fr "Release Handle & EMS" } + Regs.DX := Handle; { die Parameter in die Register laden } + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsError := Regs.AH; { Fehler? } +end; + +{*************************************************************************** +* EmsSaveMapping : Sichert die aktuelle Abbildung logischer EMS-Pages in * +* die vier physikalischen Pages des EMS-Page-Frames. * +**------------------------------------------------------------------------** +* Eingabe : Handle = Das Handle, unter dem die Pages allokiert wurden. * +* Info : Tritt ein Fehler auf, enthlt die Variable EmsError nach dem * +* Funktionsaufruf einen Wert ungleich 0 und gibt damit einen * +* Fehlercode an. * +***************************************************************************} + +procedure EmsSaveMapping( Handle : integer ); + +var Regs : Registers; { Prozessorregs. fr den Interruptaufruf } + +begin + Regs.AH := $47; { Funktionsnr. fr "Save Mapping" } + Regs.DX := Handle; { die Parameter in die Register laden } + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsError := Regs.AH; { Fehler? } +end; + +{*************************************************************************** +* EmsRestoreMapping : Holt eine zuvor mit HIlfe der Prozedur EmsSave- * +* Mapping gespeicherte Abbildung zwischen den lo- * +* gischen Pages und den vier physikalischen Pages im * +* EMS-Page-Frame wieder zurck. * +**------------------------------------------------------------------------** +* Eingabe : Handle = Das Handle, unter dem die Pages allokiert wurden. * +* Info : Tritt ein Fehler auf, enthlt die Variable EmsError nach dem * +* Funktionsaufruf einen Wert ungleich 0 und gibt damit einen * +* Fehlercode an. * +***************************************************************************} + +procedure EmsRestoreMapping( Handle : integer ); + +var Regs : Registers; { Prozessorregs. fr den Interruptaufruf } + +begin + Regs.AH := $48; { Funktionsnr. fr "Restore Mapping" } + Regs.DX := Handle; { die Parameter in die Register laden } + intr( EMS_INT, Regs ); { EMM aufrufen } + EmsError := Regs.AH; { Fehler? } +end; + +{**----------------------------------------------------------------------**} +{** Startcode der Unit **} +{**----------------------------------------------------------------------**} + +begin + EmsInit; { die Unit intialisieren } +end. \ No newline at end of file diff --git a/UNITS/INIT.PAS b/UNITS/INIT.PAS new file mode 100644 index 0000000..67f4070 --- /dev/null +++ b/UNITS/INIT.PAS @@ -0,0 +1,463 @@ +unit Init; +Interface +uses dos,crt,kbm,Tkstring,Tkstream,Tpinst,Tksaa,Tkdisk,Tkview2,Tkwin,Tkview, + Tkvideo; + +const + vertiefe=40; + packanz =99; + veranz =700; + dateianz=1000; + datanz =65535; + ko_anz =3; + Endganz =3; + + Drivename = 'DRIVE.$$$'; + Leftdatname = 'LEFTDAT.$$$'; + Leftdatindex= 'LEFTIND.$$$'; + Rightdatname= 'RIGHTDAT.$$$'; + Rightdatindex='RIGHTIND.$$$'; + Arcdatname = 'ARCDAT.$$$'; + Arcdatindex = 'ARCIND.$$$'; + Packername = 'PACKER.CFG'; + Topname = 'TOP.CFG'; + Pdatname = 'PDAT.LST'; + Scriptdatei = '*.SCR'; + + sort : byte = 1; + attrib : byte = $27 {20}; + color : byte = 1; + prgend : boolean = false; + auto : boolean = true; + flashend : boolean = false; + ver : boolean = true; + interM : boolean = true; + packverz : string[50] = 'C:\TOP\PACKER'; + tempverz : string[50] = 'C:\TOP'; + restlauf : char = 'C'; + pack : byte=0; + komp : byte=2; + Name : string[40] ='EGNK'; + Strasse : string[40] =''; + Ort : string[40] =''; + Liznr : string[5] =''; + + Pfeilfo : Byte = white; + Pfeilba : Byte = black; + Winfo : Byte = white; + Winba : Byte = blue; + Balkenba : byte = cyan; + VcloseCol : byte = lightcyan; + PackerCol : byte = yellow; + LaufcuCol : byte = yellow; + SelNumCol : byte = lightgray; + MessageCol : byte = black; + Message2Col:byte = yellow; + Message3Col: byte=white; + Laufwerkfo : byte = white; + Laufwerkba : byte = cyan; + Funktionfo : byte = black; + Funktionba : byte = lightgray; + + + ko: array [0..Ko_anz] of FilenameStr =('NULL','MIN ','NORM','MAX '); + + Ar : Acceptrec = (' Wiederholen ',' Abbruch ',''); + { --- Demo --- } + demo : boolean = false; + + AR1 : Acceptrec = (' OK ','',''); + AR2 : Acceptrec = (' Wiederholen ',' Abbruch ',''); + AR3 : Acceptrec = (' Wiederholen ',' Weiter ',' Abbruch '); + + + +type + + PackPointer = ^PackPointRec; + PackPointRec = Record + name : FilenameStr; + next : PackPointer; + End; + + Packstr = text; + + DateiRec = Record + name : FilenameStr; + attr : byte; + time : longint; + size : longint; + uns : word; + select: boolean; + + Crc : longint; + Psize : longint; + Algo : string[7]; + End; + + Script_Rec = Record + Inkl : boolean; + Verz : Dirstr; + Datei: Filenamestr; + End; + + VartRec = (Verzeichnis,Packer); + + VerzeichnisRec = Record + name : FilenameStr; + select : boolean; + files : word; + selgr : longint; + pos : byte; + Vopen : boolean; { fr Baumstruktur } + VXpos : byte; + Vart : VartRec; + End; + + FVerzeichnis = Record + name : FilenameStr; + leftselect : boolean; + leftfiles : word; + leftselgr : longint; + leftVopen : boolean; + rightselect : boolean; + rightfiles : word; + rightselgr : longint; + rightVopen : boolean; + pos : byte; + End; + + + ADatei = array[1..dateianz] of DateiRec; + AVerzeichnis = array[0..veranz] of VerzeichnisRec; + DrVerzeichnis = array[0..veranz] of FVerzeichnis; + + FensterDat = Record + fil : ADatei; + filanz : word; + aktverz : pathstr; + ver : AVerzeichnis; + veranz : word; + vpos : word; + fpos : word; + ver_dat : boolean; + wanf : byte; + sanf : word; + fanf : word; + gesamtgr : longint; + gesamtdat : word; + selgr : longint; + dfree : longint; + dsize : longint; + arcorig : longint; + arckomp : longint; + arckind : string[7]; + End; + + Dtemp = Record + drive : char; + ver : DrVerzeichnis; + veranz : word; + dfree : longint; + dsize : longint; + leftwritten : boolean; + leftselgr : longint; + leftwanf : byte; + leftsanf : word; + leftvpos : word; + rightwritten: boolean; + rightwanf : byte; + rightsanf : word; + rightvpos : word; + End; + + + + Findex = Record + Lw : char; + VPos : word; + Fseek : longint; + End; + + Ftemp = Record + name : FilenameStr; + select : boolean; + ver_dat : boolean; + jump : word; + End; + + Dparam = Record + Verp : string[12]; + Entp : string[12]; + Arcend : string[11]; + PohneV : string[29]; + PmitV : string[29]; + VohneV : string[29]; + VmitV : string[29]; + EohneV : string[29]; + EmitV : string[29]; + PmitUv : string[13]; + max : string[13]; + norm : string[13]; + min : string[13]; + null : string[13]; + self : string[13]; + packdat : string[13]; + datdel : string[13]; + passw : string[13]; + multipleV : string[13]; + end; + + Kompr = Record + datei : FilenameStr; + sel : longint; + arc : string[12]; + pas : FilenameStr; + ver : boolean; + path : boolean; + Uv : boolean; + mV : boolean; + self : boolean; + pack : byte; + komp : byte; + ausw : boolean; + end; + + endg = Record + en : array [1..Packanz*Endganz] of string[5]; + packer: array [1..Packanz*Endganz] of byte; + fanz : byte; + end; + + FensterModeR = (Rechts,Links,Archiv); + + ToggleRec =(normal,spez1,spez2); + +var + dummy : integer; + xanfR,xanfL,yanf, + xdiff,ydiff : byte; + Kom : Kompr; + z : word; + DirInfo : SearchRec; + wmi,wma : word; + FensterM : FensterModeR; + F : file of Ftemp; + D : file of Dparam; + ev1 : Event; + Fu,He : Button; + weiter : boolean; + Ftaste : integer; + Verzdel : boolean; + + + test : boolean; + merkdir : pathstr; + m_packverz,m_tempverz : pathstr; + m_ver,m_prgend,m_auto, + m_flashend,m_interM : boolean; + m_pack,m_komp,m_sort, + m_color,m_attrib : byte; + top_verz : dirstr; + Drive,Packer_File,Script_File : TypedStream; + Pdat : TextStream; + Hilfe : Helpview1; + Akber : byte; + ArcOpen : boolean; + lw : DrRec; + Verz : pathstr; + Lver : Dtemp; + ch_dat : boolean; + + + function tpibegin : boolean; + function tpiend(save:boolean) :boolean; + function CompArcend (Arcend,Packfile:pathstr) : boolean; + procedure Farbe1; + procedure Farbe2; + procedure Monochrome; + procedure Rahmen; + +Implementation + + + function tpibegin : boolean; + begin + chver(readprogdir(paramstr(0))); + tpibegin := tpiopenfile('top.exe',159136); + end; + +{-------------------------------------------------------------------------} + function tpiend(save:boolean) : boolean; + var fTime : longint; + f : text; + begin + if save then tpisavechanges; + tpiclosefile; + tpiend:=f_spe; + end; + +{-------------------------------------------------------------------------} + function CompArcend (Arcend,Packfile:pathstr) : boolean; + var Endung: string[3]; + wa :boolean; + begin + CompArcend:=false; + repeat + If pos(',',Arcend)>0 then + begin + Endung:=copy(Arcend,1,pos(',',Arcend)); + delete(Arcend,1,pos(',',Arcend)); + end else + begin + Endung:=Arcend; Arcend:=''; + end; + If CompExtension( '*.'+Endung, PackFile )then + CompArcend:=true; + until Arcend=''; + end; + + procedure Monochrome; + begin + Pfeilfo := white; + Pfeilba := black; + Winfo := white; + Winba := black; + Balkenba := lightgray; + VcloseCol := white; + PackerCol := white; + LaufcuCol := lightgray; + SelNumCol := lightgray; + MessageCol := darkgray; + Message2Col:= lightgray; + Message3Col:= white; + Message4Col:= lightgray; + Laufwerkfo := darkgray; + Laufwerkba := Lightgray; + Funktionfo := black; + Funktionba := lightgray; + Buttonfo := black; + Buttonba := lightgray; + ButtonSe := white; + ButtonKe := white; + Editfo := black; + Editba := lightgray; + Fenfo := lightgray; + Fenba := darkgray; + Fen2fo := white; + Fen2ba := black; + Helpba := darkgray; + Pullfo := black; + Pullba := lightgray; + Scrollfo := lightgray; + ActSelfo := black; + ActSelba := white; + Selfo := white; + Balkenback := darkgray; + yCol := lightgray; + wCol := white; + end; + + + procedure Farbe1; + begin + Pfeilfo := white; + Pfeilba := black; + Winfo := white; + Winba := blue; + Balkenba := cyan; + VcloseCol := lightcyan; + PackerCol := yellow; + LaufcuCol := yellow; + SelNumCol := lightgray; + MessageCol := black; + Message2Col:= yellow; + Message3Col:= white; + Message4Col:= yellow; + Laufwerkfo := white; + Laufwerkba := cyan; + Funktionfo := black; + Funktionba := lightgray; + Buttonfo := lightgray; + Buttonba := blue; + ButtonSe := white; + ButtonKe := yellow; + Editfo := black; + Editba := lightgray; + Fenfo := blue; + Fenba := cyan; + Fen2fo := white; + Fen2ba := red; + Helpba := green; + Pullfo := black; + Pullba := Lightgray; + Scrollfo := yellow; + Scrollba := green; + Balkenback := black; + ActSelfo := white; + ActSelba := black; + Selfo := black; + yCol := yellow; + wCol := white; + ProgColors(1); + end; + + procedure Farbe2; + begin + Pfeilfo := white; + Pfeilba := black; + Winfo := white; + Winba := green; + Balkenba := red; + VcloseCol := lightcyan; + PackerCol := black; + LaufcuCol := lightred; + SelNumCol := lightgray; + MessageCol := white; + Message2Col:= white; + Message3Col:= white; + Message4Col:= white; + Laufwerkfo := darkgray; + Laufwerkba := Lightgray; + Funktionfo := black; + Funktionba := lightgray; + Buttonfo := black; + Buttonba := lightgray; + ButtonSe := white; + ButtonKe := red; + Editfo := black; + Editba := lightgray; + Fenfo := lightgreen; + Fenba := blue; + Fen2fo := white; + Fen2ba := red; + Helpba := brown; + Pullfo := black; + Pullba := lightgray; + Scrollfo := yellow; + ActSelfo := white; + ActSelba := red; + Selfo := white; + Balkenback := black; + yCol := black; + wCol := black; + ProgColors(2); + end; + + + procedure Rahmen; + begin + cursor_off; + textcolor(white);textbackground(black); + clrscr; + textcolor(Funktionfo);textbackground(Funktionba); + gotoxy(1,1); insline; + WriteXY(CrtxmaX Div 2 -2,1,'TOP '); + textcolor(darkgray); + writeXY(CrtXmax-7,1,'Ver 2.1'); + MouShowMouse; + end; + + +begin +end. \ No newline at end of file diff --git a/UNITS/INSTALL.PAS b/UNITS/INSTALL.PAS new file mode 100644 index 0000000..28e8df2 --- /dev/null +++ b/UNITS/INSTALL.PAS @@ -0,0 +1,455 @@ +{$A+,B-,D+,E-,F+,G+,I+,L+,N-,O-,P+,Q-,R+,S+,T-,V+,X+} +program Install; +uses crt,dos,tksaa,tkstring,tkwin,kbm,tpinst,tkvideo,tkdisk,tkview2,tkstream,init; +Type Copystream = Object(Typedstream) + Procedure Read(var R; P: Longint; Anz: Word); virtual; + Procedure Write(var R; P: Longint; Anz: Word); virtual; + End; + +const + First : boolean = true; + Inst_Konfignr=33408; + First_pos = 58; + + Top_Konfignr =159136; + Name_pos =718; + Strasse_pos =760; + Ort_pos =802; + Liznr_pos =844; + + Zielverz_pos = 664; {tempverz} + Packerverz_pos = 612; + Buf_max = 4042; + + AR : Acceptrec = (' OK ','',''); + +var Ed1,Ed2,Ed3,Ed4: edit; + Bu : Button; + I : integer; + fTime : longint; + f : text; + str40 : string[40]; + str5 : string[5]; + CopyF : Textstream; + LizF, + SourceF, + TargetF : Copystream; + Hilfe : Helpview1; + Zeile : string; + verz : Pathstr; + Laufw : String[2]; + Buf : array [1..Buf_Max] of Char; + OK,weiter : boolean; + S : string; + z : byte; + Dirinfo : SearchRec; +label Fehler; + + +Procedure Copystream.read(var R; P: Longint; Anz: Word); +begin + If P = -1 then P:=Pos; {sequentielles Lesen} + If OK then + repeat + seek(P); + {$I-} Blockread (F, R, Anz, Result); {$I+} + Ok := Inoutres=0; + until testerror(readmsg); + {EndIf} +end; + +Procedure Copystream.Write(var R; P: Longint; Anz: Word); +begin + If P = -1 then P:=Pos; {sequentielles Schreiben} + If OK then + repeat + seek(P); + {$I-} Blockwrite(F, R, Anz, Result); {$I+} + Ok := Inoutres=0; + until Testerror(writemsg); + {End IF} +end; + + +FUNCTION Mkver(S:String) : Boolean; +var Verzeichnis : Pathstr; + Verz : string; +begin + getver(0,Verzeichnis); + S:=addbackslash(S); + If length(S) > 1 then + If S[2]=':' then + begin + If not chver(S[1]+':'+'\') then + begin + Mkver:=false; chver(Verzeichnis); exit; + end; + delete(S,1,2); + end; + {EndIF} + If pos('\',S)=1 then delete(S,1,1); + while (S<>'') and (S<>'\') do + begin + Verz :=copy(S,1,pos('\',S)-1); + If not chver(Verz) then + begin + {$I-} mkdir(Verz); {$I+} + If (Ioresult>0) or not chver(Verz) then + begin + Mkver:=false; chver(Verzeichnis); exit; + end; + end; + delete(S,1,pos('\',S)); + end; + chver(Verzeichnis); + Mkver:=true; +end; + + + + function Abfrage(M :Message):boolean; + var i : byte; + Ab : Button; + weiter : boolean; + + begin + Abfrage:=true; + openwindow(31,4,white,red,'Abfrage'); + textcolor(yellow);writeXY(1,2,center(M,31)); + Initbutton(Ab, 4,4,' ~Ja ',Alt_J,1); + Initbutton(Ab,19,4,' ~Nein ',Alt_N,2); + Ab.anz:=2; I:=1; weiter:=false; Ab.FaFen:=red; + repeat + Setbutton(Ab); + case I of + 1: Activebutton(Ab); + end; + + case EventThisbutton(Ab) of + 1 : begin + Abfrage:=true; weiter:=true; + end; + 2 : begin + Abfrage:=false; weiter:=true; + end; + end; + + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + ESC : begin + Abfrage:=false; weiter:=true; + end; + end; + end; + until weiter; + closewindow; + end; + +Function CopyFrom(S:string):string; +begin + while pos(' ',S)=1 do delete(S,1,1); + If pos(' ',S)>0 then + CopyFrom:=copy(S,1,pos(' ',S)) else + CopyFrom:=copy(S,1,length(S)); +end; + + +Function CopyTo(S:string):string; +var l : string; +begin + while pos(' ',S)=1 do delete(S,1,1); + If pos(' ',S)>0 then + CopyTo:=(trim(copy(S,pos(' ',S),length(S)-pos(' ',S)+1))) else + CopyTo:=''; +end; + + +Procedure Ende(Fehler:boolean); +var Bu : Button; + weiter : boolean; + +begin + openwindow(50,5,fenfo,fenba,'Ende'); + Initbutton(Bu, 20,5,' ~Ok ',Alt_O,1); Bu.anz:=1; + textcolor(MessageCol); + If Fehler then + writeXY(1,2,center('Die Installation wurde abgebrochen!',50)) else + begin + writeXY(2,2,'Die Installation wurde erfolgreich durchgefhrt!'); + writeXY(2,3,'Geben Sie TOP ein, um das Programm zu starten!'); + end; + weiter:=false; + repeat + Activebutton(Bu); + weiter:=EventThisbutton(Bu)=1; + + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + ESC : begin + weiter:=true; + end; + end; + end; + until weiter; + closewindow; + textbackground(black); textcolor(Lightgray); + CopyF.Done; Cursor_on; + halt(0); +end; + + +begin + Farbe1; cursor_off; + Moushowmouse; getver(0,verz); Laufw:=verz[1]+':'; + CopyF.Init(addbackslash(justpathname(paramstr(0)))+'install.fid'); + If first then + begin + + CopyF.Open; + If not CopyF.Ok then Ende(True); + CopyF.ReadLn(Zeile); + If not CopyF.Ok then Ende(True); + CopyF.Close; + + {Initeditor (Ed1 ,20, 4,'Lizensnummer :',true,'', 5);} + Initeditor (Ed2 ,20, 4,'Name :',true,'', 40); + Initeditor (Ed3 ,20, 6,'Strae :',true,'', 40); + Initeditor (Ed4 ,20, 8,'Ort :',true,'', 40); + + Initbutton(Bu,13,10,' ~Weiter ', Alt_W,1); + Initbutton(Bu,45,10,' ~Abbruch ', Alt_A,2); Bu.anz:=2; + + openwindow(70,10,fenfo,fenba,'Installation von TOP 2.1'); + Fehler :; + textbackground(fenba); textcolor(MessageCol); + writeXY(3,2,'Bitte geben Sie hier Ihre persnlichen Daten an!'); + OK:=false; weiter:=false; I:=2; + repeat + SetButton(Bu); + + {Seteditor(Ed1);} + Seteditor(Ed2); + Seteditor(Ed3); + Seteditor(Ed4); + + + case I of + {1: ActiveEditor(Ed1);} + 2: ActiveEditor(Ed2); + 3: ActiveEditor(Ed3); + 4: ActiveEditor(Ed4); + 6: Activebutton(Bu); + end; + + case EventThisButton(Bu) of + 1 : begin + If trim(Ed2.T)='' then goto Fehler; { kein Name eingegeben } + If Abfrage('Sind Ihre Angaben korrekt ?') then + begin + + chver(justpathname(Laufw+CopyFrom(Zeile))); + tpiopenfile('top.exe', Top_Konfignr); + + {str40:=crypt(Ed1.T); + tpiput(Liznr_pos,6,str40);} + str40:=crypt(Ed2.T); + tpiput(Name_pos,41,str40); + str40:=crypt(Ed3.T); + tpiput(Strasse_pos,41,str40); + str40:=crypt(Ed4.T); + tpiput(Ort_pos,41,str40); + tpisavechanges; + tpiclosefile; + + If f_spe then + begin + IO_Error('Kann Top.exe nicht initialisieren','IOERROR.MSG',101, AR); + goto Fehler; + end; + + chver(justpathname(paramstr(0))); + tpiopenfile('install.exe', Inst_Konfignr); + First:=false; + tpiput(First_pos,1,First); + tpisavechanges; + tpiclosefile; + If f_spe then + begin + IO_Error('Kann Install.exe nicht initialisieren','IOERROR.MSG',101, AR); + goto Fehler; + end; + OK:=true; weiter:=true; + end; + end; + 2 : begin + weiter:=true; + end; + end; + + + {If EventEditor(Ed1) then I:=1;} + If EventEditor(Ed2) then I:=2; + If EventEditor(Ed3) then I:=3; + If EventEditor(Ed4) then I:=4; + + + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + BACKTAB, + CUP : begin + dec(I); + If I<{1}2 then I:=6; + end; + TAB, + CDOWN : begin + inc(I); + If I>6 then I:={1}2; + end; + ESC : weiter:=true; + end; + end; + + until weiter; + closewindow; + + If not Ok then Ende(True); + end; + { 2. Fenster } + Initeditor (Ed1 ,22, 7,'Zielverzeichnis :',true,'', 45); + Initeditor (Ed2 ,22, 9,'Packerverzeichnis:',true,'', 45); + Ed1.T:='C:\TOP'; + Ed2.T:='C:\TOP\PACKER'; + Initbutton(Bu,15,12,' ~Installieren ', Alt_S,1); + Initbutton(Bu,45,12,' ~Abbruch ', Alt_A,2); Bu.anz:=2; + + openwindow(70,12,fenfo,fenba,'Installation von TOP 2.1'); + textcolor(white); + writeXY(11,2,'TOP - Toms Oberflche fr Packprogramme - Version 2.1'); + textcolor(MessageCol); + writeXY(17,3,'Copyright (C) 1992-95, Thomas Knfel'); + textcolor(fenfo); + for z:=1 to 71 do + writexy(z,4,''); + OK:=false; weiter:=false; I:=1; + repeat + SetButton(Bu); + + Seteditor(Ed1); + Seteditor(Ed2); + + case I of + 1: ActiveEditor(Ed1); + 2: ActiveEditor(Ed2); + 3: ActiveButton(Bu); + end; + + case EventThisButton(Bu) of + 1 : begin + If not chver(Ed1.T[1]+':'+'\') then + begin + closewindow; closewindow; + Ende(True); + end; + + CopyF.Open; + CopyF.ReadLn(Zeile); + CopyF.Close; + + + CopyF.Open; + Openwindow(36,2,yellow,lightgreen,'Kopieren'); + + If not mkver(Ed1.T) or not mkver(Ed2.T)then + begin + closewindow; closewindow; + Ende(True); + end; + + While not CopyF.EOF do + begin + CopyF.ReadLn(Zeile); + chver(justpathname(Laufw+CopyFrom(Zeile))); + S :=Ed1.T; + SourceF.Init(Laufw+CopyFrom(Zeile),1); + If CopyTo(Zeile) = '2' then + TargetF.Init(addbackslash(Ed2.T)+justfilename(CopyFrom(Zeile)),1) else + TargetF.Init(addbackslash(Ed1.T)+justfilename(CopyFrom(Zeile)),1); + SourceF.Open; + If not SourceF.OK then + begin + closewindow; closewindow; + Ende(True); + end; + TargetF.Create; + If not TargetF.OK then + begin + closewindow; closewindow; + Ende(True); + end; + findFirst(Laufw+CopyFrom(Zeile), $37, DirInfo); + If Doserror > 0 then + begin + closewindow; closewindow; + Ende(True); + end; + writeXY(3,2,concat('Kopiere  ',pad(justfilename(CopyFrom(Zeile)),12))); + While not SourceF.EOF do + begin + SourceF.Read(Buf,-1,Buf_max); + TargetF.Write(Buf,-1,SourceF.Result); + If not SourceF.OK or not TargetF.OK then + begin + closewindow; closewindow; + Ende(True); + end; + end; + {$I-}GetFTime(SourceF.F,fTime);{$I+} + Doserror:=IOresult; Doserror:=0; + SetFTime(TargetF.F,fTime); + SourceF.Done; + TargetF.Done; + + chver(Ed1.T); + tpiopenfile('top.exe', Top_Konfignr); + tpiput(Zielverz_pos, 51,Ed1.T); + tpiput(Packerverz_pos,51,Ed2.T); + tpisavechanges; + tpiclosefile; + + End{While}; + closewindow; + CopyF.Close; + OK:=true; weiter :=true; + end; + 2 : weiter :=true; + end; + + If EventEditor(Ed1) then I:=1; + If EventEditor(Ed2) then I:=2; + + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + BACKTAB, + CUP : begin + dec(I); + If I<1 then I:=3; + end; + TAB, + CDOWN : begin + inc(I); + If I>3 then I:=1; + end; + ESC : weiter:=true; + end; + end; + + until weiter; + closewindow; + If not OK then Ende(True); + chver(Ed1.T); + Ende(False); +end. \ No newline at end of file diff --git a/UNITS/KBM.PAS b/UNITS/KBM.PAS new file mode 100644 index 0000000..891e5d7 --- /dev/null +++ b/UNITS/KBM.PAS @@ -0,0 +1,1143 @@ +{*************************************************************************** +* K B M : eine Unit, die komfortable Routinen zur Abfrage von Maus und * +* Tastatur bereitstellt. * +**------------------------------------------------------------------------** +* Autor : MICHAEL TISCHER * +* entwickelt am : 1.06.1989 * +* letztes Update am: 23.09.1989 * +***************************************************************************} + +unit Kbm; + +interface + +uses Dos,Crt; { Units einbinden } + +{== Typdeklarationen, die in Verbindung mit den ffentlichen Prozeduren ===} +{== und Funktionen aus dieser Unit bentigt werden. ===} + +type TASTE = word; { Tastencode, >= 256 : erweiterter Code } + PTRVIEW = longint; { Maske fr Maus-Cursor } + + BEREICH = record { beschreibt einen Mausbereich } + x1, { Koordinaten der oberen linken } + y1, { und unteren rechten Ecke des } + x2, { spezifizierten Bereichs } + y2 : byte; + end; + BERARRAY = array [0..10] of BEREICH; { Bereichs-Array } + BERPTR = ^BERARRAY; { Zeiger auf Bereichs-Array } + + EVENT = record { beschreibt Ereignis von Maus oder Tastatur } + Ereignis : integer; { Ereignis-Code } + Zeit : longint; { Zeit in Ticks } + CtrlCode : Taste; { dient zum Zwischensp.} + case byte of { Tastatur oder Maus? } + 0 : { Maus: ( EV_MOU_...) ------------------------------} + ( ZeileRel, { Position des Maus-Cursor } + SpalteRel, { relativ zum Bereich } + ZeileAbs, { Position des Maus-Cursor } + SpalteAbs, { relativ zum ges. Bilds. } + Bereich, { Mausbereich } + Buttons : byte ); { Status der Buttons } + + 1 : { Taste: ( EV_KEY_PRESSED ) ------------------------} + ( Key : TASTE ); { bettigte Taste } + + 2 : { Taste, erzeugt keinen Code: ( EV_KEY_UNKNOWN ) ---} + ( ScanCode, { zurckgelieferter Scan-Code } + Status : byte ); { Status der Steuertasten } + + 3 : { Statustaste, kein Code ( EV_KEY_STATUS ) ---------} + ( StateKey : byte ); + end; + + EVENTHANDLER = procedure ( var EvRec : EVENT ); + +{== Deklaration der Funktionen und Prozeduren, die von einem anderen ======} +{== Programm aufgerufen werden knnen ======} + +procedure KbmRegisterHandler ( Event : word; Handler : EVENTHANDLER ); +procedure KbmDeRegisterHandler( Event : word ); +procedure KbmGetEvent ( var EvRec : EVENT ); +procedure KbmPeekEvent ( var EvRec : EVENT ); +procedure KbClrevent; +procedure MouClrevent; +procedure KbmReleaseMode ( Modus : byte ); +procedure KbmSetMode ( Modus : byte ); +function MouPtrMask ( Zeichen, Farbe : word ) : PTRVIEW; +function PtrDifChar ( Zeichen : byte ) : word; +function PtrDifCol ( Farbe : byte ) : word; +procedure MouDefinePtr ( Mask : PTRVIEW ); +procedure MouDefBereich ( Anzahl : byte; BPtr : BERPTR ); +procedure KbmEventWait ( WaitEvent : integer; var EvRec : EVENT ); +procedure MouShowMouse; +procedure MouHideMouse; +procedure MouSetMoveArea ( x1, y1, x2, y2 : byte ); +procedure MouSetSpeed ( XSpeed, YSpeed : integer ); +procedure MouMovePtr ( Col, Row : byte ); +procedure KbmInit ( Spalten, Zeilen : byte ); +procedure KbmEnd(ende:boolean); + + +{== Variablen, die einem Anwendungsprogramm zugnglich sind ===============} + +var MouAvail : boolean; { ist TRUE, wenn Maus verfgbar } + + {-- Variablen, die mit jedem Aufruf des Maus-Handlers geladen werden --} + + AnzBereiche, { Anzahl der Bereiche } + AktBer, { Nummer des aktuellen Bereichs } + AktBut, { Status der Mausknpfe } + AktX, { aktuelle Position des Maus-Cursors } + AktY : byte; { in Bezug zum gesamten Bildschirm } + crtxmax,crtymax : byte; { fr max Bildschirmausdehnung } + ev : Event; { enthlt alle Ereignisse } + +{== Konstanten, die einem Anwendungsprogramm zugnglich sind ==============} + +const {------------------------------------------------- Event-Codes ------} + + EV_NO_EVENT = 0; { es steht kein Ereignis bereit } + EV_MOU_MOVE = 1; { Maus bewegt } + EV_LEFT_PRESS = 2; { linker Mausknopf niedergedr. } + EV_LEFT_REL = 4; { linker Mausknopf losgelassen } + EV_RIGHT_PRESS = 8; { rechter Mausknopf niedergedr. } + EV_RIGHT_REL = 16; { rechter Mausknopf losgelassen } + EV_KEY_PRESSED = 256; { Taste bettigt } + EV_KEY_UNKNOWN = 512; { Tastenkombination, die keinen Code erzeugt } + EV_KEY_STATUS = 1024; { Statustaste, erzeugt keinen Code } + + EV_MOU_ALL = 31; { alle Maus-Events } + EV_KEY_ALL = 1792; { alle Tastatur-Events } + EV_ALL = 1823; { alle Maus- und Tastatur-Events } + + {------------------------------------- Codes der Status-Tasten ------} + + KEY_RIGHT_SHIFT = 1; + KEY_LEFT_SHIFT = 2; + KEY_CTRL = 4; + KEY_ALT = 8; + KEY_SCROLL_LOCK = 16; { auf deutschen Tastaturen: Abbr(uch) } + KEY_NUM_LOCK = 32; { Umschaltung Ziffern-Tastatur } + KEY_CAPS_LOCK = 64; { Umschaltung Gro-/Kleinschreibung } + KEY_INSERT = 128; { INSERT, wird als Taste und nicht als } + { Status-nderung zurckgeliefert } + + {--------------- Konstanten zur Beschreibung des Maus-Cursors -------} + + PtrSameChar = $00ff; { gleiches Zeichen } + PtrSameCol = $00ff; { gleiche Farbe } + PtrInvCol = $7777; { Farbe invertiert } + PtrSameColB = $807f; { gleiche Farbe blinkend } + PtrInvColB = $F777; { invertierte Farbe blinkend } + + {------------------------------------- Codes der Steuertasten -------} + + BEL = 7; { Klingelzeichen } + BS = 8; { Backspace-Taste } + TAB = 9; { Tabulator-Taste } + LF = 10; { Linefeed } + CR = 13; { Return-Taste } + ESC = 27; { Escape-Taste } + SPACE = 32; { Leer-Taste } + CTRL_A = 1; { CTRL + A } + CTRL_B = 2; { CTRL + B } + CTRL_C = 3; { CTRL + C } + CTRL_D = 4; { CTRL + D } + CTRL_E = 5; { CTRL + E } + CTRL_F = 6; { CTRL + F } + CTRL_G = 7; { CTRL + G } + CTRL_H = 8; { CTRL + H } + CTRL_I = 9; { CTRL + I } + CTRL_J = 10; { CTRL + J } + CTRL_K = 11; { CTRL + K } + CTRL_L = 12; { CTRL + L } + CTRL_M = 13; { CTRL + M } + CTRL_N = 14; { CTRL + N } + CTRL_O = 15; { CTRL + O } + CTRL_P = 16; { CTRL + P } + CTRL_Q = 17; { CTRL + Q } + CTRL_R = 18; { CTRL + R } + CTRL_S = 19; { CTRL + S } + CTRL_T = 20; { CTRL + T } + CTRL_U = 21; { CTRL + U } + CTRL_V = 22; { CTRL + V } + CTRL_W = 23; { CTRL + W } + CTRL_X = 24; { CTRL + X } + CTRL_Y = 25; { CTRL + Y } + CTRL_Z = 26; { CTRL + Z } + BACKTAB = 271; { SHIFT + TAB } + ALT_Q = 272; { ALT + Q } + ALT_W = 273; { ALT + W } + ALT_E = 274; { ALT + E } + ALT_R = 275; { ALT + R } + ALT_T = 276; { ALT + T } + ALT_Y = 277; { ALT + Y } + ALT_U = 278; { ALT + U } + ALT_I = 279; { ALT + I } + ALT_O = 280; { ALT + O } + ALT_P = 281; { ALT + P } + ALT_A = 286; { ALT + A } + ALT_S = 287; { ALT + S } + ALT_D = 288; { ALT + D } + ALT_F = 289; { ALT + F } + ALT_G = 290; { ALT + G } + ALT_H = 291; { ALT + H } + ALT_J = 292; { ALT + J } + ALT_K = 293; { ALT + K } + ALT_L = 294; { ALT + L } + ALT_Z = 300; { ALT + Z } + ALT_X = 301; { ALT + X } + ALT_C = 302; { ALT + C } + ALT_V = 303; { ALT + V } + ALT_B = 304; { ALT + B } + ALT_N = 305; { ALT + N } + ALT_M = 306; { ALT + M } + F1 = 315; { F1-Taste } + F2 = 316; { F2-Taste } + F3 = 317; { F3-Taste } + F4 = 318; { F4-Taste } + F5 = 319; { F5-Taste } + F6 = 320; { F6-Taste } + F7 = 321; { F7-Taste } + F8 = 322; { F8-Taste } + F9 = 323; { F9-Taste } + F10 = 324; { F10-Taste } + CDOWN = 336; { Cursor-Down } + CHOME = 327; { Cursor-Home } + CUP = 328; { Cursor-Up } + CPGUP = 329; { Cursor-Page Up } + CLEFT = 331; { Cursor-Left } + CRIGHT = 333; { Cursor-Right } + CEND = 335; { Cursor-Right } + CPGDN = 337; { Cursor-Page Dn } + INSERTKEY = 338; { INSERT-Taste } + DELETEKEY = 339; { DELETE-Taste } + SHIFT_F1 = 340; { SHIFT + F1 } + SHIFT_F2 = 341; { SHIFT + F2 } + SHIFT_F3 = 342; { SHIFT + F3 } + SHIFT_F4 = 343; { SHIFT + F4 } + SHIFT_F5 = 344; { SHIFT + F5 } + SHIFT_F6 = 345; { SHIFT + F6 } + SHIFT_F7 = 346; { SHIFT + F7 } + SHIFT_F8 = 347; { SHIFT + F8 } + SHIFT_F9 = 348; { SHIFT + F9 } + SHIFT_F10 = 349; { SHIFT + F10 } + CTRL_F1 = 350; { CTRL + F1 } + CTRL_F2 = 351; { CTRL + F2 } + CTRL_F3 = 352; { CTRL + F3 } + CTRL_F4 = 353; { CTRL + F4 } + CTRL_F5 = 354; { CTRL + F5 } + CTRL_F6 = 355; { CTRL + F6 } + CTRL_F7 = 356; { CTRL + F7 } + CTRL_F8 = 357; { CTRL + F8 } + CTRL_F9 = 358; { CTRL + F9 } + CTRL_F10 = 359; { CTRL + F10 } + ALT_F1 = 360; { ALT + F1 } + ALT_F2 = 361; { ALT + F2 } + ALT_F3 = 362; { ALT + F3 } + ALT_F4 = 363; { ALT + F4 } + ALT_F5 = 364; { ALT + F5 } + ALT_F6 = 365; { ALT + F6 } + ALT_F7 = 366; { ALT + F7 } + ALT_F8 = 367; { ALT + F8 } + ALT_F9 = 368; { ALT + F9 } + ALT_F10 = 369; { ALT + F10 } + CTRL_LF = 371; { CTRL-Left } + CTRL_RI = 372; { CTRL-Right } + CTRL_PGDN = 374; { CTRL-PgUp } + CTRL_HOME = 375; { CTRL-Home } + ALT_1 = 376; { ALT + 1 } + ALT_2 = 377; { ALT + 2 } + ALT_3 = 378; { ALT + 3 } + ALT_4 = 379; { ALT + 4 } + ALT_5 = 380; { ALT + 5 } + ALT_6 = 381; { ALT + 6 } + ALT_7 = 382; { ALT + 7 } + ALT_8 = 383; { ALT + 8 } + ALT_9 = 384; { ALT + 9 } + ALT_0 = 385; { ALT + 0 } + CTRL_PGUP = 388; { CTRL-PgUp } + +implementation + +{$L kbma} { das Assembler-Modul einbinden } + +{== Konstanten, modulintern ===============================================} + +const KEIN_BEREICH = 255; { Maus-Cursor nicht in Bereich xy } + EVQ_LEN = 100; { Lnge der Maus- u. Tastatur-Queue } + +{== Typdeklarationen, modulintern =========================================} + +type PTRREC = record { dient dem Zugriff auf die } + Ofs : word; { Bestandteile eines belie- } + Seg : word; { bigen Pointers } + end; + + PTRVREC = record { dient dem Zugriff auf die } + ScreenMask : word; { Bestandteile eines PTRVIEW } + CursorMask : word; + end; + + BERBUF = array [0..10900] of byte; { Bereichspuffer } + + BBPTR = ^BERBUF; { Zeiger auf einen Bereichspuffer } + + EVQUEUE = record { eine Ereignis-Queue } + Next, { Zeiger auf nchstes Event } + Last : integer; { Zeiger auf letztes Event } + Queue : array [1..EVQ_LEN] of EVENT; { Event-Puffer } + end; + + EVQUEUEPTR = ^EVQUEUE; { Zeiger auf die Event-Queue } + + EVHANDREC = record { Element in der Event-Handler-Tabelle } + Call : boolean; { Handler installiert? } + Handler : EVENTHANDLER; { Prozedur-Zeiger } + end; + +{== globale Variablen, modulintern ========================================} + +var + TLine, { Anzahl Text-Zeilen } + TCol : byte; { Anzahl Text-Spalten } + BufPtr : BBPTR; { Zeiger auf Puffer fr Bereichs-Erkennung } + AktBerPtr: BERPTR; { Pointer auf akt. Bereichs-Vektor } + BLen : integer; { Lnge des Bereichspuffer in Byte } + ExitOld : pointer; { Zeiger auf die alte Exit-Prozedur } + HandTab : array [1..16] of EVHANDREC; { Tabelle mit Event-Handlern } + { des Anwendungsprogramms } + + KbQueueP, { Queue fr Tastaturereignisse } + MouQueueP : EVQUEUEPTR; { Queue fr Mausereignisse } + + OldKbHandler : pointer; { Adresse des alten Int09-Handlers } + + Time : longint absolute $40:$6C; { BIOS-Tick-Zhler } + BiosKbFlag : byte absolute $40:$17; { BIOS-Tastatur-Flag } + AktStatus : byte; { aktueller Tastatur-Status } + + + +{== Deklaration externer Funktionen =======================================} + +{$F+} { die Funktion ist FAR } +procedure NewMouHandler ; external ; { der Maus-Event-Handler } +procedure NewKbHandler ; external ; { neuer Tastatur-Handler (Int $09) } +{$F-} { FAR-Funktionen nicht mehr erzwingen } + +{**************************************************************************} +{* KbmIGetIndex : Ermittelt aus einer Event-Maske den zugehrigen Index *} +{* in die Event-Handler-Tabelle *} +{**-----------------------------------------------------------------------*} +{* Eingabe: MASK = die Event-Maske *} +{* Ausgabe: Index zwischen 1 und 16 *} +{**************************************************************************} + +function KbmIGetIndex( Mask : word ) : byte ; + +var i : byte; { nimmt den Index auf } + +begin + i := 1; + while ( Mask <> 1 ) do { Event-Bit noch nicht in Bit 0 ? } + begin { Nein } + Mask := Mask shr 1; { Mask um ein Bit nach rechts shiften } + inc( i ); { Index inkrementieren } + end; + KbmIGetIndex := i; { Index zurckliefern } +end; + +{**************************************************************************} +{* KbmIBufFill: speichert den Bereichscode fr einen Mausbereich inner- *} +{* halb des modulinternen Bereichsspeichers *} +{**----------------------------------------------------------------------**} +{* Eingabe: x1, y1 = obere linke Ecke des Mausbereichs *} +{* x2, y2 = untere rechte Ecke des Mausbereichs *} +{* Code = der Bereichscode *} +{**************************************************************************} + +procedure KbmIBufFill( x1, y1, x2, y2, Code : byte ); + +var Index : integer; { zeigt auf bearbeitetes Feld } + Spalte, { Schleifenzhler } + Zeile : byte; + +begin + for Zeile:=y1 to y2 do { die einzelnen Zeilen durchlaufen } + begin + Index := Zeile * TCol + x1; { erster Index der Zeile } + for Spalte:=x1 to x2 do { die Spalten in der Zeile durchlaufen } + begin + BufPtr^[ Index ] := Code; { Code speichern } + inc( Index ); { Index auf das nchste Feld setzen } + end; + end; +end; + +{**************************************************************************} +{* KbmIGetX: ermittelt die Textspalte, in der sich der Maus-Cursor be- *} +{* findet *} +{**----------------------------------------------------------------------**} +{* Ausgabe: Spalte des Maus-Cursors in Bezug auf den Textbildschirm *} +{**************************************************************************} + +function KbmIGetX : byte; + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + Regs.AX := $0003; { Fktnr.: fr "Get mouse position" } + Intr( $33, Regs ); { Maus-Treiber aufrufen } + KbmIGetX := Regs.CX shr 3; { Spalte umrechnen und zurckl. } +end; + +{**************************************************************************} +{* KbmIGetY: ermittelt die Textzeile, in der sich der Maus-Cursor be- *} +{* findet *} +{**----------------------------------------------------------------------**} +{* Ausgabe: Zeile des Maus-Cursors in Bezug auf den Textbildschirm *} +{**************************************************************************} + +function KbmIGetY : byte; + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + Regs.AX := $0003; { Fktnr.: fr "Get mouse position" } + Intr( $33, Regs ); { Maus-Treiber aufrufen } + KbmIGetY := Regs.DX shr 3; { Zeile umrechnen und zurckl. } +end; + + +{**************************************************************************} +{* KbmPutQueue : Hngt ein Event-Record an das Ende der Event-Queue an. *} +{**-----------------------------------------------------------------------*} +{* Eingabe: Qp = Zeiger auf die zu bearbeitende Queue *} +{* EvRec = das anzuhngende Event-Record *} +{* Info: ist in der Event-Queue kein Platz mehr, berschreibt das *} +{* Event das bisher letzte Event. *} +{**************************************************************************} + +procedure KbmPutQueue( Qp : EVQUEUEPTR; EvRec : EVENT ); + +var NeuLast : integer; { neuer letzter Eintrag } + +begin + with Qp^ do { die angegebene Queue bearbeiten } + begin + Queue[ Last ] := EvRec; { Event-Record in Queue kopieren } + NeuLast := Last + 1; { Nummer des neuen letzten Eintrags } + if ( NeuLast > EVQ_LEN ) then { Wrap-Around am Ende der Queue } + NeuLast := 1; + if ( NeuLast <> Next ) then { berlauf } + Last := NeuLast; { Nein, letzten Eintrag setzen } + end; +end; + +{**************************************************************************} +{* KbmGetQueue : Liest das nchste Event aus der Maus- oder Tastatur- *} +{* Queue *} +{**-----------------------------------------------------------------------*} +{* Eingabe: Qp = Zeiger auf die zu bearbeitende Queue *} +{* EvRec = Variable, die das Event-Record aufnimmt *} +{* Info: Steht beim Aufruf der Funktion noch kein Event bereit, lie- *} +{* fert die Funktion als Ereignistyp EV_NO_EVENT zurck und *} +{* setzt gleichzeitig das Zeitfeld auf MAXLONGINT *} +{**************************************************************************} + +procedure KbmGetQueue( Qp : EVQUEUEPTR; var EvRec : EVENT ); + +begin + with Qp^ do { die angegebene Queue bearbeiten } + begin + if ( Next = Last ) then { kein Element in der Queue? } + begin { Nein } + EvRec.Ereignis := EV_NO_EVENT; { kein Ereignis } + EvRec.Zeit := MAXLONGINT; { ungltige Zeit } + end + else { es befindet sich ein Element in der Queue } + begin + EvRec := Queue[ Next ]; { Event-Record aus Queue holen } + if ( Next = EVQ_LEN ) then Next := 1 { EvNext auf nchstes } + else inc( Next ); { Queue-Element setzen } + end; + end; +end; + +{**************************************************************************} +{* KbmPeekQueue : Liest das nchste Event aus der Maus- oder Tastatur- *} +{* Queue, ohne es allerdings aus der Queue zu entfernen *} +{**-----------------------------------------------------------------------*} +{* Eingabe: Qp = Zeiger auf die zu bearbeitende Queue *} +{* EvRec = Variable, die das Event-Record aufnimmt *} +{* Info: Steht beim Aufruf der Funktion noch kein Event bereit, lie- *} +{* fert die Funktion als Ereignistyp EV_NO_EVENT zurck und *} +{* setzt gleichzeitg das Zeitfeld auf MAXLONGINT *} +{**************************************************************************} + +procedure KbmPeekQueue( Qp : EVQUEUEPTR; var EvRec : EVENT ); + +begin + with Qp^ do { die angegebene Queue bearbeiten } + begin + if ( Next = Last ) then { kein Element in der Queue? } + begin { Nein } + EvRec.Ereignis := EV_NO_EVENT; { kein Ereignis } + EvRec.Zeit := MAXLONGINT; { ungltige Zeit } + end + else { es befindet sich ein Element in der Queue } + EvRec := Queue[ Next ]; { Event-Record aus Queue holen } + end; +end; + +{**************************************************************************} +{* KbmGetEvent : Liest das nchste Event *} +{**-----------------------------------------------------------------------*} +{* Eingabe: EvRec = Variable, die das Event-Record aufnimmt *} +{* Info: Steht beim Aufruf der Funktion noch kein Event bereit, war- *} +{* tet die Funktion auf den Eintritt des nchsten Events *} +{**************************************************************************} + +procedure KbmGetEvent( var EvRec : EVENT ); + +var MouEv, { Ereignis aus der Maus-Queue } + KbEv : EVENT; { Ereignis aus der Tastatur-Queue } + +begin + repeat { Leseschleife, wartet auf Eintritt eines Ereignisses } + KbmPeekQueue( MouQueueP, MouEv ); { Maus-Ereignis holen } + KbmPeekQueue( KbQueueP, KbEv ); { Tastatur-Ereignis holen } + until ( ( MouEv.Ereignis <> EV_NO_EVENT ) or + ( KbEv.Ereignis <> EV_NO_EVENT ) ); + + if ( KbEv.Zeit <= MouEv.Zeit ) then { kam Tastatur-Ereignis frher? } + begin + KbmGetQueue( KbQueueP, EvRec ); { Ja, Tastatur-Ereignis holen } + Evrec.Ctrlcode:=Evrec.key; + end + else { Nein, Maus-Ereignis holen } + begin + KbmGetQueue( MouQueueP, EvRec ); + Evrec.Ctrlcode:=0; + end; +end; + + +{**************************************************************************} +{* KbmPeekEvent : Liest das nchste Event aus der Event-Queue, ohne es *} +{* allerdings aus der Queue zu entfernen. *} +{**----------------------------------------------------------------------**} +{* Eingabe: EvRec = Variable, die das Event-Record aufnimmt *} +{* Info: Steht beim Aufruf der Funktion noch kein Event bereit, lie- *} +{* fert die Funktion im Feld EREIGNIS den Wert EV_NO_EVENT *} +{* zurck. *} +{**************************************************************************} + +procedure KbmPeekEvent( var EvRec : EVENT ); + +var MouEv, { Ereignis aus der Maus-Queue } + KbEv : EVENT; { Ereignis aus der Tastatur-Queue } + +begin + KbmPeekQueue( MouQueueP, MouEv ); { Maus-Ereignis holen } + KbmPeekQueue( KbQueueP, KbEv ); { Tastatur-Ereignis holen } + + if ( KbEv.Zeit <= MouEv.Zeit ) then { kam Tastatur-Ereignis frher? } + EvRec := KbEv { Ja, Tastatur-Ereignis zurckliefern } + else { Nein, Maus-Ereignis zurckliefern } + EvREc := MouEv; +end; + +{**************************************************************************} +{* KbHandler : wird vom neuen Int-09-Handler (NewKbHandler im Assembler- *} +{* Modul) bei der Bettigung einer Taste aufgerufen *} +{**----------------------------------------------------------------------**} +{* Eingabe: KbPort = Code, der vom Tastaturport 60h gelesen wurde *} +{**************************************************************************} + +procedure KbHandler( KbPort : byte ); + +var EvRec : EVENT; { zu erstellender Event-Record } + Regs : Registers; { Prozessorregister } + NewKbS : byte; { neuer Tastatur-Status } + + +begin + EvRec.Zeit := Time; { Uhrzeit ermitteln } + Regs.AH := 1; { feststellen, ob Taste in Tastencode } + intr( $16, Regs ); { umgesetzt wurde } + if ( Regs.Flags and FZERO = 0 ) then + begin { Ja, Zeichen jetzt im Tastaturpuffer } + Regs.AH := 0; { Zeichen ber BIOS aus dem } + intr( $16, Regs ); { Tastaturpuffer laden } + if ( Regs.AL = 0 ) then EvRec.Key := Regs.AH + 256 + else EvRec.Key := Regs.AL; + + EvRec.Ereignis := EV_KEY_PRESSED; { Event-Code setzen } + KbmPutQueue( KbQueueP, EvRec ); { Event in Queue bringen } + end + else { Tastendruck resultierte nicht in Tastencode } + begin + NewKbS := BiosKbFlag; { Status der Steuertasten ermitteln } + if ( AktStatus <> NewKbS ) then { Statusnderung? } + begin + if ( AktStatus < NewKbS ) then { wurde ein Bit gesetzt? } + begin { Ja, Ereignis festhalten } + EvRec.StateKey := AktStatus xor NewKbS; { Flag isolieren } + if ( EvRec.StateKey <> KEY_INSERT ) then { nicht INSERT? } + begin { Nein, EVENT erzeugen } + EvRec.Ereignis := EV_KEY_STATUS; + KbmPutQueue( KbQueueP, EvRec ); { Event in Queue } + end; + end + end + else { Nein, keine Statusnderung } + if ( KbPort < 128 ) then { Make-Code? } + begin { Ja, Event erzeugen } + EvRec.Ereignis := EV_KEY_UNKNOWN; { unbekannter Code } + EvRec.ScanCode := KbPort; { Scan-Code bergeben } + EvRec.Status := NewKbs; { Status in Event-Record laden } + KbmPutQueue( KbQueueP, EvRec ); { Event in Queue bringen } + end; + AktStatus := NewKbS; { neuen Tastatur-Status merken } + end; +end; + +{**************************************************************************} +{* MouEventHandler: Wird vom Maustreiber ber die Assembler-Routine *} +{* AssHand aufgerufen, sobald ein Ereignis in Verbin- *} +{* dung mit der Maus eintritt *} +{**----------------------------------------------------------------------**} +{* Eingabe: EvFlags = die Event-Mask *} +{* ButState = aktueller Status der Mausknpfe *} +{* X, Y = die aktuelle Position des Maus-Cursors in Bezug *} +{* auf den Textbildschirm *} +{**************************************************************************} + +procedure MouEventHandler( EvFlags, ButState, x, y : integer ); + +var NeuS, { neue Koordinate des Maus-Cursors } + NeuZ, { relativ zum neuen Bereich } + NeuBer : byte; { Nummer des neuen Bereichs } + EvData : EVENT; { das eingetretene Ereignis } + Ticks : longint; { nimmt die aktuelle Uhrzeit auf } + i, { Schleifenzhler } + Mask : integer; { Bit-Maske } + +begin + Ticks := Time; { Zeit holen } + NeuBer := BufPtr^[ y * TCol + x ]; { Bereich holen } + if ( NeuBer = KEIN_BEREICH ) then { nicht in Bereich? } + begin { Ja, Bezugspunkt ist gesamter Bildschirm } + NeuZ := y; + NeuS := x; + end + else { Nein, Bezugspunkt ist obere linke Bereichsecke } + begin + NeuZ := y - AktBerPtr^[ NeuBer ].y1; + NeuS := x - AktBerPtr^[ NeuBer ].x1; + end; + +{----- Die einzelnen Ereignisse separat als ein EVENT-Record erfassen ------} + + Mask := 1; { mit Event-Bit 0 beginnen } + with EvData do { Event-Record erzeugen } + begin + Zeit := Ticks; { Daten in das Event-Record laden } + Buttons := ButState; + Bereich := NeuBer; + ZeileRel := NeuZ; + SpalteRel := NeuS; + ZeileAbs := y; + SpalteAbs := x; + end; + + for i:=0 to 4 do { die einzelnen Bits in EvFlags durchlaufen } + begin + if not((EvFlags and Mask = 0) or + ((Mask = EV_MOU_MOVE) and ((x = AktX) and (y = AktY)))) then + begin + EvData.Ereignis := Mask; { Ereignis-Code speichern } + KbmPutQueue( MouQueueP, EvData ); {Event-Record in der Queue abl.} + end; + Mask := Mask shl 1; { nchstes Event-Bit verarbeiten } + end; + + {-- neue Mausdaten in globalen Variablen merken -------------------------} + + AktX := x; { neue Mausposition } + AktY := y; + AktBut := ButState; { Status der Mausknpfe merken } + AktBer := NeuBer; { neuen Mausbereich merken } +end; + +{**************************************************************************} +{* KbmEventWait: wartet auf den Eintritt eines bestimmten Ereignisses in *} +{* Verbindung mit der Maus oder der Tastatur *} +{**----------------------------------------------------------------------**} +{* Eingabe: WAIT_EVENT = Bitmaske, die die zu erwartenden Ereignisse *} +{* spezifiziert *} +{* EV_REC = Event-Record, in dem Informationen ber das *} +{* eingetretene Ereignis zurckgeliefert werden. *} +{* Info: - WAIT_EVENT kann durch ODER Verknpfung der verschie- *} +{* denen Konstanten wie EV_MOU_MOVE, EV_LEFT_PRESS etc. *} +{* erstellt werden *} +{* - Die Prozedur kehrt erst zum Aufrufer zurck, wenn eines *} +{* der angegebenen Ereignisse eingetreten ist. Ereignisse, *} +{* die in der Zwischenzeit eintreten, aber nicht erwartet *} +{* werden, werden verworfen. *} +{* - Diese Funktion darf rekursiv aufgerufen werden, so da *} +{* sich ein innerhalb dieser Funktion aufgerufener Event- *} +{* Handler des Anwendungsprogramms wiederum dieser Funktion *} +{* bedienen kann. *} +{**************************************************************************} + +procedure KbmEventWait( WaitEvent : integer; var EvRec : EVENT ); + +var AktEvent : EVENT; { nimmt das aktuelle Event auf } + Index : byte; { Index in die Event-Handler-Tabelle } + TestEvent: Event; + +begin + {AktEvent:=Evrec; + KbmPeekEvent(Testevent);} + {If (AktBut = 0) or (Testevent.ereignis>0) then + begin} + repeat { auf passendes Ereignis warten } + KbmGetEvent( AktEvent ); { Ereignis holen } + {-- Handler des Anwendungsprogramms aufrufen --------------------------} + + Index := KbmIGetIndex( AktEvent.Ereignis ); { Index in Tabelle erm. } + if ( HandTab[ Index ].Call ) then { Handler installiert? } + HandTab[ Index ].Handler( AktEvent ); { Ja, aufrufen } + + {If Aktbut >0 then delay(50);} + until ( AktEvent.Ereignis and WaitEvent <> 0 ); + {end; else + delay(50);} + EvRec := AktEvent; { Event an Aufrufer bergeben } +end; + +{**************************************************************************} +{* KbmRegisterHandler : registriert einen Handler des Anwendungspro- *} +{* gramms fr ein bestimmtes Ereignis *} +{**-----------------------------------------------------------------------*} +{* Eingabe: EVENT = die Event-Maske *} +{* HANDLER = der aufzurufende Handler *} +{**************************************************************************} + +procedure KbmRegisterHandler( Event : word; Handler : EVENTHANDLER ); + +var i : byte; { Index in Event-Handler-Tabelle } + +begin + i := KbmIGetIndex( Event ); { Index ermitteln } + HandTab[ i ].Call := TRUE; { Handler aufrufen } + HandTab[ i ].Handler := Handler; { Zeiger auf Handler speichern } +end; + +{**************************************************************************} +{* KbmDeRegisterHandler : entfernt einen Handler des Anwendungsprogramms *} +{* fr ein bestimmtes Ereignis wieder *} +{**-----------------------------------------------------------------------*} +{* Eingabe: EVENT = die Event-Maske *} +{**************************************************************************} + +procedure KbmDeRegisterHandler( Event : word ); + +begin + HandTab[ KbmIGetIndex( Event ) ].Call := FALSE; { Handler nicht mehr } +end; { aufrufen } + +{**************************************************************************} +{* MouPtrMask: fgt die Cursor- und Screen-Mask aus einer Bitmaske fr *} +{* das Zeichen und die Farbe zusammen *} +{**----------------------------------------------------------------------**} +{* Eingabe: Zeichen = Bitmaske fr die Cursor- und Screen-Mask in Bezug *} +{* auf das Zeichen *} +{* Farbe = Bitmaske fr die Cursor- und Screen-Mask in Bezug *} +{* auf die Farbe des Zeichens *} +{* Ausgabe: die Cursor- und die Screen-Mask als ein Wert vom Typ PTRVIEW *} +{* Info: fr Zeichen und Farbe knnen die Konstanten PtrSameChar, *} +{* PtrSameCol, PtrSameColB, PtrInvCol und PtrInvColB sowie die *} +{* Ergebnisse der Funktionen PtrDifChar und PtrDifCol bergeben *} +{* werden *} +{**************************************************************************} + +function MouPtrMask( Zeichen, Farbe : word ) : PTRVIEW; + +var Mask : PTRVIEW; { die zu erstellen Cursor- und Screen-Mask } + +begin + PTRVREC( Mask ).ScreenMask := ( ( Farbe and $ff ) shl 8 ) + + ( Zeichen and $ff ); + PTRVREC( Mask ).CursorMask := ( Farbe and $ff00 ) + ( Zeichen shr 8 ); + MouPtrMask := Mask; { Maske an Aufrufer zurckliefern } +end; + +{**************************************************************************} +{* PtrDifChar: erstellt den Zeichenteil der Cursor- und Screen-Mask in *} +{* Bezug auf das Zeichen *} +{**----------------------------------------------------------------------**} +{* Eingabe: ASCII-Code des Zeichens, das den Maus-Cursor bilden soll *} +{* Ausgabe: Cursor- und Screen-Mask fr dieses Zeichen *} +{* Info: das Funktionsergebnis sollte mit Hilfe der Funktion *} +{* MouPtrMask weiterverarbeitet werden *} +{**************************************************************************} + +function PtrDifChar( Zeichen : byte ) : word; + +begin + PtrDifChar := Zeichen shl 8; +end; + +{**************************************************************************} +{* PtrDifCol: erstellt den Zeichenteil der Cursor- und Screen-Mask in *} +{* Bezug auf die Farbe des Maus-Cursors *} +{**----------------------------------------------------------------------**} +{* Eingabe: Farbe des Zeichens, das den Maus-Cursor bilden soll *} +{* Ausgabe: Cursor- und Screen-Mask fr diese Farbe *} +{* Info: das Funktionsergebnis sollte mit Hilfe der Funktion *} +{* MouPtrMask weiterverarbeitet werden *} +{**************************************************************************} + +function PtrDifCol( Farbe : byte ) : word; + +begin + PtrDifCol := Farbe shl 8; +end; + +{**************************************************************************} +{* MouDefinePtr: bergibt dem Maustreiber die Cursor- und Screen-Mask, *} +{* die fortan das Erscheinungsbild des Maus-Cursors be- *} +{* estimmen soll *} +{**----------------------------------------------------------------------**} +{* Eingabe: Mask = die Cursor- und Screen-Mask als ein Paramter vom *} +{* Typ PTRVIEW *} +{* Info: - der Parameter Mask sollte mit Hilfe der Funktion *} +{* MouPtrMask erstellt worden sein *} +{* - die hherwertigen 16-Bit von Mask reprsentieren die *} +{* Screen-Mask, die niederwertigen 16 Bit die Cursor-Mask *} +{**************************************************************************} + +procedure MouDefinePtr( Mask : PTRVIEW ); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + Regs.AX := $000a; { Fktnr. fr "Set text pointer type" } + Regs.BX := 0; { Software-Cursor einstellen } + Regs.CX := PTRVREC( Mask ).ScreenMask; { Lo-Word ist AND-Maske } + Regs.DX := PTRVREC( Mask ).CursorMask; { Hi-Word ist XOR-Maske } + Intr( $33, Regs); { Maus-Treiber aufrufen } +end; + +{**************************************************************************} +{* MouDefBereich: erlaubt die Registrierung verschiedener Bildschirmbe- *} +{* reiche, die als unterschiedliche Mausbereiche erkannt *} +{* werden *} +{**----------------------------------------------------------------------**} +{* Eingabe: Anzahl = Anzahl der Bildschirmbereiche *} +{* BPtr = Zeiger auf das Array, in dem die einzelnen *} +{* Bereiche als jeweils eine Struktur vom Typ *} +{* BEREICH beschrieben werden *} +{* Info: - den freibleibenden Bildschirmbereichen wird der Code *} +{* KEIN_BEREICH zugeordnet *} +{**************************************************************************} + +procedure MouDefBereich( Anzahl : byte; BPtr : BERPTR ); + +var AktBer, { Nummer des aktuellen Bereichs } + Bereich : byte; { Schleifenzhler } + +begin + AktBerPtr^ := BPtr^; { Pointer auf Vektor und An- } + AnzBereiche := Anzahl; { zahl der Bereiche merken } + FillChar( BufPtr^, BLen, KEIN_BEREICH ); { alle Elemente=KEIN_BEREICH } + for Bereich:=0 to anzahl-1 do { die einzelnen Bereiche durchlaufen } + with BPtr^[ Bereich ] do + KbmIBufFill( x1, y1, x2, y2, Bereich ); + + AktBer := BufPtr^[ AktY * TCol + AktX ]; { akt. Bereich ermitteln } +end; + +{**************************************************************************} +{* MouShowMouse: bringt den Maus-Cursor auf den Bildschirm *} +{**----------------------------------------------------------------------**} +{* Info: die Aufrufe von MouShowMouse und MouHidemOuse mssen ausbala- *} +{* ciert sein, damit sie Wirkung zeigen *} +{**************************************************************************} + +procedure MouShowMouse; + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + Regs.AX := $0001; { Fktnr.: fr "Show Mouse" } + Intr( $33, Regs ); { Maus-Treiber aufrufen } +end; + +{**************************************************************************} +{* MouHideMouse: entfernt den Maus-Cursor vom Bildschirm *} +{**----------------------------------------------------------------------**} +{* Info: die Aufrufe von MouShowMouse und MouHideMouse mssen ausbalan- *} +{* ciert sein, damit sie Wirkung zeigen *} +{**************************************************************************} + +procedure MouHideMouse; + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + Regs.AX := $0002; { Fktnr. fr "Hide Mouse" } + Intr( $33, Regs); { Maus-Treiber aufrufen } +end; + +{**************************************************************************} +{* MouSetMoveArea: legt den Bewegungsbereich fr den Maus-Cursor fest *} +{**----------------------------------------------------------------------**} +{* Eingabe: x1, y1 = Koordinate der oberen linken Bereichsecke *} +{* x2, y2 = Koordinate der unteren rechten Bereichsecke *} +{* Info: - Die Ordinaten beziehen sich auf den Textbildschirm und *} +{* nicht auf den virtuellen Grafikbildschirm des Maustreibers *} +{**************************************************************************} + +procedure MouSetMoveArea( x1, y1, x2, y2 : byte ); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + Regs.AX := $0008; { Fktnr. fr "Set vertical Limits" } + Regs.CX := integer( y1 ) shl 3; { Umrechnung in virtuellen } + Regs.DX := integer( y2 ) shl 3; { Mausbildschirm } + Intr( $33, Regs ); { Maus-Treiber aufrufen } + Regs.AX := $0007; { Fktnr. fr "Set horizontal Limits" } + Regs.CX := integer( x1 ) shl 3; { Umrechnung in virtuellen } + Regs.DX := integer( x2 ) shl 3; { Mausbildschirm } + Intr( $33, Regs ); { Maus-Treiber aufrufen } +end; + +{**************************************************************************} +{* MouSetSpeed: legt das Verhltnis zwischen der Mausbewegung und der *} +{* daraus resultierenden Bewegung des Maus-Cursors fest *} +{**----------------------------------------------------------------------**} +{* Eingabe: XSpeed = Geschwindigkeit in X-Richtung *} +{* YSpeed = Geschwindigkeit in Y-Richtung *} +{* Info: - Beide Parameter beziehen sich auf die Einheit Mickey/8 Px. *} +{**************************************************************************} + +procedure MouSetSpeed( XSpeed, YSpeed : integer ); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + Regs.AX := $000f; { Fktnr. "Set mickeys to pixel ratio" } + Regs.CX := XSpeed; + Regs.DX := YSpeed; + Intr( $33, Regs); { Maus-Treiber aufrufen } +end; + +{**************************************************************************} +{* MouMovePtr: bewegt den Maus-Cursor an eine neue Bildschirmposition *} +{**----------------------------------------------------------------------**} +{* Eingabe: COL = die neue Bildschirmspalte des Maus-Cursors *} +{* ROW = die neue Bildschirmzeile des Maus-Cursors *} +{* Info: - Die Ordinaten beziehen sich auf den Textbildschirm und *} +{* nicht auf den virtuellen Grafikbildschirm des Maustreibers *} +{**************************************************************************} + +procedure MouMovePtr( Col, Row : byte ); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + NeuBer : byte; { Bereich, in den die Maus bewegt wird } + +begin + Regs.AX := $0004; { Fktnr. "Set mouse pointer position" } + AktX := col; { Koordinate in globalen } + AktY := row; { Variablen speichern } + Regs.CX := integer( col ) shl 3; { Koordinaten umrechnen und in } + Regs.DX := integer( row ) shl 3; { globalen Variablen speichern } + Intr( $33, Regs ); { Maus-Treiber aufrufen } + + AktBer := BufPtr^[ Row * TCol + Col ]; { neuen Bereich ermitteln } +end; + + +procedure KbClrevent; +begin + KbQueueP^.Next := 1; { noch kein Event in der Queue } + KbQueueP^.Last := 1; + ev.Ereignis:=0; +end; + +procedure MouClrevent; +begin + MouQueueP^.Next := 1; { noch kein Event in der Queue } + MouQueueP^.Last := 1; + ev.Ereignis:=0; AktBut:=0; +end; + + +{**************************************************************************} +{* KbmReleaseMode : Lscht einen der Tastatur-Modi SCROLL-LOCK, NUM-LOCK *} +{* oder CAPS-LOCK *} +{**-----------------------------------------------------------------------*} +{* Eingabe: Modus = einer der Codes KEY_SCROLL_LOCK, KEY_CAPS_LOCK oder *} +{* KEY_NUM_LCOK *} +{* Info : Nur bei ATs und 386ern wird durch den Aufruf dieser Prozedur *} +{* auch automatisch das entsprechende Tastatur-LED abgeschaltet.*} +{* Bei XTs ist dies nicht mglich. *} +{**************************************************************************} + +procedure KbmReleaseMode( Modus : byte ); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + BiosKbFlag := BiosKbFlag and ( Modus xor $FF ); { Bit ausblenden } + Regs.AH := $02; { BIOS-Tastatur-Status abfragen, damit } + intr( $16, Regs ); { das BIOS den neuen Status erkennt } +end; + +{**************************************************************************} +{* KbmSetMode : Schaltet einen der Tastatur-Modi SCROLL-LOCK, NUM-LOCK *} +{* oder CAPS-LOCK an *} +{**-----------------------------------------------------------------------*} +{* Eingabe: Modus = einer der Codes KEY_SCROLL_LOCK, KEY_CAPS_LOCK oder *} +{* KEY_NUM_LCOK *} +{* Info : Nur bei ATs und 386ern wird durch den Aufruf dieser Prozedur *} +{* auch automatisch das entsprechende Tastatur-LED angeschaltet.*} +{* Bei XTs ist dies nicht mglich. *} +{**************************************************************************} + +procedure KbmSetMode( Modus : byte ); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + BiosKbFlag := BiosKbFlag or Modus; { Bit einblenden } + Regs.AH := $02; { BIOS-Tastatur-Status abfragen, damit } + intr( $16, Regs ); { das BIOS den neuen Status erkennt } +end; + + + + +{**************************************************************************} +{* KbmEnd: wird zur Beendigung der Arbeit mit den Funktionen und Proze- *} +{* duren aus dem Maus-Modul aufgerufen *} +{**----------------------------------------------------------------------**} +{* Info: - Die Prozedur mu vom Anwendungsprogramm nicht explizit auf- *} +{* gerufen werden, da die Funktion KbmInit sie als Exit-Proze- *} +{* dur definiert *} +{**************************************************************************} + +{$F+} { mu FAR sein, damit Aufruf als Exit-Prozedur mglich } + + +procedure KbmEnd(ende:boolean); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + +begin + MouHideMouse; { Maus-Cursor vom Bildschirm entfernen } + Regs.AX := 0; { Reset des Maus-Treibers } + Intr( $33, Regs); { Maus-Treiber aufrufen } + + Dispose( KbQueueP ); { Tastatur-Queue wieder auflsen } + Dispose( MouQueueP ); { Maus-Queue wieder auflsen } + + FreeMem( BufPtr, BLen ); { allokierten Speicher wieder freigeben } + FreeMem( AktBerptr, SizeOf( Berarray )+1); + SetIntVec( $09, OldKBHandler ); { alten Tastatur-Handler restaurieren } + If ende then + ExitProc := ExitOld; { wieder alte Exit-Prozedur installieren } +end; + + +{$F-} { keine FAR-Prozeduren mehr } + +{**************************************************************************} +{* KbmInit: leitet die Arbeit mit den verschiedenen Funktionen und Pro- *} +{* zeduren des Maus-Moduls ein und initialisiert die verschie- *} +{* denen Variablen *} +{**------------------------------------------------------------------------} +{* Eingabe: Spalten = Anzahl der Bildschrimspalten *} +{* Zeilen = Anzahl der Bildschirmzeilen *} +{**************************************************************************} + +procedure KbmInit( Spalten, Zeilen : byte ); + +var Regs : Registers; { Prozessorregister fr Interruptaufruf } + i : byte; { Schleifenzhler als Index in HandTab } + +begin + + {-- neuen Tastatur-Handler installieren----------------------------------} + + AktStatus := BiosKbFlag; { BIOS-Tastatur-Status laden } + + GetIntVec( $09, OldKBHandler ); { Adresse des Int-09-Handlers holen } + SetIntVec( $09, @NewKbHandler ); { neuen Handler installieren } + + TLine := Zeilen; { Anzahl Zeilen- und Spalten in } + TCol := Spalten; { globalen Variablen speichern } + + {-- Puffer fr Maus-Bereiche allokieren und fllen ----------------------} + + BLen := TLine * TCol; { Anzahl der Zeichen im Bildschirm } + GetMem( BufPtr, BLen ); { internen Bereichs-Puffer allokieren } + KbmIBufFill( 0, 0, TCol-1, TLine-1, KEIN_BEREICH ); + + Regs.AX := 0; { Mouse-Treiber initialisieren } + Intr( $33, Regs ); { Maus-Treiber aufrufen } + MouAvail := ( Regs.AX = $ffff ); { Maus verfgbar? } + + AktBer := KEIN_BEREICH; { Maus-Cursor in keinem Bereich } + AktX := TCol + 1; { Position auerhalb des Bildschirms } + {new(AktBerptr);} + GetMem( AktBerptr, SizeOf( Berarray )+1); + {-- die Maus- und Tastatur-Queue anlegen und initialisieren -------------} + + New( KbQueueP ); { die Tastatur-Queue erzeugen } + KbQueueP^.Next := 1; { noch kein Event in der Queue } + KbQueueP^.Last := 1; + + New( MouQueueP ); { die Maus-Queue erzeugen } + MouQueueP^.Next := 1; { noch kein Event in der Queue } + MouQueueP^.Last := 1; + + for i := 1 to 16 do { noch kein Anwender-Event-Handler installiert } + HandTab[ i ].Call := FALSE; + + if ( MouAvail ) then { ist eine Maus installiert? } + begin { Ja } + MouSetMoveArea( 0, 0, TCol-1, TLine-1 ); { Bewegunsbereich setzen } + + AktX := KbmIGetX; { aktuelle Mausposition in } + AktY := KbmIGetY; { globale Variablen laden } + + {-- den Maus-Event-Handler NewMouHandler installieren ---------------} + + Regs.AX := $000C; { Fktnr. fr "Set Mouse Handler" } + Regs.CX := EV_MOU_ALL; { Event-Maske laden } + Regs.DX := Ofs( NewMouHandler ); { Offsetadresse des Handlers } + Regs.ES := Seg( NewMouHandler ); { Segmentadresse des Handlers } + Intr( $33, Regs ); { Maus-Treiber aufrufen } + end; +end; + +{**----------------------------------------------------------------------**} +{** Startcode der Unit **} +{**----------------------------------------------------------------------**} + +begin + CrtXMax := Succ(lo(WindMax)); + CrtYMax := Succ(hi(WindMax)); + KbmInit( CrtXmax, CrtYmax ); { die Unit intialisieren } + ExitOld := ExitProc; { Adresse der Exit-Prozedur merken } + ExitProc := @KbmEnd; { KbmEnd als Exit-Prozedur definieren} +end. diff --git a/UNITS/KBMA.ASM b/UNITS/KBMA.ASM new file mode 100644 index 0000000..7cc8da6 --- /dev/null +++ b/UNITS/KBMA.ASM @@ -0,0 +1,153 @@ +;**************************************************************************; +;* K B M A . A S M *; +;*------------------------------------------------------------------------*; +;* Aufgabe : Assembler-Modul fr die KBM-Unit *; +;*------------------------------------------------------------------------*; +;* Autor : MICHAEL TISCHER *; +;* entwickelt am : 1.06.1989 *; +;* letztes Update : 3.06.1989 *; +;*------------------------------------------------------------------------*; +;* assemblieren : TASM KBMA oder *; +;* MASM KBMA; *; +;* ... mit der KBM-Unit verknfpen *; +;**************************************************************************; + +;== Datensegment =========================================================== + +DATA segment word public + +extrn OldKbHandler : dword ;Adresse des alten Int-09-Handlers + +DATA ends + +;== Programm =============================================================== + +CODE segment byte public ;das Programmsegment + + assume CS:CODE ;CS zeigt auf das Codesegment, der In- + ;halt von DS, SS und ES ist unbekannt + +public NewMouHandler ;gibt dem TP-Programm die Mglichkeit, +public NewKbHandler ;die Adresse des Assembler-Handlers + ;zu ermitteln + +extrn MouEventHandler : near ;der aufzurufende TP-Event-Handler +extrn KbHandler : near ;der aufzurufende Tastatur-Handler + +;--------------------------------------------------------------------------- +;-- NewMouHandler: Event-Handler, der zunchst vom Maustreiber aufgerufen +;-- wird, um seinerseits dann die TP-Prozedur MouEventHandler +;-- aufzurufen +;-- Aufruf von TP: nicht erlaubt! + +NewMouHandler proc far + + push ax ;Prozessorregister sichern + push bx + push cx + push dx + push di + push si + push bp + push es + push ds + + ;-- die Argumente fr den Aufruf der TP-Funktion auf den -------- + ;-- Stack bringen + ;-- Aufruf: + ;-- MouEventHandler (EvFlags, ButStatus, x , y : integer ); + + push ax ;Event-Flags auf den Stack bringen + push bx ;Status der Mausknpfe auf den Stack + + mov di,cx ;horizontale Ordinate in DI merken + mov cl,3 ;Schiebezhler f. Koordinatenumr. + + shr di,cl ;DI (horizontale Ord.) durch 8 teilen + push di ;und auf den Stack bringen + + shr dx,cl ;DX (vertikale Ord.) durch 8 teilen + push dx ;und auf den Stack bringen + + mov ax,DATA ;Segmentadresse des Datensegments AX + mov ds,ax ;in von dort in das DS-Register + + call MouEventHandler ;Aufruf der TP-Prozedur + + ;-- die gesicherten Register wieder vom Stack holen ------------- + + pop ds + pop es + pop bp + pop si + pop di + pop dx + pop cx + pop bx + pop ax + + ret ;zurck zum Maustreiber + +NewMouHandler endp + +;--------------------------------------------------------------------------- +;-- NewKbHandler: neuer Tastatur-Handler, der bei Aufruf des Interrupts 09h +;-- aufgerufen wird, um seinerseits die TP-Prozedur KbHandler +;-- aufzurufen +;-- Aufruf von TP: nicht erlaubt! + +NewKbHandler proc far + + sti ;Interruptaufrufe zulassen + push ax ;Prozessorregister sichern + push bx + push cx + push dx + push di + push si + push bp + push es + push ds + + in al,60h ;Scancode von Tastatur einlesen + xor ah,ah ;und als Argument fr den Aufruf + push ax ;von KbHandler auf den Stack bringen + + mov ax,DATA ;Segmentadresse des Datensegments AX + mov ds,ax ;in von dort in das DS-Register + + assume ds:data + + pushf ;Interruptaufruf des alten Interrupt- + call [OldKbHandler] ;Handlers simulieren + + ;-- die Argumente fr den Aufruf der TP-Funktion auf den -------- + ;-- Stack bringen + ;-- Aufruf: + ;-- KbHandler( KbPort : byte ); + + call KbHandler ;Aufruf der TP-Prozedur + + assume ds:nothing + + ;-- die gesicherten Register wieder vom Stack holen ------------- + + pop ds + pop es + pop bp + pop si + pop di + pop dx + pop cx + pop bx + pop ax + + iret ;zurck zum unterbrochenen Prg. + +NewKbHandler endp + +;--------------------------------------------------------------------------- + +CODE ends ;Ende des Codesegments + end ;Ende des Programms + \ No newline at end of file diff --git a/UNITS/KBMA.OBJ b/UNITS/KBMA.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..c71b2adc4efb5c4c12e957dd7dda7dcf8cfb7df3 GIT binary patch literal 329 zcmZqRV&L$0@^#d64EA;DkY`|E2q`T}%2#kKE>6u&%1JF!PzXycD$dN$Q!vys*wrDx z;PBFVj;$D6)8h_ippefrCI*I#X>1HEE{-9NZZp^!JQx_57#T%DLeBm!uC72K4PORk zM#kqo+6+AYIVs*r9*KD=KpPnNee+9Q%Tn`7U;>;7Ir|ABK!bSwQpxKecnhRGc)3=WGJCoTwN06HfiI4~$YER;inZQ5)3EALKs`5*_fD4n1?VPv14Oo PY;j~`Vs`2RT2=x80&-#j literal 0 HcmV?d00001 diff --git a/UNITS/SWAP.PAS b/UNITS/SWAP.PAS new file mode 100644 index 0000000..ecc0baf --- /dev/null +++ b/UNITS/SWAP.PAS @@ -0,0 +1,218 @@ +{*************************************************************************** +* S W A P : eine Unit, die eine alternative Exec-Prozedur zum Aufruf be- * +* liebiger Programme aus dem TP-Programm heraus zur Verfgung * +* stellt. Im Gegensatz zur normalen Exec-Prozedur wird das TP- * +* Programm vor der Ausfhrung des angegebenen Programms in den * +* EMS-Speicher oder auf Platte ausgelagert und so der Speicher * +* fr die Ausfhrung des Programms frei gemacht. * +**------------------------------------------------------------------------** +* Autor : MICHAEL TISCHER * +* entwickelt am : 9.06.1989 * +* letztes Update am: 13.06.1989 * +***************************************************************************} + +unit swap; + +interface + +uses DOS, Ems, Kbm; + +{$F-} +{-- Deklaration der Funktionen und Prozeduren, die von einem anderen ------} +{-- Programm aufgerufen werden knnen ------} + +function ExecPrg ( Command : string ) : byte; +function ExecCommand( Command : string ) : byte; + +{-- Konstanten, ffentlich ------------------------------------------------} + +const SwapPath : string[ 80 ] = 'c:\'; + + {------------------------ Fehlercodes von ExecPrg & ExecCommand -----} + + SwapErrOk = 0; { kein Fehler, alles o.k. } + SwapErrStore = 1; { TP-Programm konnte nicht ausgelagert werden } + SwapErrNotFound = 2; { Programm nicht gefunden } + SwapErrNoAccess = 5; { Zugriff auf Programm verweigert } + SwapErrNoRAM = 8; { zu wenig Speicher } + +implementation + +{$L swapa} { Assembler-Modul einbinden } + +{-- Deklaration der Prozeduren aus dem Assembler-Modul SWAPA --------------} + +function SwapOutAndExec( Command, + CmdPara : string; + ToDisk : boolean; + Handle : word; + Len : longint ) : byte ; external; + +function InitSwapa : word ; external; + +{-- globale Variablen, modulintern ----------------------------------------} + +var Len : longint; { Anzahl der auszulagernden Bytes } + +{*************************************************************************** +* NewExec : Steuert die Auslagerung des aktuellen TP-Programms und den * +* anschlieenden Aufruf des angegebenen Progamms. * +**------------------------------------------------------------------------** +* Eingabe : CmdLine = String mit dem Namen des auzurufenden Programms * +* CmdPara = String mit den Kommandozeilen-Parametern fr das * +* aufzurufenden Programm * +* Ausgabe : Einer der Fehlercodes SwapErr... * +***************************************************************************} + +function NewExec( CmdLine, CmdPara : string ) : byte; + +var Regs, { Prozessorregister zum Interruptaufruf } + Regs1 : Registers; + SwapFile : string[ 81 ]; { Namen der temporren Swap-Datei } + ToDisk : boolean; { auf Platte oder EMS-Speicher auslagern? } + Handle : integer; { EMS- oder Datei-Handle } + Pages : integer; { Anzahl der bentigten EMS-Pages } + +begin + {-- testen, ob Auslagerung in EMS-Speicher mglich ----------------------} + KbmEnd(false); + ToDisk := TRUE; { von Auslagerung auf Platte ausgehen } + if ( EmsInst ) then { ist EMS-Speicher verfgbar } + begin { Ja } + Pages := ( Len + 16383 ) div 16384; { bentigte Pages ermitteln } + Handle := EmsAlloc( Pages ); { Pages allokieren } + ToDisk := ( EmsError <> EmsErrOk ); { Allokation erfolgreich? } + if not ToDisk then + EmsSaveMapping( Handle ); { Mapping speichern } + end; + + if ToDisk then { in EMS-Speicher auslagern? } + begin { Nein, auf Platte } + + {- temporre Datei im SwapPath mit Attributen SYSTEM & HIDDEN ffnen } + + SwapFile := SwapPath; + SwapFile[ byte(SwapFile[0]) + 1 ] := #0; {String in DOS-Format konv.} + Regs.AH := $5A; { Funktionsnr.: "temp. Datei erstellen" } + Regs.CX := Hidden or SysFile; { Dateiattribut } + Regs.DS := seg( SwapFile ); { Adresse des SwapPath nach DS:DX } + Regs.DX := ofs( SwapFile ) + 1; + MsDos( Regs ); { DOS-Interrupt 21h aufrufen } + if ( Regs.Flags and FCarry = 0 ) then { Datei erffnet? } + Handle := Regs.AX { Ja, Handle merken } + else { Nein, Funktion vorzeitig beenden } + begin + NewExec := SwapErrStore; { Fehler beim Auslagern des Programms } + exit; { Funktion beenden } + end; + end; + + {-- Programm ber Assembler-Routine ausfhren -------------------------} + SwapVectors; { Interrupt-Vektoren zurcksetzen } + NewExec := SwapOutAndExec( CmdLine, CmdPara, ToDisk, Handle, Len ); + SwapVectors; { Turbo-Int-Handler wieder installieren } + if ToDisk then { wurde auf Platte ausgelagert? } + begin { Ja } + {-- temporre Datei schlieen und lschen -------------------------} + + Regs1.AH := $3E; { Funktionsnr.: "Datei schlieen" } + Regs1.BX := Regs.AX; { Handle nach BX laden } + MsDos( Regs1 ); { DOS-Interrupt 21h aufrufen } + + Regs.AH := $41; { Funktionsnr.: "Datei lschen" } + MsDos( Regs ); + end + else { Nein, Auslagerung erfolgte in EMS-Speicher } + begin + EmsRestoreMapping( Handle ); { Mapping wieder zurckspeichern } + EmsFree( Handle ); { allokierten EMS-Speicher wieder freigeben } + end; + KbmInit(CrtXmax,CrtYmax); +end; + +{*************************************************************************** +* ExecPrg : Fhrt ein Programm, dessen Name inklusive der Dateierwei- * +* terung bekannt sein mu, ber NewExec aus. * +**------------------------------------------------------------------------** +* Eingabe : Command = String mit dem Namen des auszufhrenden Programms * +* und den Parametern, die in der Kommandozeile ber- * +* geben werden sollen. * +* Ausgabe : Einer der Fehlercodes SwapErr... * +* Info : Mit Hilfe dieser Prozedur knnen nur EXE- und COM-Programme, * +* nicht aber Batch-Dateien und interne Befehle des Kommando- * +* prozessors ausgefhrt werden. Dabei mu die Dateierweiterung * +* des Programms und der Pfad genau angegeben werden, da nicht * +* im "Path" nach einem entsprechenden Programm gesucht wird. * +***************************************************************************} + +function ExecPrg( Command : string ) : byte; + +const Trenner : set of char = [ ' ',#9,'-','/','>','<',#0,'|' ]; + +var i : integer; { Index in Source-String } + CmdLine, { nimmt Befehl auf } + Para : string; { nimmt Parameter auf } + +begin + {-- den Befehl aus dem Command-String isolieren -------------------------} + + CmdLine := ''; { den String zunchst einmal leeren } + i := 1; { mit dem ersten Buchstaben im Source-String beginnen } + while not ( (Command[i] in Trenner) or ( i > length( Command ) ) ) do + begin { Zeichen ist noch kein Trenner } + CmdLine := CmdLine + Command[ i ]; { in String aufnehmen } + inc( i ); { I auf nchstes Zeichen im String setzen } + end; + + Para := ''; { noch keine Parameter entdeckt } + + {-- nach dem nchsten "nicht-Leerzeichen" suchen ------------------------} + + while (i<=length(Command)) and ( (Command[i]=#9) or (Command[i]=' ') ) do + inc( i ); + + {-- den Rest des Strings in den Para-String kopieren --------------------} + + while i <= length( Command ) do + begin + Para := Para + Command[ i ]; + inc( i ); + end; + + ExecPrg := NewExec( CmdLine, Para ); { Befehl ber NewExec ausfhren } + +end; + +{*************************************************************************** +* ExecCommand : Fhrt ein Programm aus, als ob sein Name innerhalb der * +* Benutzeroberflche von DOS angegeben wurde. * +**------------------------------------------------------------------------** +* Eingabe : Command = String mit dem Namen des auszufhrenden Programms * +* und den Parametern, die in der Kommandozeile ber- * +* geben werden sollen. * +* Ausgabe : Einer der Fehlercodes SwapErr... * +* Info : Da der Aufruf des Programms ber den Kommandprozessor er- * +* folgt, knnen mit Hilfe dieser Prozedur auch die internen * +* Befehle des Kommandoprozessors (DIR etc.) sowie Batch-Dateien * +* zur Ausfhrung gebracht werden. * +***************************************************************************} + +function ExecCommand( Command : string ) : byte; + +var ComSpec : string; { Pfad des Kommandoprozessors } + +begin + ComSpec := GetEnv( 'COMSPEC' ); { Pfad des Kommandoprozessors holen } + ExecCommand := NewExec( ComSpec, '/c'+ Command ); {Prg/Befehl ausfhren} +end; + +{**----------------------------------------------------------------------**} +{** Startcode der Unit **} +{**----------------------------------------------------------------------**} + +begin + {-- Anzahl der jeweils auszulagernden Bytes berechnen -------------------} + + Len := ( longint(Seg(HeapEnd^)-(PrefixSeg+$10)) * 16 ) - + InitSwapa + Ofs(HeapPtr^); +end. diff --git a/UNITS/SWAPA.ASM b/UNITS/SWAPA.ASM new file mode 100644 index 0000000..435460a --- /dev/null +++ b/UNITS/SWAPA.ASM @@ -0,0 +1,672 @@ +;**************************************************************************; +;* S W A P A . A S M *; +;*------------------------------------------------------------------------*; +;* Aufgabe : Assembler-Modul fr die SWAP-Unit *; +;*------------------------------------------------------------------------*; +;* Autor : MICHAEL TISCHER *; +;* entwickelt am : 1.06.1989 *; +;* letztes Update : 3.06.1989 *; +;*------------------------------------------------------------------------*; +;* assemblieren : TASM /MX SWAPA *; +;* ... mit der SWAP-Unit verknfpen *; +;**************************************************************************; + +;== Konstanten ============================================================= + +STACK_LEN equ 64 ;Anzahl der Words in internem Stack + +;== Strukturen ============================================================= + +ExecStruc struc ;Datenstruktur fr EXEC-Funktion + +EsSegEnv dw ? ;Segmentadresse des Environment-Blocks +EsCmdPAdr dd ? ;Pointer auf die Kommandozeilen-Parameter +EsFCB1Adr dd ? ;Pointer auf FCB #1 +EsFCB2Adr dd ? ;Pointer auf FCB #2 + +ExecStruc ends + +;== Datensegment =========================================================== + +DATA segment word public + +extrn PrefixSeg : word ;Segmentadresse des PSP in Turbo-Variable + +DATA ends + +;== Programm =============================================================== + +CODE segment byte public ;das Programmsegment + +public SwapOutAndExec ;gibt dem TP-Programm die Mglichkeit, + ;die Adresse des Assembler-Handlers + ;zu ermitteln +public InitSwapa ;Initialisierungs-Prozedur +;== Variablen im Codesegment =============================================== + +CodeStart equ this byte ;hier beginnt der Code, der an den Anfang + ;des TP-Programms kopiert wird + +;-- Variablen, die zum Up- und DownLoaden der Swap-Routinen bentigt ------- +;-- werden + +CoStAddr dd ? ;urspr. Adresse von PARA(CodeStart) +CoStLen dw ? ;Anzahl geswappter Words ab CoStAddr +StackPtr dw ? ;nimmt alten Stackpointer auf +StackSeg dw ? ;nimmt altes Stacksegment auf +TurboSeg dw ? ;Segmentadresse des Turbo-Codesegments + +;-- Variablen, die whrend des Auslagerns des Programms und der Aus- ------- +;-- fhrung des bergebenen Befehls bentigt werden + +NewStack dw STACK_LEN dup (?) ;neuer Stack +EndStack equ this word ;Ende des Stacks + +Command dd ? ;Zeiger auf Befehl +CmdPara dd ? ;Zeiger auf Kommandozeilen-Parameter +ToDisk db ? ;True, wenn Swapping auf Disk erfolgt +Handle dw ? ;Disk oder EMS-Handle +Len dd ? ;Anzahl zu sichernder Bytes + +FCB1 db 16 dup ( 0 ) ;FCB #1 fr PSP +FCB2 db 16 dup ( 0 ) ;FCB #2 fr PSP +CmdBuf db 128 dup ( 0 ) ;Kommandozeilen-Befehle hiner Prg.-Name +PrgName db 64 dup ( 0 ) ;Programmname +ExecData ExecStruc < 0, CmdBuf, FCB1, FCB2 > ;Datenstruktur fr EXEC + +OldPara dw ? ;Anzahl bisher reservierter Paragraphen +FrameSeg dw ? ;Segmentadresse des EMS-Page-Frames +FehlerCode db 0 ;FehlerCode fr Aufrufer +TerMes db 13,10,13,10 + db "ͻ",13,10 + db " Das ausgelagerte Programm konnte nicht mehr ",13,10 + db " zurck in den Speicher geladen werden. ",13,10 + db " Die Programmausfhrung wurde beendet ! ",13,10 + db "ͼ" + db 13,10,13,10,"$" + +;--------------------------------------------------------------------------- +;-- StartSwap : koordiniert das Auslagern des TP-Programms + +StartSwap proc far + + assume cs:code, ds:nothing + + ;-- aktuellen Stack sichern und neuen Stack installieren -------- + + cli ;Interrupts unterdrcken + mov StackPtr,sp ;aktuellen Stack merken + mov StackSeg,ss + push cs ;neuen Stack installieren + pop ss + mov sp,offset EndStack - 2 + sti ;Interrupts wieder zulassen + + push cs ;DS auf CS setzen + pop ds + assume cs:code, ds:code + ;-- nicht bentigten Speicher wegschreiben ---------------------- + + cmp ToDisk,0 ;in EMS-Speicher schreiben? + je Ems ;Ja ---> Ems + + call Write2File ;Nein, in Datei schreiben + jnc ShrinkMem ;kein Fehler ---> ShrinkMem + + mov FehlerCode, 1 ;Fehler bei Ausgabe in Datei + jmp short GetBack ;zurck zu Turbo + +Ems: mov ah,41h ;Segmentadresse des Page-Frames ermitteln + int 67h ;EMM aufrufen + mov FrameSeg,bx ;Resultat in Variablen merken + + call Write2Ems ;Programm in EMS-Speicher auslagern + + ;-- Anzahl aktuell allokierter Paragraphen ermitteln ------------ + +ShrinkMem: mov ax,TurboSeg ;Segmentadresse Turbo Codesegment + sub ax,11h ;10 Paragraphen fr PSP und einen fr + ;MCB abziehen + mov es,ax ;ES zeigt jetzt auf MCB des Turbo-Progs. + mov bx,es:[3] ;Anzahl allokierter Paragraphen holen + mov OldPara,bx ;und in Variablen merken + + ;-- Anzahl noch bentigter Paragraphen berechnen und Speicher- -- + ;-- bedarf auf diese Gre reduzieren + + inc ax ;AX zeigt jetzt auf PSP + mov es,ax ;fr Funktionsaufruf nach ES + mov bx,CostLen ;Anzahl fr Swap-Rout. bentigter Words + add bx,128+7 ;PSP hinzurechnen und aufrunden + mov cl,3 ;durch 8 Words (pro Paragraph) teilen + shr bx,cl + + mov ah,4Ah ;Funktionsnr. fr "Gre ndern" + int 21h ;DOS-Interrupt aufrufen + + ;-- die bergebene Befehlszeile mit Hilfe der EXE-Funktion ------ + ;-- ausfhren + + mov bp,ds ;DS sichern + + mov ax,cs ;ES und DS auf CS setzen + mov es,ax + mov ds,ax + + ;-- Segmentadresse des Codesegments in die Zeiger innerhalb ----- + ;-- der EXEC-Struktur eintragen + + mov word ptr ExecData.EsFCB1Adr + 2,ax + mov word ptr ExecData.EsFCB1Adr + 2,ax + mov word ptr ExecData.EsCmdPAdr + 2,ax + + mov bx,offset ExecData ;ES:BX zeigt auf Parameterblock + mov dx,offset PrgName ;DS:DX zeigt auf Befehls-String + + mov ax,4B00h ;Funktionsnr. fr "EXEC" + int 21h ;DOS-Interrupt aufrufen + mov ds,bp ;DS zurckholen + jnc ReMem ;kein Fehler ---> ReMem + + mov FehlerCode,ah ;Fehlercode merken + ;-- Speicher wieder auf alte Gre zurckfhren ----------------- + +ReMem: mov ax,TurboSeg ;Segmentadresse des Turbo-Codesegments + sub ax,10h ;auf Anfang des PSP setzen + mov es,ax ;und nach ES laden + mov bx,OldPara ;alte Anzahl Paragraphen + + mov ah,4Ah ;Funktionsnr. fr "Gre ndern" + int 21h ;DOS-Interrupt aufrufen + jnc GetBack ;kein Fehler ---> GetBack + + jmp Terminate ;Fehler bei ReMem, Prg. beenden + + ;-- das Programm wieder zurckholen ----------------------------- + +GetBack: cmp ToDisk,0 ;in EMS-Speicher schreiben? + je Ems1 ;JA ---> Ems1 + + call GetFromFile ;Nein, aus Datei zurckladen + jnc CloseUp ;kein Fehler ---> CloseUp + + jmp Terminate ;Fehler bei Lesen, Prg. beenden + +Ems1: call GetFromEms ;TP-Programm aus EMS-Speicher zurckholen + + ;-- alten Stack restaurieren ------------------------------------ + +CloseUp: cli ;Interrupts unterdrcken + mov ss,StackSeg + mov sp,StackPtr + sti ;Interrupts wieder zulassen + + ;-- Register zum Rcktauschen vorbereiten ----------------------- + + push cs ;DS auf CS setzen + pop ds + assume cs:code, ds:code + + mov cx,CoStLen ;Anzahl zu swappender Words + mov di,cx ;Anzahl der Words nach DI + dec di ;um ein Word dekrementieren + shl di,1 ;verdoppeln + mov si,di ;nach SI + add di,word ptr CostAddr ;DI + Offsetadr der Swap-Routinen + mov es,word ptr CostAddr + 2 ;ES auf altes CS der Swap-Routinen + mov ds,TurboSeg ;Segadr. des Code-Anfangs + + ret ;zurck zu SwapOutAndExec + +StartSwap endp + +;--------------------------------------------------------------------------- +;-- Write2Ems : Schreibt das auszulagernde Programm in den EMS-Speicher +;-- Eingabe : BX = die Segmentadresse des EMS-Page-Frames +;-- DS = Codesegment + +EMS_PLEN equ 16384 ;Lnge einer EMS-Page + +HiWLen dw ? ;Hi-Word verbleibende Lnge + +Write2Ems proc near + + push ds ;DS auf dem Stack sichern + cld ;bei Stringbefehlen aufwrts zhlen + mov es,bx ;ES zeigt auf den Page-Frame + + mov si,offset CodeEnd ;hier beginnt das Swapping + + mov bp,word ptr Len ;Lo-Word Lnge nach BP + mov ax,word ptr Len + 2 ;Hi-Word Lnge nach AX + mov HiWLen,ax ;und von dort in Variable + + mov dx,Handle ;EMS-Handle nach DX + xor bx,bx ;mit erster log. Page beginnen + + assume cs:code, ds:nothing + + jmp short WriECalc ;in die Schleife springen + +WriELoop: ;-- Registerbelegung innerhalb dieser Schleife ----------------- + ; + ; AX = mal dies, mal das + ; BX = Nummer der zu adressierenden logischen EMS-Page + ; CX = Anzahl zu kopierender Bytes in diesem Durchlauf + ; DX = EMS-Handle + ; ES:DI = Zeiger auf erste Page im EMS-Page-Frame (Ziel) + ; DS:SI = Zeiger auf erstes zu kopierendes Word (Start) + ; HiWLen:BP = Anzahl noch zu kopierender Bytes + + mov ax,4400h ;Funktionsnr fr Abbildung + int 67h ;EMM aufrufen + + mov si,offset CodeEnd ;Offset fr Swapping + xor di,di ;an den Anfang der EMS-Page schreiben + mov ax,cx ;Anzahl in AX merken + rep movsb ;Speicher kopieren + + sub bp,ax ;Restlnge um geschriebene Bytes + sbb HiWLen,0 ;dekrementieren + + inc bx ;Nummer der log. Page inkrementieren + + mov ax,ds ;Startsegment nach AX + add ax,EMS_PLEN shr 4 ;um die geschr. Paragraphen inkr. + mov ds,ax ;und wieder nach DS + +WriECalc: mov cx,EMS_PLEN ;EMS_PLEN Bytes schreiben + cmp HiWLen,0 ;mehr als 64 KByte? + ja WriELoop ;Ja ---> WriELoop + cmp bp,cx ;Nein, noch mehr als EMS_PLEN Bytes? + jae WriELoop ;Ja, weiterschreiben + mov cx,bp ;Nein, Restanzahl schreiben + or cx,cx ;keine Bytes mehr zu schreiben + jne WriELoop ;doch ---> WriELoop + +WriERet: pop ds ;DS vom Stack zurckholen + ret ;zurck zum Aufrufer + +Write2Ems endp + +;--------------------------------------------------------------------------- +;-- GetFromEms : Holt das ausgelagerte Programm aus dem EMS-Speicher zurck +;-- Eingabe : DS = Codesegment + +GetFromEms proc near + + push ds ;DS auf dem Stack sichern + cld ;bei Stringbefehlen aufwrts zhlen + + mov di,offset CodeEnd ;hier beginnt das Swapping + + mov bp,word ptr Len ;Lo-Word Lnge nach BP + mov ax,word ptr Len + 2 ;Hi-Word Lnge nach AX + mov HiWLen,ax ;und von dort in Variable + + mov dx,Handle ;EMS-Handle nach DX + xor bx,bx ;mit erster log. Page beginnen + + mov ds,FrameSeg ;DS zeigt auf den Page-Frame + push cs ;ES auf das Codesegment setzen + pop es + + assume cs:code, ds:nothing + + jmp short GetECalc ;in die Schleife springen + +GetELoop: ;-- Registerbelegung innerhalb dieser Schleife ----------------- + ; + ; AX = mal dies, mal das + ; BX = Nummer der zu adressierenden logischen EMS-Page + ; CX = Anzahl zu kopierender Bytes in diesem Durchlauf + ; DX = EMS-Handle + ; DS:SI = Zeiger auf erste Page im EMS-Page-Frame (Start) + ; ES:DI = Zeiger auf Zieladresse im Speicher + ; HiWLen:BP = Anzahl noch zu kopierender Bytes + + mov ax,4400h ;Funktionsnr fr Abbildung + int 67h ;EMM aufrufen + + mov di,offset CodeEnd ;Offset fr Swapping + xor si,si ;an den Anfang der EMS-Page schreiben + mov ax,cx ;Anzahl in AX merken + rep movsb ;Speicher kopieren + + sub bp,ax ;Restlnge um geschriebene Bytes + sbb HiWLen,0 ;dekrementieren + + inc bx ;Nummer der log. Page inkrementieren + + mov ax,es ;Startsegment nach AX + add ax,EMS_PLEN shr 4 ;um die geschr. Paragraphen inkr. + mov es,ax ;und wieder nach ES + +GetECalc: mov cx,EMS_PLEN ;EMS_PLEN Bytes schreiben + cmp HiWLen,0 ;mehr als 64 KByte? + ja GetELoop ;Ja ---> GetELoop + cmp bp,cx ;Nein, noch mehr als EMS_PLEN Bytes? + jae GetELoop ;Ja, weiterschreiben + mov cx,bp ;Nein, Restanzahl schreiben + or cx,cx ;keine Bytes mehr zu schreiben + jne GetELoop ;doch ---> GetELoop + +GetERet: pop ds ;DS vom Stack zurckholen + ret ;zurck zum Aufrufer + +GetFromEms endp + +;--------------------------------------------------------------------------- +;-- Write2File : Schreibt das auszulagernde Programm in eine Datei +;-- Rckgabe : Carry-Flag = 1 : Fehler + +Write2File proc near + +ANZ_WRITE = 2048 ;zu schreibende Bytes pro Durchlauf + ;2er Potenz, maximal 2^16 + assume cs:code, ds:code + + push ds ;DS auf dem Stack merken + mov bp,4000h ;Funktionsnr. fr "Schreiben" + mov bx,Handle ;Handle der Datei laden + +WriFStart: mov di,word ptr Len ;Lo-Word Lnge nach DI + mov si,word ptr Len + 2 ;Hi-Word Lnge nach SI + mov dx,offset CodeEnd ;Offsetadresse schreiben + jmp short WriFCalc ;Anzahl zu schreibender Bytes ber. + +WriFLoop: ;-- Registerbelegung innerhalb dieser Schleife ----------------- + ; + ; AX = mal dies, mal das + ; BX = DOS-Datei-Handle + ; CX = Anzahl der zu schreibenden/lesenden Bytes + ; DS:DX = Adresse, ab der geschrieben/gelesen wird + ; DI:SI = Anzahl der noch zu kopierenden Bytes + ; BP = Funktionsnummer der aufzurufenden DOS-Funktion + + mov ax,bp ;DOS-Funktionsnr. laden + int 21h ;DOS-Interrupt aufrufen + jc WriFEnd ;Fehler ---> WriFEnd + mov ax,ds ;Startsegment nach AX + add ax,ANZ_WRITE shr 4 ;um die geschr. Paragraphen inkr. + mov ds,ax ;und wieder nach DS + sub di,cx ;Restlnge um geschriebene Bytes + sbb si,0 ;dekrementieren + +WriFCalc: mov cx,ANZ_WRITE ;ANZ_WRITE Bytes schreiben + cmp si,0 ;mehr als 64 KByte? + ja WriFLoop ;Ja ---> WriFLoop + cmp di,cx ;Nein, noch mehr als ANZ_WRITE Bytes? + jae WriFLoop ;Ja, weiterschreiben + mov cx,di ;Nein, Restanzahl schreiben + or cx,cx ;keine Bytes mehr zu schreiben + jne WriFLoop ;doch ---> WriFLoop + +WriFEnd: pop ds ;DS zurckladen +WriFRet: ret ;zurck zum Aufrufer + +Write2File endp + +;--------------------------------------------------------------------------- +;-- GetFromFile : Ldt das ausgelagerte Progamm wieder in den Speicher +;-- Rckgabe : Carry-Flag = 1 : Fehler + +GetFromFile proc near + + assume cs:code, ds:code + + push ds ;DS auf dem Stack sichern + + ;-- File-Pointer an den Anfang der Datei bewegen ---------------- + + mov ax,4200h ;DOS-Funktionsnummer + mov bx,Handle ;Handle der Datei laden + xor cx,cx ;CX:DX geben die Position an + mov dx,cx ;(hier 0) + int 21h ;DOS-Interrupt aufrufen + jc WriFRet ;Fehler ---> WriFRet + + ;-- Datei mit HIlfe von Write2File in den Speicher laden -------- + + mov bp,3F00h ;Funktionsnr. fr "Lesen" + jmp WriFStart ;in die Write2File-Proz. springen + +GetFromFile endp + +;--------------------------------------------------------------------------- +;-- Terminate : es kann nicht mehr in das ursprngliche TP-Programm zurck- +;-- gekehrt werden. Programm mit Fehlercode beenden. + +Terminate label near + + ;-- Fehlermeldung ausgeben -------------------------------------- + + push cs ;DS auf CS setzen + pop ds + mov dx,offset TerMes ;DS:DX zeigt jetzt auf Fehlermeldung + mov ah,9 ;Funktionsnr. fr "String ausgeben" + int 21h ;DOS-Interrupt ausgeben + + mov ax,4C01h ;Programm mit Fehlercode beenden + int 21h + +;=========================================================================== + +CodeEnd equ this byte ;bis hier hin wird der Code an den Anfang + ;des TP-Programms kopiert + +;--------------------------------------------------------------------------- +;-- SwapOutAndExec : Lagert das aktuelle Programm in den EMS-Speicher oder +;-- auf Platte aus und startet dann ein anderes Programm +;-- ber die DOS-EXEC-Funktion +;-- Aufruf von TP: SwapOutAndExec( Command, +;-- CmdPara : string; +;-- ToDisk : boolean; +;-- Handle : word; +;-- Len : longint ); +;-- Info : Die Parameter Command und CmdPara mssen als Strings im +;-- DOS-Format vorliegen. + +SwapOutAndExec proc near + +ACommand equ dword ptr [bp+16] ;Konstanten zum Zugriff auf die +ACmdPara equ dword ptr [bp+12] ;bergebenen Argumente +AToDisk equ byte ptr [bp+10] +AHandle equ word ptr [bp+ 8] +ALen equ dword ptr [bp+ 4] +ARG_LEN equ 16 ;Lnge der Argumente + + assume cs:code, ds:data + + push bp ;Zugriff auf die Argumente ermglichen + mov bp,sp + ;-- Programmnamen in Puffer im Codesegment kopieren ------------- + + mov dx,ds ;DS merken + push cs ;ES auf CS setzen + pop es + + lds si,ACommand ;DS:SI zeigt auf Command-Puffer + mov di,offset PrgName ;ES:DI zeigt auf PrgName + cld ;bei Stringbefehlen aufwrts zhlen + lodsb ;Lnge des Pascal-Strings lesen + cmp al,64 ;mehr als 64 Zeichen? + jbe CmdCopy ;Nein ---> CmdCopy + + mov al,64 ;Ja, maximal 64 Zeichen kopieren + +CmdCopy: xor ah,ah ;Hi-Byte der Lnge auf 0 setzen + mov cx,ax ;und in den Counter laden + rep movsb ;String kopieren + + ;-- Kommandozeile in Puffer im Codesegment kopieren ------------- + + lds si,ACmdPara ;DS:SI zeigt auf CmdPara-Puffer + mov di,offset CmdBuf ;ES:DI zeigt auf CmdBuf + lodsb ;Lnge des Pascal-Strings lesen + cmp al,126 ;mehr als 126 Zeichen? + jbe ParaCopy ;Nein ---> ParaCopy + + mov al,126 ;Ja, maximal 126 Zeichen kopieren + +ParaCopy: stosb ;Lnge als erstes Byte speichern + xor ah,ah ;Hi-Byte der Lnge auf 0 setzen + mov cx,ax ;und in den Counter laden + rep movsb ;String kopieren + + mov al,0dH ;Carriage Return anhngen + stosb + + ;-- Dateinamen aus der Kommandozeile in FCBs bertragen --------- + + push cs ;CS nach DS bertragen + pop ds + + mov si,offset CmdBuf+1 ;DS:SI zeigt auf CmdBuf + 1 + mov di,offset FCB1 ;ES:DI zeigt auf FCB #1 + mov ax,2901h ;Funktionsnr.: "Dateinamen in FCB bertr." + int 21h ;DOS-Interrupt aufrufen + + mov di,offset FCB2 ;ES:DI zeigt jetzt auf FCB #2 + mov ax,2901h ;Funktionsnr.: "Dateinamen in FCB bertr." + int 21h ;DOS-Interrupt aufrufen + + mov ds,dx ;DS wieder mit alten Wert laden + + ;-- die brigen Parameter in Variablen bertragen --------------- + + les ax,ALen ;Lnge bearbeiten + mov word ptr Len + 2,es + mov word ptr Len,ax + + mov al,AToDisk ;Disk-Flag bearbeiten + mov ToDisk,al + + mov ax,AHandle ;Handle bearbeiten + mov Handle,ax + push ds ;DS auf dem Stack merken + + ;-- die Variablen und dem Programmcode zwischen den Labels ------ + ;-- CosdeStart und CodeEnd mit dem Inhalt des Codesegments hinter + ;-- dem PSP vertauschen + + mov ax,PrefixSeg ;ES:DI zeigt auf TP-Programm- + add ax,10h ;Anfang hinter PSP + mov TurboSeg,ax ;Adr. des TP-Codesegments merken + mov es,ax + xor di,di + + push cs ;DS auf CS setzen + pop ds + assume cs:code, ds:code + + mov si,offset CodeStart ;DS:SI zeigt auf CodeStart + and si,0FFF0h ;auf Paragraphen-Start abrunden + + mov cx,CostLen ;Anzahl zu swappender Words holen + mov word ptr CoStAddr,si ;Adresse von PARA(CodeStart) + mov word ptr CoStAddr + 2,ds ;merken + + mov dx,es ;Zielsegment in DX merken + cld ;bei Stringbefehlen SI/DI inkrementieren + + ;-- Tausch-Schleife --------------------------------------------- + +dl_loop: mov ax,[si] ;ein Word aus dem Ass-Modul laden + mov bx,es:[di] ;ein Word aus TP-Programm laden + stosw ;das Word aus Ass-Modul in TP-Prg. schr. + mov [si],bx ;das Word aus TP-Prg. in Ass-Modul schr. + inc si ;SI auf nchstes Word setzen + inc si ;(DI wurde durch STOSW inkrementiert) + loop dl_loop ;alle Words abarbeiten + ;-- Segmentadresse des Codesegments vor Aufruf der StartSwap- --- + ;-- Prozedur so anpassen, da sich die Variablenreferenzen auf + ;-- das Codesegment nicht ndern + + mov ax,offset CodeStart ;Anzahl der Paragraphen zwischen + mov cl,4 ;CodeStart und dem Anfang des Segments + shr ax,cl ;berechnen und von Segmentadresse in + sub dx,ax ;DX abziehen + + push cs ;Rcksprungadresse beim Label BACK + mov ax,offset back ;auf den Stack legen + push ax + + push dx ;Segmentadresse auf den Stack + mov ax,offset StartSwap ;Offsetadresse auf den Stack legen + push ax + + retf ;mir FAR-RET zu StartSwap springen + +back: ;---------------------------------------------------------------- + ;-- An diese Stelle kehrt das Programm erst zurck, nachdem der + ;-- Speicher ausgelagert, das angegebene Programm ausgefhrt + ;-- und der Speicher wieder eingeladen wurde. + ;-- Die einzelnen Register haben dann folgenden Inhalt: + ;-- DS:SI = Ende des Assembler-Codes hinter dem PSP + ;-- ES:DI = Ende des Turbo Codes in der SWAP-Unit + ;-- CX = Anzahl der Words + ;---------------------------------------------------------------- + + assume cs:code, ds:nothing + + std ;Stringbefehle dekrementieren SI/DI + + ;-- Rcktausch-Schleife ----------------------------------------- + +ul_loop: mov bx,es:[di] ;Byte aus altem Speicherber. holen + mov ax,[si] ;Byte aus akt. Speicherber. holen + mov [si],bx ;Byte aus altem in akt. Speicherber. + dec si ;SI auf vorhergehendes Wort setzen + dec si + stosw ;Byte aus akt. in alten Speicherber. + loop ul_loop ;wiederholen, bis Speicherber. vertauscht + pop ds ;DS vom Stack zurckholen + assume ds:data + + pop bp ;BP zurckholen + + ;-- hier mu nicht MOV SP,BP angegeben werden, weil SP nicht + ;-- verndert wurde + + xor ah,ah ;Fehlercode in AX zurckliefern + mov al,FehlerCode + + ret ARG_LEN ;zurck zum Aufrufer, dabei Argumente vom + ;Stack putzen + +SwapOutAndExec endp + +;--------------------------------------------------------------------------- +;-- InitSwapa : berechnet die Anzahl der Bytes bzw. Words, die Swap nach dem +;-- Auslagern des Programms am Anfang des TP-Programms im Spei- +;-- cher belegt +;-- Eingabe : keine +;-- Ausgabe : die Anzahl der Bytes +;-- Aufruf von TP: function InitSWapa : word; +;-- Info : Diese Prozedur mu vor dem ersten Aufruf von +;-- SwapOutAndExec aufgerufen werden! + +InitSwapa proc near + + assume cs:code, ds:data + + mov bx,offset CodeStart ;AX zeigt auf Anfang des Codes + and bx,0FFF0h ;auf Paragraphen-Start abrunden + mov ax,offset CodeEnd ;BX zeigt auf Endes des Codes + sub ax,bx ;Anzahl Bytes berechnen + inc ax ;CX in Words umwandeln + shr ax,1 + mov CoStLen,ax ;Anzahl zu swappender Words merken + shl ax,1 ;wieder in Bytes umwandeln + + ;-- der Inhalt von AX wird als Funktionsergebnis zurckgeliefert + + ret ;zurck zum Aufrufer + +InitSwapa endp + +;--------------------------------------------------------------------------- + +CODE ends ;Ende des Codesegments + end ;Ende des Programms diff --git a/UNITS/SWAPA.OBJ b/UNITS/SWAPA.OBJ new file mode 100644 index 0000000000000000000000000000000000000000..83816c17e7692a84300bbdac9f77f0e7ec0af0a3 GIT binary patch literal 1550 zcmb8veM}o=90%~%F6(O8VGBUU?Q2r7q(ytMwe{9Fwyxv(QW?WAG`LG zyZher{GR9To?OFfN>S>)`@E7@srs%_B%<}6fWM?#bSR2kRZ=PYMRBL>S1PJ~VvdyE z(YS`}3q?I2JanhqkBtUoTiQ6Ha{aKYrOimZ)8TQr-(N+~5OIvH)ua5aPL~VOqXkI@ z#uDLFN-5svau@E}?kb>z<;Q8uUO#|_sBkR`#u@1@Lu#XdQdO>v6KED;qGqE ziaP^f)K?Fc`vbl*u|9z2Vu>vK_QHmYQZ$Im`u_!$kw`#Kr-CGZBk1qb16cn98tR`?JiFaX0a4qw0wT=sBnowJPd8H8nRWT1vurFQD-pzcb8 zx~`RSzFHKbim8G*EtcCW&}$ribiOFb_ffm$n6ET8*zB55zM@ zgyq2+Ueb$6s3xJDv{Fyf@UYFR{wa$_Iluh3?2uk|=>N)IAiFBGlA6~}>gEpWt>G8b z)mYr>7cid&(q^)jf?rb)B?tec`gz-uGN(>rMwc<8C_Sxr%^6px(Eg_j^weV1oYAYX zb189alx>Mycc?#vFPT@x>MVmcwtPC*UdNrWXJ1vvuAhk2r4IJd>D&W|4xC!a&ZM0( zXAJby;8BXQjdAN>WM!{i8g=th*r?xkJ2kmY((x8j-N{mSD+yghNful%VS(h_LVu#* z{5Adkhc*+11&+eQ%POC#J{$?Hcf03qM2XJw(}}Fl&Cv&winm2ia>WyW;Ihhx))y5; z=5A!{&b}&jHnU-i{=o=dxfZSAvqtPw38|Z>sc%PO$IjDeiiaCbh5O)scnqF|o$wO8 z0;TX81fd16W=21PPhcK?!+J5pBk%;+kR<`u=jaPi2j`J@Lq2Q+)Q|0kJy33BELM$! c*Fj&X7$|laI^ZM>LJTGV3pBY2U+>z#05?}p9{>OV literal 0 HcmV?d00001 diff --git a/UNITS/TBAUM.PAS b/UNITS/TBAUM.PAS new file mode 100644 index 0000000..1ffce96 --- /dev/null +++ b/UNITS/TBAUM.PAS @@ -0,0 +1,1442 @@ +Unit TBaum; + +Interface +uses TUrfen,Dos,Crt,Tkvideo,Tkwin,Tkstring,Init,KBM,Tkdisk,Tkstream; + +Type + Baum = Object(Urfenster) + Constructor Init; + procedure Unselect; + procedure UnselectAll; + + function VerzNeu : boolean; virtual; + procedure VerzAkt; + function VerzRead (Var vpos:word; vtiefe:byte; vname: Pathstr) : boolean; + procedure VerzEinf (S:PathStr); + procedure VerzLosch(Var vpos :word); + function Verzlesen : pathstr; + + function Vjump (vpos,jump : word; up:boolean) : word; + function Vposition(pos : word) : word; + function Vdiff1(vpos1,vpos2 : word) : word; + function Vdiff2(vpos1,vpos2 : word) : word; + function VerzZoom : boolean; + + function Anpassen (var wanf: byte;var sanf,vpos : word): boolean; + procedure verwrite (m:boolean;Ypos,Vpos:word); + procedure Baumwrite(m:boolean;anf:word); + procedure vselect (Evpos:word); + procedure verselect(m:boolean;anf:word); + procedure Baummark (anf,ende: word); + + procedure VLoschen(Uv:boolean); virtual; + + function DriveRead(Var written: boolean) : boolean; + procedure DriveWrite(NewWritten:boolean); + procedure DriveDelete; + procedure DriveAkt; + + Destructor Done; + End{Baum}; + +Implementation + + Constructor Baum.Init; + begin + Urfenster.Init; + end; + + + + + function Baum.Vjump (vpos,jump :word; up:boolean) : word; + var diff,z : word; + begin + diff:=0;z:=0; + If Up then + begin + while (jump>diff) and (vpos+zdiff) and (vpos-z>1) do + begin + inc(z); + If dat.ver[vpos-z].Vopen then inc(diff); + end; + Vjump:=vpos-z; + end; + end; + + function Baum.Vdiff1(vpos1,vpos2 : word) : word; {Angabe der realen Position mit Erg abs.Breite} + var z,z1 : word; + begin + z:=vpos1; z1:=0; + while (zdat.veranz) then vpos:=dat.veranz; + + If vpos<1 then vpos:=1; + If (dat.ver[vpos].pos1) and (dat.ver[vpos].pos>=0) then + begin + If {(dat.ver[vpos].pos>(ebene-2)) and} (dat.ver[vpos].pos>0) then + wanf:=dat.ver[vpos].pos{-(ebene-2)} else wanf:=1; + Anpassen:=true; + end; + If (dat.ver[vpos].pos>wanf+(ebene-1)) then + begin + wanf:=dat.ver[vpos].pos-(ebene-1);Anpassen:=true; + end; + + If sanfvpos-(ydiff-3)) and (z>1) do + begin + dec(z); + If dat.ver[z].Vopen then dec(z1); + end; + sanf:=z; + + Anpassen:=true; + end; + end; + + If (vposdat.wanf+ebene-1)) and (dat.ver[Vpos].pos<>0) then exit; + If m then + textbackground(Balkenba) else textbackground(Winba); + If (dat.ver[Vpos+1].Vopen=false) and (Vposdat.ver[i].pos) or (i=dat.veranz+1) then + begin + lastdir:=true;break; + end; + If (dat.ver[numb].pos=dat.ver[i].pos) then + begin + lastdir:=false;break; + end; + inc(i); + until false; + inc(numb); + until dat.ver[i].Vopen or (i>=dat.veranz); + end; + + procedure senkline; + var k,t : word; + merk: byte; + st : string; + + begin + merk:=dat.ver[za].pos;st:=''; + If merk>(dat.wanf+ebene) then merk:=dat.wanf+ebene+1; + If merk1 then + for k:=za-1 downto 2 do + begin + If dat.ver[k].posdat.wanf+ebene then + t:=dat.wanf+ebene else t:=dat.ver[za].pos-1; + for k:=dat.wanf to t do + If (vernext[k]) then + st:=concat(st,lins,' ') else st:=concat(st,' '); + Zeile:=st; + writeXY(x,y,Zeile); inc(x,length(Zeile)); + { End } + end; + + begin + textcolor(Winfo); textbackground(Winba); + Unterfenster; + If dat.veranz=0 then + begin + clrwin; + writeXY(5,ydiff div 2, 'Keine Diskette im Laufwerk oder'); + writeXY(9,ydiff div 2+1,'Diskette nicht lesbar !'); + exit; + end; + vernext[1]:=false; AktMouY:=akty; + + zamax:=dat.sanf+Vdiff2(dat.sanf,dat.sanf+ydiff-3); + + za:=dat.sanf-1; + for zah:=dat.sanf to zamax do + begin + + repeat + inc(za); + until dat.ver[za].Vopen; + {EndIf} + + + Zeile:=''; + textcolor(Winfo);textbackground(Winba); + x:=1; y:=zah-dat.sanf+1; + + If za=dat.vpos then + begin + textcolor(LaufcuCol); + Zeile:=pad('',einschub-2); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + textcolor(Winfo); + end else + begin + Zeile:=pad('',einschub-2); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end; + + files:=0; k:=za; + repeat + inc(files,dat.ver[k].files); + inc(k); + until dat.ver[k].Vopen or (k>dat.veranz); + + If (files>0) then + begin + str(files,n); + Zeile:=padch(n,' ',5); + + If (dat.ver[za+1].Vopen=false) and (za 0 {za>1} then + begin + Zeile:=' '; + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end; + If dat.ver[za].pos > 0{za > 1} then senkline; + If (dat.ver[za].posdat.wanf) then + begin + if (dat.ver[za].pos=dat.ver[za+1].pos) and (dat.veranz>za) then + begin + Zeile:=concat(brl,linw); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end; + if (dat.ver[za].pos<>dat.ver[za+1].pos) or (dat.veranz=za) then + if lastdir(za) then + begin + Zeile:=concat(ule,linw); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end else + begin + Zeile:=concat(brl,linw); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end; + { End } + If dat.ver[za].pos=za)) or + ((anf>=za) and (dat.vpos<=za))) then + textbackground(Balkenba); + + Zeile:=pad(dat.ver[za].name,12); + + If (dat.ver[za+1].Vopen=false) and (za=za)) or + ((anf>=za) and (dat.vpos<=za))) then + textbackground(Balkenba); + + Zeile:=pad(dat.ver[za].name,12); + + writeXY(x,y,Zeile); inc(x,length(Zeile)); textbackground(Winba); + Zeile :=pad('',((ebene-1)-(dat.ver[za].pos-0{dat.wanf}))*3); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end else + + + If (dat.ver[za].pos+1=dat.ver[za+1].pos) and (dat.ver[za].pos+1=dat.wanf) then + begin + Zeile:=pad('',(ebene*3+15)); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end else + If (dat.ver[za].pos1) then + begin + Zeile:=pad('',(ebene*3+15)); + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end else + begin + Zeile:=' '; + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end; + end; + + Zeile:=pad('',Xdiff-X-1); {letzteSpalte fllen} + writeXY(x,y,Zeile); inc(x,length(Zeile)); + end; + + + inc(zamax); + while (zamax(ydiff-3) then + anf:=dat.sanf+(ydiff-3); + + If (dat.veranz>0) then + begin + If anfEvpos) then + verselect(false,dat.vpos); + + dat.vpos:=Evpos; + verselect(true,dat.vpos); + end; + + + procedure Baum.Baummark (anf,ende: word); + var bpos : word; + seite : boolean; + wanf : byte; + sanf,vpos : word; + begin + seite:=false; + If (ende < 1) or (anf < 1) then exit; + If ende-1 > dat.veranz then ende :=dat.veranz; + If ende < dat.sanf then seite:=true; + If ende > Vjump(dat.sanf,Vdiff2(dat.sanf,dat.sanf+ydiff-3),true) {(dat.sanf+ydiff-3)} then seite:=true; + If anf > Vjump(dat.sanf,Vdiff2(dat.sanf,dat.sanf+ydiff-3),true) {(dat.sanf+ydiff-3)} then + {anf :=dat.sanf+ydiff-2;} anf:=Vjump(dat.sanf,ydiff-2,true); + If anf < dat.sanf then + {anf :=dat.sanf-1;} anf:=Vjump(dat.sanf,1,false); + + If dat.vpos > dat.veranz then dat.vpos:=dat.veranz; + + If (dat.vpos<>ende) then + begin + wanf:=dat.wanf; + sanf:=dat.sanf; + bpos:=dat.vpos; + dat.vpos:=ende; + + + If (((dat.vpos>bpos) and (anf>bpos)) or + ((dat.vposdat.vpos) and (anfbpos) then + begin + dat.vpos:=Vjump(dat.vpos,1,false); verselect(false,bpos); dat.vpos:=Vjump(dat.vpos,1,true); + end; + verselect(true,dat.vpos); + end;{else} + + wanf:=dat.wanf; + sanf:=dat.sanf; + If (((bpos>dat.vpos) and (anf>=dat.vpos)) or + ((bpos=ev.spalterel))) or + ((ev.Ereignis=EV_KEY_PRESSED) and + ((ev.key=ord('+')) or (ev.key=ord('-')))) then + begin + VerzZoom:=true; + If (ev.Ereignis=EV_LEFT_PRESS) then Open:=not dat.ver[dat.vpos+1].Vopen; + If (ev.Ereignis=EV_KEY_PRESSED) then + If (ev.key=ord('+')) then Open:=true else Open:=false; + for z:=dat.vpos+1 to dat.veranz do + begin + If (dat.ver[z].pos-1=dat.ver[dat.vpos].pos) and Open then + dat.ver[z].Vopen:= Open; + If (dat.ver[z].pos>dat.ver[dat.vpos].pos) and not Open then + dat.ver[z].Vopen:= Open; + + If dat.ver[z].pos<=dat.ver[dat.vpos].pos then + break; + end; + BaumWrite(true,dat.vpos); + end else + VerzZoom:=false; + end; + + + function Baum.Verzlesen : pathstr; + var ver : pathstr; + gef : boolean; + VerStr: Ftemp; + + begin + ver:=''; gef:=false; + while not Filsel.Eof and not gef do + begin + Filsel.Read(VerStr,-1,1); + If Verstr.ver_dat then + begin + ver:=concat(ver,addbackslash(Verstr.name)); + end else + begin + If length(ver)>0 then + begin + gef:=true; Filsel.Seek(Filsel.Pos-1); + end else + Filsel.Seek(Filsel.Pos+Verstr.jump); + end; + end; + Verzlesen:=ver; + end; + + procedure Baum.unselect; + var Vsel : Ftemp; + Vind : Findex; + beg,en: word; + Fpos : longint; + Dseek : longint; + Laufw : char; + S : string; + begin + S:=fullpath(2); + Laufw:=S[1]; + If dat.ver_dat then + begin + for z:=1 to dat.veranz do + begin + dat.ver[z].select:=false; + dat.ver[z].files :=0; + dat.ver[z].selgr :=0; + end; + end else + begin + for z:=2 to dat.filanz do + begin + dat.ver[z].select:=false; + end; + end; + + Dseek:=0; + Filsel.Open; Filind.Open; + while not Filind.Eof do + begin + Filind.Read(Vind,-1,1); + If Dseek>0 then {Indexdatei anpassen} + begin + Vind.Fseek:=Vind.Fseek-Dseek; + Filind.Write(Vind,Filind.Pos-1,1); + end; + If (Vind.Lw=Laufw) then + begin + Fpos:=Vind.Fseek; + + repeat + dec(Fpos); {Verzeichnis} + Filsel.Read(Vsel,Fpos,1); + until not Vsel.ver_dat or (Fpos=0); + + beg:=Fpos+1; + + Fpos:=Vind.Fseek; + Filsel.Seek(Fpos); + + repeat + Filsel.Read(Vsel,-1,1); {Dateien} + until Filsel.Eof or Vsel.ver_dat; + + If Vsel.ver_dat then + en:=Filsel.Pos-1 else en:=Filsel.Pos; + + Filsel.Remove(beg,en-beg); + inc(Dseek,en-beg); + end; + + end; + + Filsel.Close; + + Filind.Seek(0); + Fpos:=Filind.Pos; + while not Filind.Eof do + begin + Filind.Read(Vind,-1,1); + If dat.ver[1].name[1]=Vind.Lw then + Filind.Remove(Filind.Pos-1,1); + end; + Filind.Close; + + For z:=1 to dat.veranz do + begin + dat.ver[z].selgr:=0; + dat.ver[z].files:=0; + dat.ver[z].select:=true; + dat.selgr:=0; + end; + DriveWrite(False); + + If not dat.ver_dat then + begin + for z:=2 to dat.filanz do + dat.fil[z].select:=false; + end; + + end; + + +procedure Baum.UnselectAll; +var z : word; + written: boolean; +begin + for z:=1 to dat.veranz do + begin + dat.ver[z].select:=false; + dat.ver[z].files :=0; + dat.ver[z].selgr :=0; + end; + + If not dat.ver_dat then + for z:=2 to dat.filanz do + begin + dat.fil[z].select:=false; + end; + + + Filind.Open; + Filind.Remove(0,Filind.Size); + Filind.Close; + + Filsel.Open; + Filsel.Remove(0,Filsel.Size); + Filsel.Close; + + Drive.Open; + while not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + for z:=1 to Lver.veranz do + begin + If Fmod=Links then + begin + Lver.ver[z].leftselect:=false; + Lver.ver[z].leftfiles :=0; + Lver.ver[z].leftselgr :=0; + end; + If Fmod =Rechts then + begin + Lver.ver[z].rightselect:=false; + Lver.ver[z].rightfiles :=0; + Lver.ver[z].rightselgr :=0; + end; + + end{For}; + + Drive.Write(Lver,Drive.Pos-1,1); + end{While}; + Drive.Close; + +end; + + +procedure Baum.DriveAkt; +var lw : DrRec; + Laufw : char; +begin + Laufw:=dat.ver[1].name[1]; + lw.Dr:=dat.ver[1].name[1]; + DriveKind(lw); + If lw.Ch[1] in ['0','1'] then + begin + Drive.Open; + while not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + If (Laufw=Lver.drive) and (length(dat.aktverz)>0) then + begin + If (Fmod = Links) then + begin + Lver.leftsanf := dat.sanf; + Lver.leftwanf := dat.wanf; + Lver.leftvpos := dat.vpos; + Lver.dfree := dat.dfree; + Lver.dsize := dat.dsize; + end; + If (Fmod =Rechts) then + begin + Lver.rightsanf := dat.sanf; + Lver.rightwanf := dat.wanf; + Lver.rightvpos := dat.vpos; + Lver.dfree := dat.dfree; + Lver.dsize := dat.dsize; + end; + + Drive.Write(Lver,Drive.Pos-1,1); + break; + end; + end; + Drive.Close; + end; +end; + + + +function Baum.DriveRead(Var written :boolean) : boolean; +var z : word; + lw : DrRec; + Laufw : char; +begin + Driveread := false; + Laufw:=dat.ver[1].name[1]; + lw.Dr:=dat.ver[1].name[1]; + DriveKind(lw); + written:=false; + If lw.Ch[1] in ['0','1'] then + begin + Drive.Open; + while not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + If Laufw=Lver.Drive then + begin + for z:=1 to Lver.veranz do + begin + dat.ver[z].name :=Lver.ver[z].name; + dat.ver[z].pos :=Lver.ver[z].pos; + dat.ver[z].Vart :=Verzeichnis; + If Fmod=Links then + begin + If not Lver.leftwritten then + begin + dat.ver[z].Vopen :=Lver.ver[z].rightVopen; + end else + begin + dat.ver[z].select:=Lver.ver[z].leftselect; + dat.ver[z].files :=Lver.ver[z].leftfiles; + dat.ver[z].selgr :=Lver.ver[z].leftselgr; + dat.ver[z].Vopen :=Lver.ver[z].leftVopen; + end; + + end; + If Fmod =Rechts then + begin + If not Lver.rightwritten then + begin + dat.ver[z].Vopen :=Lver.ver[z].leftVopen; + end else + begin + dat.ver[z].select:=Lver.ver[z].rightselect; + dat.ver[z].files :=Lver.ver[z].rightfiles; + dat.ver[z].selgr :=Lver.ver[z].rightselgr; + dat.ver[z].Vopen :=Lver.ver[z].rightVopen; + end; + end; + end{For}; + dat.veranz :=Lver.veranz; + dat.dfree :=Lver.dfree; + dat.dsize :=Lver.dsize; + If (Fmod = Links) then + begin + If Lver.leftwritten then + begin + dat.vpos := Lver.leftvpos; + dat.sanf := Lver.leftsanf; + dat.wanf := Lver.leftwanf; + end else + begin + dat.vpos := Lver.rightvpos; + dat.sanf := Lver.rightsanf; + dat.wanf := Lver.rightwanf; + end; + written:=Lver.leftwritten; + end; + If (Fmod =Rechts) then + begin + If Lver.rightwritten then + begin + dat.vpos := Lver.rightvpos; + dat.sanf := Lver.rightsanf; + dat.wanf := Lver.rightwanf; + end else + begin + dat.vpos := Lver.leftvpos; + dat.sanf := Lver.leftsanf; + dat.wanf := Lver.leftwanf; + end; + + written:=Lver.rightwritten; + end; + If (Fmod=Links) and not written then + begin + UnselectAll; dat.ver_dat:=true; + end; + If (Fmod=Rechts) and not written then + begin + UnselectAll; dat.ver_dat:=true; + end; + DriveRead:=true; + + break; + end{IF}; + end{While}; + Drive.Close; + end else + for z:=1 to dat.veranz do + dat.ver[z].Vopen := true; + {EndIf}; + + Drive.Open; + while not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + If (Laufw=Lver.drive) then + begin + If (Fmod = Links) and not Lver.leftwritten then + begin + Lver.leftsanf := dat.sanf; + Lver.leftwanf := dat.wanf; + Lver.leftvpos := dat.vpos; + Lver.leftwritten := true; + end; + If (Fmod =Rechts) and not Lver.Rightwritten then + begin + Lver.rightsanf := dat.sanf; + Lver.rightwanf := dat.wanf; + Lver.rightvpos := dat.vpos; + Lver.rightwritten := true; + end; + Drive.Write(Lver,Drive.Pos-1,1); + break; + end; + end; + Drive.Close; + +end; + + + +procedure Baum.DriveWrite(NewWritten:boolean); +var z : word; + lw : DrRec; + wr : boolean; + Laufw :char; +begin + wr:=false; + Laufw:=dat.ver[1].name[1]; + lw.Dr:=dat.ver[1].name[1]; + DriveKind(lw); + If lw.Ch[1] in ['0','1'] then + begin + Drive.Open; + while not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + If (Laufw=Lver.drive) then + begin + for z:=1 to dat.veranz do + begin + Lver.ver[z].name :=dat.ver[z].name; + Lver.ver[z].pos :=dat.ver[z].pos; + If Fmod=Links then + begin + Lver.ver[z].leftselect:=dat.ver[z].select; + Lver.ver[z].leftfiles :=dat.ver[z].files; + Lver.ver[z].leftselgr :=dat.ver[z].selgr; + Lver.ver[z].leftVopen :=dat.ver[z].Vopen; + end; + If Fmod =Rechts then + begin + Lver.ver[z].rightselect:=dat.ver[z].select; + Lver.ver[z].rightfiles :=dat.ver[z].files; + Lver.ver[z].rightselgr :=dat.ver[z].selgr; + Lver.ver[z].rightVopen :=dat.ver[z].Vopen; + end; + end; + Lver.veranz := dat.veranz; + Lver.dfree := dat.dfree; + Lver.dsize := dat.dsize; + If Fmod = Links then + begin + Lver.leftsanf := dat.sanf; + Lver.leftwanf := dat.wanf; + Lver.leftvpos := dat.vpos; + Lver.leftwritten := True; + If NewWritten then + Lver.rightwritten:=False; + end; + + If Fmod =Rechts then + begin + Lver.rightsanf := dat.sanf; + Lver.rightwanf := dat.wanf; + Lver.rightvpos := dat.vpos; + Lver.rightwritten := True; + If NewWritten then + Lver.leftwritten:=False; + end; + + wr:=true; + Drive.Write(Lver,Drive.Pos-1,1); + end{If}; + end;{While} + If not wr then + begin + for z:=1 to dat.veranz do + begin + Lver.ver[z].name :=dat.ver[z].name; + Lver.ver[z].pos :=dat.ver[z].pos; + If Fmod=Links then + begin + Lver.ver[z].leftselect:=dat.ver[z].select; + Lver.ver[z].leftfiles :=dat.ver[z].files; + Lver.ver[z].leftselgr :=dat.ver[z].selgr; + Lver.ver[z].leftVopen :=dat.ver[z].Vopen; + Lver.leftwritten := True; + If NewWritten then + Lver.ver[z].rightVopen:=true; + end; + If Fmod =Rechts then + begin + Lver.ver[z].rightselect:=dat.ver[z].select; + Lver.ver[z].rightfiles :=dat.ver[z].files; + Lver.ver[z].rightselgr :=dat.ver[z].selgr; + Lver.ver[z].rightVopen :=dat.ver[z].Vopen; + Lver.rightwritten := True; + If NewWritten then + Lver.ver[z].leftVopen:=true; + end; + end; + Lver.drive := dat.ver[1].name[1]; + Lver.veranz := dat.veranz; + Lver.dfree := dat.dfree; + Lver.dsize := dat.dsize; + If Fmod = Links then + begin + Lver.leftsanf := dat.sanf; + Lver.leftwanf := dat.wanf; + Lver.leftvpos := dat.vpos; + Lver.rightwritten := not NewWritten; + end; + If Fmod =Rechts then + begin + Lver.rightsanf := dat.sanf; + Lver.rightwanf := dat.wanf; + Lver.rightvpos := dat.vpos; + Lver.leftwritten := not NewWritten; + end; + + Drive.Write(Lver,-1,1); + end; + Drive.Close; + end{If}; +end; + + +procedure Baum.DriveDelete; +begin + Unselect; + Drive.Open; + while not Drive.Eof do + begin + Drive.Read(Lver,-1,1); + If dat.ver[1].name[1]=Lver.Drive then + begin + Drive.Remove(Drive.Pos-1,1); + break; + end; + end; + Drive.Close; + +end; + + + +function Baum.VerzNeu : boolean; +var vp,vanz : word; + written : boolean; + + procedure DatReset; + begin + dat.veranz:=0; + dat.gesamtdat:=0; + dat.gesamtgr:=0; + dat.dfree:=0; + dat.dsize:=0; + dat.selgr:=0; + dat.ver[0].pos:=0; + dat.ver[0].Vopen:=true; + dat.ver[1].pos :=0; + dat.ver[1].selgr :=0; + dat.ver[1].files :=0; + dat.ver[1].select:=false; + dat.ver[1].Vopen :=True; + dat.ver[1].Vart :=Verzeichnis; + end; + + +begin + vanz:=1; DatReset; + + VerzNeu:=true; + If not DriveRead(written) then + begin + If not VerzRead(vanz,1,dat.ver[1].name) then + begin {Keine Diskette im Laufwerk} + VerzNeu:=false; + dat.vpos:=1; + dat.ver_dat:=true; + exit; + end; + dat.ver[vanz+1].pos:=0; dat.veranz:=vanz; + + If length(dat.aktverz)=0 then {Verzeichnis suchen} + begin + getver(DrvLet_Num(dat.ver[1].name[1]),dat.aktverz); + for vp:=1 to dat.veranz do + begin + If dat.aktverz=fullpath(vp) then + begin + dat.sanf:=vp; + dat.vpos:=vp; + If dat.ver[vp].pos>ebene then dat.wanf:=dat.ver[vp].pos else dat.wanf:=1; + break; + end; + end; + end; + + DriveWrite(True); + end{If} else + begin + chver(dat.ver[1].name[1]+':'); + end; + + + If not written then + begin + Anpassen(dat.wanf,dat.sanf,dat.vpos); + DriveAkt; + end; + + {If not (Doserror in [0,18]) then DatReset; + Doserror:=0;} +end; + + +procedure Baum.VerzAkt; +var z,w : word; +begin + UnselectAll; + z:=dat.vpos; + while (dat.ver[z+1].pos > dat.ver[z].pos) and (dat.veranz>z) do + begin + dec(dat.veranz); + For w:=z+1 to dat.veranz do + begin + dat.ver[w]:=dat.ver[w+1]; + end; + end; + + If VerzRead(z,dat.ver[dat.vpos].pos+1, dat.aktverz) then + DriveWrite(True); +end; + + + +function Baum.VerzRead(var vpos :word; vtiefe: byte; vname: Pathstr) : boolean; +var vername : array [0..vertiefe] of FileNameStr; + drv : string[2]; + enter, + ende : boolean; + verstr : pathstr; + tiefe : byte; + w : word; + Verzmerk: pathstr; +begin + Verzread:=false; + If not openwindow(31,5,fenfo,fenba,'Lesen') then exit; + textcolor(MessageCol); + enter:=true;ende:=false;drv:=dat.ver[1].name; + tiefe:=vtiefe; + writeXY(3,2,'Lese die Verzeichnisstruktur'); + writeXY(9,3,concat('auf Laufwerk ',drv,' !')); + getver(DrvLet_Num(vname[1]),Verzmerk); + If chver(vname) then + begin + Verzread:=true; + repeat + If enter then + begin + dat.ver[vpos].select:=false; + {findFirst('*.*', $37, DirInfo);} + findFirst('*.*', $10, DirInfo); { Anfang } + while (((Dirinfo.name= '.') or (Dirinfo.name='..')) + and ($10=(dirinfo.attr and $10))) and (doserror=0) do + begin { Info } + (*If (Dirinfo.name<> '.') and (Dirinfo.name<>'..') and (doserror=0) and + (((dirinfo.attr and m_attrib)>0) and (not ((dirinfo.attr and $18) in[$10,$8])) or (Dirinfo.attr=0)) then + begin} + {inc(dat.gesamtdat); + inc(dat.gesamtgr,Dirinfo.size);} + {for l:=1 to Lendg.fanz do + If compend(Lendg.en[l],dirinfo.name) then + dat.ver[vpos].leftselect:=(dirinfo.name<>'..') and (dirinfo.name<>'');} + {for l:=1 to Rendg.fanz do + If compextension(Rendg.en[l],dirinfo.name) then + begin + dat.ver[vpos].rightselect:=true; break; + end;} + end;*) + findnext(DirInfo); + end{While}; + vername[tiefe]:=Dirinfo.name; + end else + begin + {findFirst('*.*', $37, DirInfo);} + findFirst('*.*', $10, DirInfo); { Weiter } + while (Dirinfo.name<>vername[tiefe]) and (Doserror=0) do + findnext(DirInfo); + If Doserror=0 then + repeat + findnext(dirinfo); { Info } + (*If (doserror=0) and (((dirinfo.attr and m_attrib)>0) and + (not ((dirinfo.attr and $18) in[$10,$8])) or (Dirinfo.attr=0))}then + begin + {inc(dat.gesamtdat); + inc(dat.gesamtgr,Dirinfo.size);} + {for l:=1 to Lendg.fanz do + If compextension(Lendg.en[l],dirinfo.name) then} + {If (dirinfo.name<>'..') and (dirinfo.name<>'') then + for zah:=vpos downto 1 do + If dat.ver[zah].pos=tiefe-1 then + begin + dat.ver[zah].leftselect:=true; break; + end;} + {for l:=1 to Rendg.fanz do + If compextension(Rendg.en[l],dirinfo.name) then + for zah:=vpos downto 1 do + If dat.ver[zah].pos=tiefe-1 then + begin + dat.ver[zah].rightselect:=true; break; + end;} + end;*) + until ($10=(dirinfo.attr and $10)) or (doserror>0); + {End IF} + vername[tiefe]:=Dirinfo.name; + end; + + If (doserror>0) then + begin + ende:=true; + If tiefe > vtiefe then { Exit } + begin + chver('..'); + dec(tiefe); + Enter:=false;ende:=false; + end; + + + end else + begin + {$I-}chdir(vername[tiefe]);{I+} { Enter } + If ioresult=0 then + begin + If dat.veranz>=vpos then { Einfgen } + begin + For w:=dat.veranz downto vpos do + begin + dat.ver[w+1]:=dat.ver[w]; + end; + inc(dat.veranz); + end; + verstr:=Fexpand(''); + inc(vpos);textcolor(fenfo);writeXY(11,5,center(vername[tiefe],12)); + dat.ver[vpos].name:=vername[tiefe]; + dat.ver[vpos].pos :=tiefe; + dat.ver[vpos].select:=false; + dat.ver[vpos].files:=0; + dat.ver[vpos].selgr:=0; + dat.ver[vpos].Vopen:=True; + dat.ver[vpos].Vart :=Verzeichnis; + inc(tiefe); + Enter:=true; + ende:=false; + If vpos+1>veranz then break; + end else + Enter:=false; + end; + until (tiefe=vtiefe) and ende or not (Doserror in [0,18]); + dat.dfree:=diskfree(0); dat.dsize:=disksize(0); + chver(Verzmerk); + end; + + {EndIF} + closewindow; +end; + + +procedure Baum.VerzEinf(S:PathStr); +var Z,Z2 : word; + vpos : byte; + Vname: FilenameStr; + new_vpos:word; +begin + new_vpos:=dat.vpos; + If Mkver(S) and (Veranz>dat.veranz) then + begin + Vname:=justfilename(S); + S:=justpathname(S); + If length(S)>3 then delete(S,length(S),1); + For z:=1 to dat.veranz do + If fullpath(z)= S Then + begin + vpos:=dat.ver[z].pos; + + while (zDirectory) and + ((not ((dirinfo.attr and $18) in[$10,$8])) or (Dirinfo.attr=0)) then + begin + DelFile.Init((concat(addbackslash(P),Dirinfo.Name)),1); + DelFile.DelFile; + DelFile.Done; + end; + findnext(Dirinfo); + + end; + Doserror:=0; + end; + +begin + If not openwindow(31,4,fenfo,fenba,'Lschen') then exit; + writeXY(6,2,'Lsche Verzeichnis...'); + chver(dat.ver[1].name); + If Uv then + begin + z:=dat.vpos; + while (dat.ver[dat.vpos].posdat.vpos do + begin + P:=fullpath(z); + writeXY(1,4,center(justfilename(P),31)); + DatLoschen(P); + If RmVer(P) then + begin + VerzLosch(z); + end; + dec(z); + end; + P:=fullpath(dat.vpos); + writeXY(1,4,center(justfilename(P),31)); + DatLoschen(P); + end; + + P:=fullpath(dat.vpos); + rm_dir:=RmVer(P); + closewindow; + If rm_dir then + begin + rm_vpos:=dat.vpos; + {vselect(Vjump(dat.vpos,1,false));} + verselect(false,dat.vpos); + dat.vpos:=Vjump(dat.vpos,1,false); + verselect(false,dat.vpos); + VerzLosch(rm_vpos); + end; + Drivewrite(True); +end; + + + + +Destructor Baum.Done; +begin +end; + +begin +end. \ No newline at end of file diff --git a/UNITS/TCONTROL.PAS b/UNITS/TCONTROL.PAS new file mode 100644 index 0000000..fe11089 --- /dev/null +++ b/UNITS/TCONTROL.PAS @@ -0,0 +1,579 @@ +UNIT TControl; + +Interface +uses Init,TFunktion,Tkstream,KBM,Tkstring,Tkwin,Crt,Tkview,Tkvideo,Dos,Tkdisk; +Type + Control = Object(Funktion) + Constructor Init( SMode : FensterModeR; Datname,Datindex : FilenameStr; xa:byte); + procedure Drahmen (paint :boolean); + procedure Fenakt (Rahmen,VerzL,DatL:boolean); + procedure Fenster; + Destructor Done; + End{Control}; + + + + +Implementation + +Constructor Control.Init( Smode : FensterModeR; Datname,Datindex : FilenameStr; xa:byte); +begin + einschub:=3; xanf:=xa ; einmal:=true; Fmod:=SMode; + yanf:=4; ydiff:=(crtymax-3)-yanf; xdiff:=(crtxmax DIV 2); ebene:=(xdiff-24) Div 3; + Readendg; + Filsel.Init (concat(addbackslash(m_tempverz),Datname),SizeOf(Ftemp)); + Filind.Init (concat(addbackslash(m_tempverz),Datindex),SizeOf(Findex)); + Filsel.Create; Filsel.Close; + Filind.Create; Filind.Close; + Funktion.Init; +end; + + + +procedure Control.Fenakt(Rahmen,VerzL,DatL : boolean); +begin + + Drahmen(Rahmen); + + If not (Fmod=Archiv) and (dat.veranz>0) and + (VerzL or DatL ) then + begin + dat.dfree:=diskfrei(DrvLet_Num(dat.ver[1].name[1])); + DriveAkt; + end; + + If VerzL then + begin + VerzNeu; + end; + + If DatL and not dat.ver_dat then + begin + Dateiread(dat.vpos); + end; + + If (not dat.ver_dat) and (dat.veranz>0) then + begin + {Anpassen(dat.wanf,dat.sanf,dat.vpos);} + fullsort(m_sort); DateienWrite(false,dat.fpos); Pfeilwrite(false,dat.vpos); + end else + begin + Anpassen(dat.wanf,dat.sanf,dat.vpos); BaumWrite(false,dat.vpos); Pfeilwrite(false,dat.vpos); + end; + {UnterFenster;} +end; + +procedure Control.Fenster; +type Sel = Record + Manf :word; + Msel :boolean; + end; +var k : word; + Er : boolean; + auha : boolean; + ev2 : Event; + M : Sel; + Right_Pr,Left_Pr, + Midd_Pr : boolean; +begin + Drahmen(True); + + If dat.ver_dat then + verselect(true,dat.vpos) else + datselect(true,dat.fpos); + weiter:=false; Aktber:=1; + Left_Pr:=false; Right_Pr:=false; Midd_Pr:=false; + ev1.ctrlcode:=0; + If ev1.Ereignis>0 then begin er:=true; ev:=ev1; end else er:=false; + ev1.Ereignis:=0; + repeat + auha:=true; + If not er then + begin + KbClrevent; KbmEventWait( EV_ALL, ev ); + end else er:=false; + + + case ev.Ereignis of + EV_LEFT_PRESS :begin + If (ev.Buttons=1) then + begin + Left_Pr:=true; Midd_Pr:=false; + Akber:=AktBer; + case AktBer of + 1 : begin + If ev.zeilerel0 then + begin + vselect(Vposition(ev.zeilerel)); + If Doppelklick then + begin + If (dat.vpos=1) and (Fmod=Archiv) then + begin {Archiv heraus} + weiter:=true; Ftaste:=CR; + end else + If not VerzZoom then + If DateiRead(dat.vpos) then + begin + dat.ver_dat:=false; + DateienWrite(true,dat.fpos); + end; + end; + end; + end else + begin + Dselect(dat.fanf+ev.zeilerel); + If Doppelklick then + begin + ev.ctrlcode:=CR; + end; + end; + end; + end; + 2 : begin + ev.ctrlcode:=TAB; ev1:=ev; + end; + end; + auha:=false; + If (ev.ZeileAbs+1ydiff+1) then + auha:=true; + If (ev.ZeileAbs+11) and (aktber<>2) then + begin + ev.ctrlcode:=CPGUP; + end; + If (ev.ZeileAbs+1>ydiff+yanf-2) and (ev.ZeileAbs+12) then + begin + ev.ctrlcode:=CPGDN; + end; + end else + begin + Midd_Pr:=true; + If Right_Pr then + If dat.ver_dat then + begin Treemark(m.manf); end else Filmark(m.manf); + Right_Pr:=false; + end; + end; + EV_LEFT_REL : begin + If (ev.Buttons=0) and not Midd_Pr then + begin + If not Right_Pr and (ev.zeileAbsydiff-2) then auha:=true; + Left_Pr:=false; + end; + If ev.Buttons=0 then Midd_Pr:=false; + end; + EV_RIGHT_PRESS : begin + If (ev.Buttons=2) then + begin + Right_Pr:=true; Midd_Pr:=false; + Akber:=AktBer; m.manf:=0; + case AktBer of + 1 : begin + If ev.zeilerel0 then + begin + vselect(Vposition(ev.ZeileRel)); + m.manf:=dat.vpos; + end; + end else + begin + Dselect(dat.fanf+ev.zeilerel); + m.manf:=dat.fpos; + end; + end; + end; + 2 : begin + ev.ctrlcode:=TAB; ev1:=ev; + end; + end; + auha:=false; + If (ev.ZeileAbs+1ydiff+1) then + auha:=true; + end else + begin + Midd_Pr:=true; Left_Pr:=false; + end; + end; + EV_RIGHT_REL: begin + If (ev.Buttons=0) and not Midd_Pr then + begin + If Left_Pr and (ev.zeileAbsydiff-2) then auha:=true; + If Right_Pr then + If dat.ver_dat then + begin Treemark(m.manf); end else Filmark(m.manf); + Right_Pr:=false; + end; + If ev.Buttons=0 then Midd_Pr:=false; + end; + EV_MOU_MOVE : begin + case aktber of + 1 : begin + If (ev.zeileAbs>yanf-2) and (ev.zeileAbs0 then + begin + If dat.ver_dat then + begin + If (dat.vpos=1) and (Fmod = Archiv) then + begin {Archiv heraus} + weiter:=true; Ftaste:=CR; + end else + If DateiRead(dat.vpos) then + begin + dat.ver_dat:=false; + DateienWrite(true,dat.fpos); + end; + end else + If dat.fil[dat.fpos].name='.' then + begin + If change then PackdateiWrite(dat.vpos); + dat.ver_dat:=true; + BaumWrite(true,dat.vpos); + end else + If (Fmod=Rechts) then {Archiv hinein} + begin + weiter:=true; Ftaste:=CR; + end; + end; + end; + SPACE: begin + If dat.ver_dat then + begin + treemark(dat.vpos); vselect(Vjump(dat.vpos,1,true)); + end else + begin + filmark(dat.fpos); dselect(dat.fpos+1); + end; + end; + CUP: begin { Hoch } + If dat.ver_dat then + begin + vselect(Vjump(dat.vpos,1,false)); + end else + begin + dselect(dat.fpos-1); + end; + end; + CDOWN: begin { Down } + If dat.ver_dat then + begin + vselect(Vjump(dat.vpos,1,true)); + end else + begin + dselect(dat.fpos+1); + end; + end; + CPGUP: begin { PgUp } + If dat.ver_dat then + begin + If Vdiff1(1,dat.vpos)>=(ydiff-2) then vselect(Vjump(dat.vpos,ydiff-2,false)) else vselect(1); + end else + begin + If dat.fpos>ydiff-2 then dselect(dat.fpos-(ydiff-2)) else dselect(1); + end; + end; + CPGDN: begin { PgDn } + If dat.ver_dat then + begin + If Vdiff1(dat.vpos,dat.veranz)>=(ydiff-2) then + vselect(Vjump(dat.vpos,(ydiff-2),true)) else + vselect(Vjump(dat.vpos,Vdiff1(dat.vpos,dat.veranz),true)); + end else + begin + dselect(dat.fpos+(ydiff-2)); + end; + end; + CLEFT: begin { Links } + If dat.ver_dat then + For k:=dat.vpos-1 downto 1 do + begin + If (dat.ver[dat.vpos].pos>dat.ver[k].pos) then break; + If (dat.ver[dat.vpos].pos=dat.ver[k].pos) then + begin + vselect(k); + break; + end; + end; + end; + CRIGHT: begin { Rechts } + IF dat.ver_dat then + For k:=dat.vpos+1 to dat.veranz do + begin + If (dat.ver[dat.vpos].pos>dat.ver[k].pos) then break; + If (dat.ver[dat.vpos].pos=dat.ver[k].pos) then + begin + vselect(k); + break; + end; + end; + end; + CHOME: begin { Home } + If dat.ver_dat then + begin + vselect(1); + end else + begin + dselect(1); + end; + end; + CEND: begin { End } + If dat.ver_dat then + begin + vselect(Vjump(dat.vpos,Vdiff1(dat.vpos,dat.veranz),true)); + end else + begin + dselect(dat.filanz); + end; + end; + INSERTKEY: begin { Ins } + If dat.ver_dat then + begin + treemark(dat.vpos); + vselect(Vjump(dat.vpos,1,true)); + end else + begin + filmark(dat.fpos); dselect(dat.fpos+1); + end; + end; + TAB: begin + Ftaste:=TAB;weiter:=true; + end; + ord('+'): begin + If dat.ver_dat then + VerzZoom else + Selendg (true) + end; + ord('-'): begin + If dat.ver_dat then + VerzZoom else + Selendg (false); + end; + ord('*'): begin + Selrev; + end; + CTRL_R : begin + weiter:=true; Ftaste:=CTRL_R; + end; + End{Case}; + + + + + ev2.Ereignis:=0; + while ((ev.ZeileAbs+1yanf+ydiff-3)) and + (Right_Pr xor Left_Pr) and (ev2.Ereignis=0) and (ev.Ereignis=1) and auha do + begin + KbmPeekEvent( ev2 ); + If ev2.Ereignis<>0 then break; + If (ev.ZeileAbs+1yanf+ydiff-3) then {Down} + begin + If Left_Pr then + begin + If dat.ver_dat then + vselect(Vjump(dat.vpos,1,true)) else + dselect(dat.fpos+1); + end; + If (Right_Pr) then + begin + If dat.ver_dat then + begin + Baummark(m.manf,Vjump(dat.vpos,1,true)); + end else + begin + datmark(m.manf,dat.fpos+1); + end; + end; + End; + end;{While} + + + If auha then + begin + Laufwerk (false); + Funktionen(false); + end; + + + + until weiter; + + If dat.ver_dat then + begin + If (dat.veranz>0) then + begin + verselect(false,dat.vpos); textbackground(Winba); + textcolor(LaufCuCol); writeXY(1,Vdiff1(dat.sanf-1,dat.vpos),''); + end; + end else datselect(false,dat.fpos); + If (Ftaste=TAB) or (AkBer=2) then Drahmen(false); + + {If not ((Ftaste=CR) and ((Fmod=Rechts) or (Fmod=Archiv))) then + window(Lo(wmi)+1,Hi(wmi)+1,Lo(wma)+1,Hi(wma)+1);} +end; + + + +procedure FensterRahmen(x1,y1,x2,y2:byte;Kopf:string;Rahmen:boolean); +var wlinwo,wlinwu,wlinsl, wlinsr, wole, wore, wule, wure: string[1]; + i : byte; + KopfPos : byte; +begin + + If Rahmen then + begin + {wlinwo:=blinwo; + wlinwu:=blinwu; + wlinsl:=blinsl; + wlinsr:=blinsr; + wole:=blinwo; + wore:=blinwo; + wule:=blinwu; + wure:=blinwu;} + wlinwo:=dlinw; + wlinwu:=dlinw; + wlinsr:=dlins; + wlinsl:=dlins; + wole:=dole; + wore:=dore; + wule:=dule; + wure:=dure; + end else + begin + wlinwo:=linw; + wlinwu:=linw; + wlinsr:=lins; + wlinsl:=lins; + wole:=ole; + wore:=ore; + wule:=ule; + wure:=ure; + end; + writexy(x1,y2,wule); + writexy(x2,y1,wore); + writexy(x1,y1,wole); + writexy(x2,y2,wure); + for i:=1 to (y2-y1)-1 do + begin + writexy(x1,y1+i,wlinsl); + writexy(x2,y1+i,wlinsr); + end; + + KopfPos:=(x2-x1-Length(Kopf)) div 2; + + writexy(x1+1,y1,padch('',wlinwo[1],KopfPos-2)); + writexy(KopfPos+Length(Kopf),y1,padch('',wlinwo[1],(x2-x1)-(KopfPos+Length(Kopf))+1)); + + writexy(x1+1,y2,padch('',wlinwu[1],(x2-x1)-1)); + + textbackground(Laufwerkba); + writeXY(KopfPos,y1,Kopf); + + +end; + + + procedure Control.Drahmen(paint:boolean); + var vlinw,vlins,vole,vore, + vule,vure,vbrl,vbrr,vbru:char; + begin + window(xanf,yanf,xanf+xdiff-3,yanf+ydiff+1); + window(LO(windmin),Hi(windmin),LO(windmax)+2,HI(windmax)+3); + If paint then + begin + Map^[1].x1:=LO(windmin)+1; Map^[1].y1:=Hi(windmin)+1; + Map^[1].x2:=LO(windmax)-1; Map^[1].y2:=HI(windmax)-2; + Funktionen(true); + MouDefBereich(5,Map); + end else + begin + MoudefBereich(1,Map); + Map^[2].x1:=LO(windmin)+1; Map^[2].y1:=Hi(windmin)+1; + Map^[2].x2:=LO(windmax)-1; Map^[2].y2:=HI(windmax)-2; + end; + + textcolor(Winfo);textbackground(Winba); + {Winframe(1,1,xdiff,ydiff+4,Paint);} + case Fmod of + Rechts : FensterRahmen(1,1,xdiff,ydiff+4,' Komprimiert ',Paint); + Links : FensterRahmen(1,1,xdiff,ydiff+4,' Unkomprimiert ',Paint); + Archiv : FensterRahmen(1,1,xdiff,ydiff+4,' Archiv ',Paint); + End; + + window(LO(windmin)+2,Hi(windmin)+2,LO(windmax),HI(windmax)-1); + textbackground(Winba); + If einmal then begin winclrscr; Laufwerk(true); einmal:=false; end; + textcolor(Winfo); textbackground(Winba); + writeXY(2,ydiff,'Ausgew.:'); + case Fmod of +Rechts,Links: begin + writeXY(2,ydiff+1,'Gesamtkapazitt:'); + writeXY(2,ydiff+2,'freier Speicher:'); + end; + Archiv: begin + writeXY(2,ydiff+1,'orig. G:'); + writeXY(26,ydiff+1,'Rat.:'); + writeXY(2,ydiff+2,'komp. G:'); + writeXY(26,ydiff+2,'Form:'); + end; + end{Case}; + end; + + + + +Destructor Control.Done; +begin + Filind.DelFile; + Filind.Done; + Filsel.Delfile; + Filsel.Done; +end; + +begin +end. \ No newline at end of file diff --git a/UNITS/TCTRL2.PAS b/UNITS/TCTRL2.PAS new file mode 100644 index 0000000..2b3a598 --- /dev/null +++ b/UNITS/TCTRL2.PAS @@ -0,0 +1,852 @@ +Unit TCTRL2; + +Interface +uses TControl,Init,Tksaa,Tkstream,Tkstring,Tkdisk,Tkwin,Tkvideo,Kbm,Crt,Dos,Swap; + +Type +RechtsFenster = Object(Control) + Constructor Init; + function Packen_Entpacken : boolean; virtual; + function Entpacken : boolean; + procedure Dekomprimieren; + procedure Fakt; + End{Object Rechtsfenakt}; + +LinksFenster = Object(Control) + Constructor Init; + function Packen_Entpacken : boolean; virtual; + function Packen : boolean; + function APacken : boolean; + procedure Komprimieren; + End{LinksFenster}; + +var LFenster : ^Linksfenster; + RFenster : ^Rechtsfenster; + + +Implementation + + + + + + +{--------------------------- Linksfenster ------------------------} + +Constructor Linksfenster.Init; +begin + Control.Init(Links,Leftdatname,Leftdatindex,2); Funktionen(true); + Fenakt(False,True,False); +end; + + +function Linksfenster.Packen_Entpacken : boolean; +begin + If ArcOpen then + Packen_Entpacken:=APacken else + Packen_Entpacken:=Packen; +end; + + +function Linksfenster.Packen : boolean; +const M = 'Fehler beim Komprimieren :'; +var tas,fun : char; + Vp : Dparam; + i : byte; + weiter : boolean; + zahl : string[15]; + Bu : Button; + Sb1,Sb2,Sb3, + Sb4,Sb5 : Selbutton; + Ed1,Ed2,Ed3 : Edit; + Pack : boolean; + LwCh : boolean; + + + + procedure Packers; + var z,k : byte; + Pack, + PackStart, + PackMerk : PackPointer; + pmax : byte; + + begin + Packer_File.Seek(0); + PackStart:=NIL; Pack:=NIL; + while not Packer_File.EOF do {Liste aufbauen} + begin + Packer_File.Read(Vp,-1,1); + PackMerk:=Pack; + new(Pack); + If PackStart=NIL then Packstart:=Pack; + Pack^.Name:=upstring(justname(Vp.verp)); + Pack^.Next:=NIL; + If PackMerk<>NIL then PackMerk^.Next:=Pack; + end; + Packerlst(PackStart,Kom.pack); + while PackStart<>NIL do {Liste lschen} + begin + Pack:=PackStart; PackStart:=Pack^.Next; dispose(Pack); + end; + Packer_File.Read(Vp,Kom.pack,1); + Sb1.Sb[1].S:=false; Sb2.Sb[1].S:=false; Sb3.Sb[1].S:=true; Sb4.Sb[1].S:=true; Sb5.Sb[1].S:=false; + Sb1.akt:=true; Sb2.akt:=true; Sb3.akt:=true; Sb4.akt:=true; Sb5.akt:=true; + Ed3.akt:=true; + end; + + + +begin + Packen:=false; Packer_File.Open; + If Packer_File.Size=0 then + begin + IO_Error(M,'IOERROR.MSG',223,AR1); exit; + end; + If not dat.ver_dat and (dat.filanz>1) then Packdateiwrite(dat.vpos); + Listendatei(Kom.sel,Kom.ausw); + If Packer_File.Size<=m_pack then m_pack:=0; + Kom.pack:=m_pack; Kom.komp:=m_komp; Kom.arc:=''; Kom.pas:='';Kom.ver:=false; + Kom.self:=false; Kom.path:=false; Kom.Uv:=false; Kom.mV:=false; + Packer_File.Read(Vp,Kom.pack,1); + Lw.Dr:=RFenster^.dat.ver[1].name[1]; + DriveKind(Lw); + LwCh:=Lw.Ch[1]='0'; + If dat.vpos>1 then Kom.arc:=dat.ver[dat.vpos].name; + Kom.datei:='*.*'; + If not openwindow(59,12,fenfo,fenba,'Komprimieren') then exit; + + writeXY(3,2,'Packen von :'); + + InitEditor(Ed1,16,2,'',true,Kom.datei,12); + InitEditor(Ed2,16,4,'in Archiv :',true,Kom.arc ,8); + InitEditor(Ed3,45,4,'Passwort :',true,Kom.pas,12); + + InitSelbutton(Sb1,3 ,8 ,'Dateien verschieben',Kom.ver,1); Sb1.Anz:=1; + InitSelbutton(Sb2,34,8,'Selbstentpacker',Kom.self,1); Sb2.Anz:=1; + InitSelbutton(Sb3,3 ,9 ,'Mit Verzeichnisstruktur',true{Kom.path},1); Sb3.Anz:=1; + InitSelbutton(Sb4,34,9 ,'Multiple Volume',true,1); Sb4.Anz:=1; + InitSelbutton(Sb5,3 ,10,'Mit Unterverzeichnissen',Kom.Uv,1); Sb5.Anz:=1; + + + InitButton(Bu, 3,12,' ~Komprimieren ',Alt_K,1); + InitButton(Bu,21,12,' ~Packer ', Alt_P,2); + InitButton(Bu,35,12,' ~Modus ', Alt_M,3); + InitButton(Bu,48,12,' ~Abbruch ', Alt_A,4); Bu.Anz:=4; + + I:=2; weiter:=false; Pack:=false; + repeat + + SetEditor(Ed2); + + textcolor(fenfo);textbackground(fenba); + If trim(Vp.passw)>'' then + SetEditor(Ed3) else + writeXY(34,4,' '); + + textcolor(fenfo);textbackground(fenba); + If (trim(Vp.VohneV)>'') then + SetSelbutton(Sb1) else + begin + writeXY(3,8,' '); Sb1.Sb[1].S:=false; + end; + + + + If not ((trim(Vp.multipleV)>'') and LwCh) then + If (trim(Vp.self)>'') then + SetSelbutton(Sb2) else + begin + writeXY(34,8,' '); Sb2.Sb[1].S:=false; + end; + {EndIf} + + If ((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>'')) then + SetSelbutton(Sb3) else + begin + writeXY(3,9,' '); Sb3.Sb[1].S:=false; + end; + + If (trim(Vp.multipleV)>'') and LwCh then + SetSelbutton(Sb4) else + begin + writeXY(34,9,' '); Sb4.Sb[1].S:=false; + end; + + If Kom.sel=0 then + begin + If trim(Vp.PmitUv)>'' then + SetSelbutton(Sb5) else + begin + writeXY(3,10,' '); Sb5.Sb[1].S:=false; + end; + end; + + + + Setbutton(Bu); + + textcolor(fenfo);textbackground(fenba); + writeXY( 3,6,concat(chr(254),' ',pad(justname(upstring(Vp.verp)),9),'Packer')); + writeXY(34,6,concat(chr(254),' ',pad(Ko[Kom.komp],5),'Komprimierung')); + + If (Kom.sel>0) and Kom.ausw then + begin + str(Kom.sel,zahl); + If Kom.sel>1 then + writeXY(16,2,concat(zahl,' Dateien')) else + writeXY(16,2,concat(zahl,' Datei')); + end else + begin + If (not dat.ver_dat) and (dat.fpos>1) then + writeXY(16,2,upstring(dat.fil[dat.fpos].name)) else + SetEditor(Ed1); + end; + + case I of + 1: ActiveEditor(Ed1); + 2: ActiveEditor(Ed2); + 3: ActiveEditor(Ed3); + 4: ActiveSelButton(Sb1); + 5: ActiveSelButton(Sb2); + 6: ActiveSelButton(Sb3); + 7: ActiveSelButton(Sb4); + 8: ActiveSelButton(Sb5); + 9: ActiveButton(Bu); + end; + + case EventThisbutton(Bu) of + 1 : begin + If (Kom.sel=0) then + Kom.datei:=Ed1.T; + Kom.arc :=Ed2.T; + If trim(Kom.arc)<>'' then + begin + Pack :=true; + weiter:=true; + end; + If (trim(Vp.passw)>'') then + Kom.pas :=Ed3.T; + If (trim(Vp.VohneV)>'') then + Kom.ver :=Sb1.Sb[1].S; + If not((trim(Vp.multipleV)>'') and LwCh) then + If (trim(Vp.self)>'') then + Kom.self :=Sb2.Sb[1].S; + If ((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>'')) then + Kom.path:=Sb3.Sb[1].S; + If (trim(Vp.multipleV)>'') and LwCh then + Kom.mV:=Sb4.Sb[1].S; + If (trim(Vp.PmitUv)>'') and (Kom.sel=0) then + Kom.Uv:=Sb5.Sb[1].S; + end; + 2 : begin + Packers; + Sb1.Akt:=True; + Sb2.Akt:=True; + Sb3.Akt:=True;; + Ed1.Akt:=True; + Ed2.Akt:=True; + Ed3.Akt:=True; + I:=2; + end; + 3 : Moduslst(Ko,Kom.komp); + 4 : begin + weiter:=true; + Pack:=false; + end; + end; + + If (Kom.sel=0) then + If EventEditor(Ed1) then I:=1; + If EventEditor(Ed2) then I:=2; + + If (trim(Vp.passw)>'') then + If EventEditor(Ed3) then I:=3; + + If (trim(Vp.VohneV)>'') then + If EventSelButton(Sb1) then I:=4; + + If not((trim(Vp.multipleV)>'') and LwCh) then + If (trim(Vp.self)>'') then + If EventSelButton(Sb2) then I:=5; + + If ((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>'')) then + If EventSelButton(Sb3) then I:=6; + + If (trim(Vp.multipleV)>'') and LwCh then + If EventSelButton(Sb4) then I:=7; + + If (trim(Vp.PmitUv)>'') and (Kom.sel=0) then + If EventSelButton(Sb5) then I:=8; + + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + CUP, + BACKTAB: begin + If I>1 then dec(I) else I:=9; + If ((trim(Vp.PmitUv)='') and (I=8)) or + ((Kom.sel>0) and (I=8))then dec(I); + If ((trim(Vp.multipleV)='') or not LwCh) and (I=7) then dec(I); + If not (((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>''))) + and (I=6) then dec(I); + If ((trim(Vp.self) ='') or ((trim(Vp.multipleV)>'') and LwCh)) + and (I=5) then dec(I); + If (trim(Vp.VohneV)='') and (I=4) then dec(I); + If (trim(Vp.passw)='') and (I=3) then dec(I); + If (Kom.sel>0) and (I=1) then dec(I); + end; + CDOWN, + TAB:begin + If I<9 then inc(I) else I:=1; + If (Kom.sel>0) and (I=1) then inc(I); + If (trim(Vp.passw)='') and (I=3) then inc(I); + If (trim(Vp.VohneV)='') and (I=4) then inc(I); + If ((trim(Vp.self) ='') or ((trim(Vp.multipleV)>'') and LwCh)) + and (I=5) then inc(I); + If not (((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>''))) + and (I=6) then inc(I); + If ((trim(Vp.multipleV)='') or not LwCh) and (I=7) then inc(I); + If ((trim(Vp.PmitUv)='') and (I=8)) or + ((Kom.sel>0) and (I=8))then inc(I); + end; + Esc : weiter:=true; + F1 : Hilfe.ViewPage(23); + end; + end; + until weiter; + closewindow; m_pack:=Kom.pack; m_komp:=Kom.komp; Packer_File.Close; + If Pack then Komprimieren; + Packen:=Pack; +end; + +function Linksfenster.APacken:boolean; +const M = 'Fehler beim Komprimieren :'; +var tas,fun : char; + Vp : Dparam; + i : byte; + weiter : boolean; + zahl : string[15]; + Bu : Button; + Sb1,Sb3,Sb5: Selbutton; + Ed1,Ed3 : Edit; + Pack : boolean; + +begin + APacken:=false; Packer_File.Open; + If Packer_File.Size=0 then + begin + IO_Error(M,'IOERROR.MSG',223,AR1); exit; + end; + If not LFenster^.dat.ver_dat and (LFenster^.dat.filanz>1) then LFenster^.Packdateiwrite(LFenster^.dat.vpos); + LFenster^.Listendatei(Kom.sel,Kom.ausw); + Vp.Arcend:=''; + + while not Packer_File.EoF and not CompArcend(Vp.Arcend,RFenster^.dat.fil[RFenster^.dat.fpos].name) do + Packer_File.Read(Vp,-1,1); + + + Kom.pack:=Packer_File.Pos-1; Kom.komp:=m_komp; Kom.arc:=''; Kom.pas:='';Kom.ver:=false; + Kom.self:=false; Kom.path:=false; Kom.Uv:=false; Kom.ver:=false; + + Kom.arc:=RFenster^.dat.fil[RFenster^.dat.fpos].name; + If (trim(Vp.PmitUv) > '') and (Kom.sel=0) then Kom.path:=true; + Kom.datei:='*.*'; + If not openwindow(59,12,fenfo,fenba,'Komprimieren') then exit; + + writeXY(3,2,'Packen von :'); + + InitEditor(Ed1,16,2,'',true,Kom.datei,12); + writeXY(3,4,'in Archiv : '+upstring(Kom.arc)); + InitEditor(Ed3,45,4,'Passwort :',true,Kom.pas,12); + + InitSelbutton(Sb1,3,8,'Dateien verschieben',Kom.ver,1); Sb1.Anz:=1; + InitSelbutton(Sb3,3 ,9 ,'Mit Verzeichnisstruktur',true{Kom.path},1); Sb3.Anz:=1; + InitSelbutton(Sb5,3 ,10,'Mit Unterverzeichnissen',Kom.Uv,1); Sb5.Anz:=1; + + InitButton(Bu, 3,12,' ~Komprimieren ',Alt_K,1); + InitButton(Bu,35,12,' ~Modus ', Alt_M,2); + InitButton(Bu,48,12,' ~Abbruch ', Alt_A,3); Bu.Anz:=3; + + I:=6; weiter:=false; Pack:=false; + repeat + + If trim(Vp.passw)>'' then + SetEditor(Ed3); + + textcolor(fenfo);textbackground(fenba); + + If (trim(Vp.VohneV)>'') then + SetSelbutton(Sb1) else + begin + writeXY(3,8,' '); Sb1.Sb[1].S:=false; + end; + + If ((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>'')) then + SetSelbutton(Sb3) else + begin + writeXY(3,9,' '); Sb3.Sb[1].S:=false; + end; + + If Kom.sel=0 then + begin + If trim(Vp.PmitUv)>'' then + SetSelbutton(Sb5) else + begin + writeXY(3,10,' '); Sb5.Sb[1].S:=false; + end; + end; + + + If (Kom.sel>0) and Kom.ausw then + begin + str(Kom.sel,zahl); + If Kom.sel>1 then + writeXY(16,2,concat(zahl,' Dateien')) else + writeXY(16,2,concat(zahl,' Datei')); + end else + begin + If (not LFenster^.dat.ver_dat) and (LFenster^.dat.fpos>1) then + begin + writeXY(16,2,upstring(LFenster^.dat.fil[LFenster^.dat.fpos].name)) + end else + SetEditor(Ed1); + end; + + Setbutton(Bu); + textcolor(fenfo);textbackground(fenba); + writeXY( 3,6,concat(chr(254),' ',pad(justname(upstring(Vp.verp)),9),'Packer')); + writeXY(34,6,concat(chr(254),' ',pad(Ko[Kom.komp],5),'Komprimierung')); + + case I of + 1: ActiveEditor(Ed1); + 2: ActiveEditor(Ed3); + 3: ActiveSelButton(Sb1); + 4: ActiveSelButton(Sb3); + 5: ActiveSelButton(Sb5); + 6: ActiveButton(Bu); + end; + + + case EventThisbutton(Bu) of + 1 : begin + Pack:=true; + weiter:=true; + If (Kom.sel=0) then + Kom.datei:=Ed1.T; + If (trim(Vp.passw)>'') then + Kom.pas :=Ed3.T; + If (trim(Vp.VohneV)>'') then + Kom.ver :=Sb1.Sb[1].S; + If ((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>'')) then + Kom.path:=Sb3.Sb[1].S; + If (trim(Vp.PmitUv)>'') and (Kom.sel=0) then + Kom.Uv:=Sb5.Sb[1].S; + end; + 2 : Moduslst(Ko,Kom.komp); + 3 : begin + weiter:=true; + end; + end; + + + If not ((Kom.sel>0) and Kom.ausw) and not ((not LFenster^.dat.ver_dat) and (LFenster^.dat.fpos>1)) then + If EventEditor(Ed1) then I:=1; + + If (trim(Vp.passw)>'') then + If EventEditor(Ed3) then I:=2; + If (trim(Vp.VohneV)>'') then + If EventSelButton(Sb1) then I:=3; + If ((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>'')) then + If EventSelButton(Sb3) then I:=4; + If (trim(Vp.PmitUv)>'') and (Kom.sel=0) then + If EventSelButton(Sb5) then I:=5; + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + CUP, + BACKTAB: begin + If I>1 then dec(I) else I:=6; + If ((trim(Vp.PmitUv)='') and (I=5)) or + ((Kom.sel>0) and (I=5))then dec(I); + If not (((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>''))) + and (I=4) then dec(I); + If (trim(Vp.VohneV)='') and (I=3) then dec(I); + If (trim(Vp.passw)='') and (I=2) then dec(I); + If (Kom.sel>0) and (I=1) then dec(I); + end; + CDOWN, + TAB:begin + If I<6 then inc(I) else I:=1; + If (Kom.sel>0) and (I=1) then inc(I); + If (trim(Vp.passw)='') and (I=2) then inc(I); + If (trim(Vp.VohneV)='') and (I=3) then inc(I); + If not (((trim(Vp.VohneV)='') and (trim(Vp.PmitV)>'')) or + ((trim(Vp.VohneV)>'') and (trim(Vp.PmitV)>'') and (trim(Vp.VmitV)>''))) + and (I=4) then inc(I); + If ((trim(Vp.PmitUv)='') and (I=5)) or + ((Kom.sel>0) and (I=5))then inc(I); + End{Case}; + Esc : weiter:=true; + F1 : Hilfe.ViewPage(23); + end; + end; + until weiter; + closewindow; m_komp:=Kom.komp; Packer_File.Close; + If Pack then Komprimieren; + APacken:=Pack; +end; + + + + procedure LinksFenster.Komprimieren; + const M = 'Fehler beim Komprimieren :'; + var Cmdline,progdir : pathstr; + tstr : pathstr; + Vp : Dparam; + ex,fhohe : byte; + + begin + Dosexitcode; + Packer_File.Open; + Packer_File.read(Vp,kom.pack,1); + Packer_File.Close; + Progdir:=concat(addbackslash(m_packverz),Vp.verp,' '); + FindFirst(Progdir, $27, DirInfo); + If ((Dirinfo.name='') or (Doserror>0)) then + begin + execend(Vp.verp,concat(M,' ',Vp.verp),Ar1); MouShowMouse; + Doserror:=0;exit; + end; + chver(LFenster^.dat.aktverz); Cmdline:=''; + If Kom.ver then + begin + If Kom.path then + Cmdline:=Vp.VmitV else Cmdline:=Vp.VohneV; + end else + begin + If Kom.path then + Cmdline:=Vp.PmitV else Cmdline:=Vp.PohneV; + end; + If Kom.Uv then + Cmdline:=Cmdline+' '+Vp.PmitUv; + case Kom.Komp of + 0: Cmdline:=Cmdline+' '+Vp.null; + 1: Cmdline:=Cmdline+' '+Vp.min; + 2: Cmdline:=Cmdline+' '+Vp.norm; + 3: Cmdline:=Cmdline+' '+Vp.max; + end; + If Kom.self then + Cmdline:=concat(Cmdline,' ',Vp.self); + If Kom.mV then + CmdLine:=concat(Cmdline,' ',Vp.multipleV); + If Kom.pas>'' then + Cmdline:=concat(Cmdline,' ',Vp.passw,Kom.pas); + Cmdline:=concat(Cmdline,' ',addbackslash(RFenster^.dat.aktverz),Kom.arc); + If m_interM then + begin + If not savewin(2,2,crtxmax-ShadowX,crtymax-ShadowY) then exit; + MouDefBereich(2,Map); + MouHideMouse; Ausblenden; + end else + begin + If trim(Vp.packdat)>'' then fhohe:=2 else fhohe:=4; + If not openwindow(31,fhohe,fenfo,fenba,'Komprimieren') then exit; + textcolor(MessageCol); + If Kom.sel=1 then + writeXY(10,2,'Packe Datei...') else writeXY(10,2,'Packe Dateien...'); + MouHideMouse; redout; + end; + If Kom.sel=0 then + begin + Cmdline:=concat(Cmdline,' ',Kom.datei); + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline)); + until execend(Vp.verp,M,Ar2)=2; + end else + begin + If trim(Vp.packdat)>'' then + begin + Cmdline:=concat(Cmdline,' ',Vp.packdat,addbackslash(m_tempverz),'PDAT.LST'); + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline)); + until execend(Vp.verp,M,Ar2)=2; + end else + begin + Pdat.Open; ex:=0; + while not Pdat.EOF and (ex<>3) do + begin + Pdat.Readln(tstr); + If not m_InterM then + begin + textcolor(fenfo); textbackground(fenba); + writeXY(1,4,center(justfilename(tstr),31)); + end; + repeat + textcolor(lightgray); textbackground(black); + Doserror:=ExecPrg(concat(Progdir,Cmdline,' ',tstr)); + ex:=execend(Vp.verp,M,Ar3); + until ex in [2,3]; + end; + Pdat.Close; + end; + end; + If not m_interM then + begin + redback; + closewindow; + end else + {If not m_flashend then} + begin + Blackscreen; restwindow; Einblenden; + end; + MouShowMouse; + end; + + +{--------------------------- Rechtsfenster ------------------------} + +Constructor Rechtsfenster.Init; +begin + Control.Init(Rechts,Rightdatname,Rightdatindex,(Crtxmax Div 2)+2); Funktionen(true); + Fenakt(False,True,True); +end; + + +procedure RechtsFenster.Fakt; +var vpos : word; +begin + {UnselectAll;} + ClrUnterf; + {Fenakt(True,True,True);} + Fenakt(True,False,True); + ArcOpen:=false; +end; + + +function RechtsFenster.Packen_EntPacken; +begin + Packen_EntPacken:=Entpacken; +end; + + + + +function RechtsFenster.Entpacken :boolean; +const M : Message = 'Fehler beim Dekomprimieren :'; + AR1 : Acceptrec = (' OK ','',''); +var tas,fun : char; + entpack : byte; + i : byte; + Vp : Dparam; + Bu : Button; + Sb,Sb4 : SelButton; + Ed1,Ed2 : Edit; + zahl : string[10]; + weiter : boolean; + entp : boolean; + LwCh : boolean; + + +begin + Entpacken:=false; Packer_File.Open; + If not dat.ver_dat and (dat.filanz>1) then Packdateiwrite(dat.vpos); + Listendatei(Kom.sel,Kom.ausw); + entpack:=0; Entp:=false; Packer_File.Seek(entpack); + If Kom.sel=0 then + begin + IO_Error(concat(M),'IOERROR.MSG',222,AR1); + Entpacken:= Entp; exit; + end; + If not Kom.ausw then + begin + Vp.Arcend:=''; + while not Packer_File.EoF and not CompArcend(Vp.Arcend,dat.fil[dat.fpos].name) do + Packer_File.Read(Vp,-1,1); + end else Vp.passw:=''; + Packer_File.Close; + Lw.Dr:=dat.ver[1].name[1]; + DriveKind(Lw); + LwCh:=Lw.Ch[1]='0'; + Kom.datei:='*.*'; Kom.pas:=''; Kom.path:=false; Kom.mV:=false; + If not openwindow(60,9,fenfo,fenba,'Dekomprimieren') then exit; + + writeXY(3,2,'Entpacken von :'); + InitEditor(Ed1,19,2,'',true,Kom.datei,12); + If (Kom.sel>0) and Kom.ausw then + begin + str(Kom.sel,zahl); + If Kom.sel>1 then + writeXY(3,4,concat('aus ',zahl,' Archiven')); + writeXY(3,4,concat('aus ',zahl,' Archiv')); + end else + writeXY(3,4,concat('aus Archiv : ',upstring(dat.fil[dat.fpos].name))); + + If (trim(Vp.passw)>'') and not Kom.ausw then + Initeditor(Ed2,45,4,'Passwort :',true,Kom.pas,12); + + InitSelButton(Sb,3,7 ,'Mit Verzeichnissen',true{Kom.path},1); Sb.Anz:=1; + InitSelbutton(Sb4,34,7 ,'Multiple Volume',true,1); Sb4.Anz:=1; + + + InitButton(Bu,10 ,9,' ~Dekomprimieren ',ALT_D,1); + InitButton(Bu,38,9, ' ~Abbruch ', ALT_A,2); Bu.Anz:=2; + + I:=1;weiter:=false; + repeat + + SetEditor(Ed1); + + If (trim(Vp.EmitV)>'') and not Kom.ausw then + SetSelButton(Sb); + If (trim(Vp.multipleV)>'') and LwCh and not Kom.ausw then + SetSelbutton(Sb4); + + If (trim(Vp.passw)>'') and not Kom.ausw then + SetEditor(Ed2); + + SetButton(Bu); + case I of + 1: ActiveEditor(Ed1); + 2: ActiveEditor(Ed2); + 3: ActiveSelButton(Sb); + 4: ActiveSelButton(Sb4); + 5: ActiveButton(Bu); + end; + + case EventThisButton(Bu) of + 1: begin + Kom.datei:=Ed1.T; + If (trim(Vp.passw)>'') and not Kom.ausw then + Kom.pas :=Ed2.T; + If (trim(Vp.EmitV)>'') and not Kom.ausw then + Kom.path :=Sb.Sb[1].S; + If (trim(Vp.multipleV)>'') and LwCh and not Kom.ausw then + Kom.mV:=Sb4.Sb[1].S; + Entp:=true; + weiter:=true; + end; + 2: begin + weiter:=true; + end + end; + + If EventEditor(Ed1) then I:=1; + If ((trim(Vp.passw)>'') and not Kom.ausw ) then + If EventEditor(Ed2) then I:=2; + If (trim(Vp.EmitV)>'') and not Kom.ausw then + If EventSelButton(Sb) then I:=3; + If (trim(Vp.multipleV)>'') and LwCh and not Kom.ausw then + If EventSelButton(Sb4) then I:=4; + + + case ev.key of + CUP, + BACKTAB: begin + If I>1 then dec(I) else I:=5; + If ((trim(Vp.multipleV)='') or not LwCh or Kom.ausw) and (I=4) then dec(I); + If ((trim(Vp.EmitV)='') or Kom.ausw ) and (I=3) then dec(I); + If ((trim(Vp.passw)='') or Kom.ausw ) and (I=2) then dec(I); + end; + CDOWN, + TAB : begin + If I<5 then inc(I) else I:=1; + If ((trim(Vp.passw)='') or Kom.ausw ) and (I=2) then inc(I); + If ((trim(Vp.EmitV)='') or Kom.ausw ) and (I=3) then inc(I); + If ((trim(Vp.multipleV)='') or not LwCh or Kom.ausw) and (I=4) then inc(I); + end; + ESC : weiter:=true; + F1 : Hilfe.ViewPage(24); + end; + until weiter; + closewindow; + If entp then Dekomprimieren; + Entpacken:=entp; +end; + + procedure RechtsFenster.Dekomprimieren; + const M = 'Fehler beim Dekomprimieren :'; + var Cmdline,progdir : pathstr; + tstr : pathstr; + Vp : Dparam; + ex,Z : byte; + en : Endg; + begin + Dosexitcode; + chver(LFenster^.dat.aktverz); + If m_interM then + begin + If not savewin(2,2,crtxmax-ShadowX,crtymax-ShadowY) then exit; + MouHideMouse; Ausblenden; + end else + begin + If not openwindow(31,4,fenfo,fenba,'Dekomprimieren') then exit; + textcolor(MessageCol); + If Kom.sel>1 then + writeXY(9,2,'Entpacke Archive...') else writeXY(9,2,'Entpacke Archiv...'); + MouHideMouse;redout; + end; + Pdat.Open; ex:=0; + while not Pdat.EOF and (ex<>3) do + begin + Pdat.Readln(tstr); + If not m_InterM then + begin + textcolor(fenfo); textcolor(fenba); + writeXY(1,4,center(justfilename(tstr),31)); + end; + + Packer_File.Open; + Vp.arcend:=''; + while not Packer_File.EoF and not CompArcend(Vp.Arcend,dat.fil[dat.fpos].name) do + Packer_File.Read(Vp,-1,1); + Packer_File.Close; + + If trim(Vp.entp)='' then Vp.entp:=Vp.verp; + Progdir:=addbackslash(m_packverz)+Vp.entp+' '; + FindFirst(Progdir, $27, DirInfo); + If ((Dirinfo.name>'') and (Doserror=0)) then + begin + Cmdline:=''; + If Kom.path then + Cmdline:=Vp.EmitV else Cmdline:=Vp.EohneV; + If Kom.pas>'' then + Cmdline:=Cmdline+' '+Vp.passw+Kom.pas; + If Kom.mV then + Cmdline:=Cmdline+' '+Vp.multipleV; + + Cmdline:=Cmdline+' '+tstr; + Cmdline:=Cmdline+' '+Kom.datei; + repeat + Doserror:=ExecPrg(concat(Progdir,Cmdline)); + ex:=execend(Vp.Entp,M,Ar3); + until ex in[2,3]; + end else + execend(Vp.Entp,concat(M,' ',Vp.Entp),Ar1); + end; + Pdat.Close; + If not m_interM then + begin + redback; closewindow + end else + {If not m_flashend then} + begin + Blackscreen; restwindow; Einblenden; + end; + MouShowMouse; + end; + + +begin +end. \ No newline at end of file diff --git a/UNITS/TDATEI.PAS b/UNITS/TDATEI.PAS new file mode 100644 index 0000000..fa3fafd --- /dev/null +++ b/UNITS/TDATEI.PAS @@ -0,0 +1,722 @@ +UNIT TDatei; + +Interface +uses TBaum,Init,Tkstring,Dos,Crt,Tkvideo,Tkwin,Tkstream,Tkdisk; + +Type + + Datei = Object(Baum) + + ToggleJ : ToggleRec; + + Constructor Init; + + procedure PackdateiWrite(vpos:word); + procedure PackdateiRead (vpos:word); + function Dateiread (vpos:word): boolean; + function Dateilesen (vpos:word): boolean; virtual; + + procedure fullsort(so:byte); + procedure selcount; + + procedure Readendg; virtual; + + procedure dwrite (m:boolean;x:byte;df:word);virtual; + procedure Dateienwrite (m:boolean;anf:word); + procedure dselect (Edpos:word); + procedure datselect (m:boolean;anf:word); + procedure datmark (anf,ende:word); + procedure filmark (anf:word); + + procedure Floschen; virtual; + {procedure Vloschen(Uv:boolean); virtual;} + procedure treemark (anf:word); + + Destructor Done; + End{Datei}; + +Implementation + + Constructor Datei.Init; + begin + ToggleJ:=normal; Baum.Init; + end; + + + + + procedure Datei.treemark(anf:word); + var z,k,vpos : word; + se : boolean; + begin + If anf < 1 then exit; + BaumWrite(false,dat.vpos); + se:=false; + k:=anf; + repeat + If dat.ver[k].files>0 then se:=true; + inc(k); + until dat.ver[k].Vopen or (k>dat.veranz); + se:= not se; + If anf<=dat.vpos then + begin + vpos:=dat.vpos; + while (vposI Then + Begin + X:=sorti(dat.fil[(Left+Right) DIV 2]); + Repeat + While sorti(dat.fil[I])X Do Dec(J); + If I<=J Then + Begin + Hold:=dat.fil[I]; + dat.fil[I]:=dat.fil[J]; + dat.fil[J]:=Hold; + Inc(I); + Dec(J); + End + Until I>J; + End; + If J>Left Then SortQuick(Left,J); + If Idat.fil[z].select) and (Vsel.name=dat.fil[z].name) then + begin + Vsel.select:=dat.fil[z].select; + Filsel.write(Vsel,Fpos-1,1); + end; + inc(z); + weiter:=not Vsel.ver_dat; + If Vsel.select and weiter then inc(zahl); + end; + end else + begin + Fpos:=Filsel.Size; + Filsel.Seek(Fpos); + fullver:=addbackslash(aktver); { Verzeichnis speichern } + Vsel.ver_dat:=true; + while not (length(fullver)=0) do + begin + If fullver[1]='\' then + begin + Vsel.name:='\'; delete(fullver,1,1); + end else + begin + Vsel.name:=copy(fullver,1,pos('\',fullver)-1); + delete(fullver,1,pos('\',fullver)); + end; + Vsel.jump:=0; + Filsel.write(Vsel,-1,1);inc(Fpos); + end; + + + Vind.Lw :=Laufw; + Vind.Fseek:=Fpos; + Vind.vpos :=vpos; + Filind.Write(Vind,-1,1); + Vsel.ver_dat:=false; zahl:=1; + for z:=2 to dat.filanz do { Dateien abspeichern } + begin + Vsel.name :=dat.fil[z].name; + Vsel.select:=dat.fil[z].select; + Vsel.jump :=dat.filanz-z; + If dat.fil[z].select then inc(zahl); + Filsel.write(Vsel,-1,1); + end; + + end; + If zahl=dat.filanz then + dat.ver[vpos].select:=true else dat.ver[vpos].select:=false; + Filsel.Close; + Filind.Close; + If not dat.ver_dat then fullsort(m_sort); +end; + + + + +procedure Datei.PackdateiRead(vpos:word); +var aktver : PathStr; + Laufw : Char; + weiter : boolean; + Vind : Findex; + Vsel : Ftemp; + found : boolean; + Fpos : longint; + zahl : word; + +begin + aktver:=fullpath(vpos); + Laufw :=aktver[1]; + Filind.Open; weiter:=true; found:=false; + while not FilInd.Eof and weiter do + begin + FilInd.Read(Vind,-1,1); + If (Laufw=Vind.Lw) then + begin + If (vpos=Vind.vpos) then + begin + found:=true; weiter:=false; + end; + end else + begin + + end; + end; + + Filsel.Open; z:=2; + If found then + begin + Fpos:=Vind.Fseek; + Filsel.Seek(Fpos); weiter:=true; + while not Filsel.Eof and weiter do + begin + Filsel.Read(Vsel,-1,1); inc(Fpos); + If trim(Vsel.name)=dat.fil[z].name then + begin + dat.fil[z].select:=Vsel.select; + end; + inc(z); + weiter:=not Vsel.ver_dat; + end; + end else + begin + end; + fullsort(m_sort); + Filsel.Close; + Filind.Close; +end; + + + + + procedure Datei.Readendg; + var Vp : Dparam; + PackPos: byte; + endgcount: byte; + begin + PackPos:=0; + case FMod of + Links : begin + Fendg.en[1] :='*.*'; + Fendg.packer[1]:=PackPos; + Fendg.fanz :=1; + end; + Rechts: begin + Packer_File.Open; + Fendg.fanz:=0; Packer_File.Seek(0); + while not Packer_File.EOF do + begin + Packer_File.Read(Vp,-1,1); + endgcount:=0; + repeat + inc(Fendg.fanz); inc(endgcount); + If pos(',',Vp.arcend)>0 then + begin + Fendg.en[Fendg.fanz] :=concat('*.',copy(Vp.arcend,1,pos(',',Vp.arcend)-1)); + Fendg.Packer[Fendg.fanz]:=PackPos; + delete(Vp.arcend,1,pos(',',Vp.arcend)); + end else + begin + Fendg.en[Fendg.fanz]:=concat('*.',Vp.arcend); Vp.arcend:=''; + Fendg.Packer[Fendg.fanz]:=PackPos; + end; + until (Vp.arcend='') or (endgcount=EndgAnz); + inc(PackPos); + end; + Packer_File.Close; + end; + end{Case}; + end; + + + + + function Datei.Dateilesen (vpos:word): boolean; + var name : string[13]; + taste2 : char; + l : byte; + aktverz : pathstr; + + begin + aktverz:=fullpath(vpos); + {If not chver(dat.aktverz) then + begin + Dateilesen:=false; exit; + end;} + + dat.fanf:=1;dat.filanz:=1;dat.fil[1].name:='.';dat.fpos:=1; + dat.fil[1].select:=false; + change:=false; + findfirst (addbackslash(aktverz)+'*.*',$3F,Dirinfo); + while (Doserror=0) and ((Dirinfo.name='.') or (Dirinfo.name='..')) do + begin + findnext(Dirinfo); + end; + while (Doserror=0) and (dat.filanzDirectory) and (((dirinfo.attr and m_attrib)>0) + and (not ((dirinfo.attr and $18) in[$10,$8])) or (Dirinfo.attr=0)) + and (dat.filanz1 then + begin + unpacktime(dat.fil[df].time,dt); + str(dt.day,Tag);str(dt.month,Monat); + str(dt.hour,Stunde);str(dt.min,Minute);str(dt.year,Jahr); + str(dat.fil[df].size,Groesse); + delete(Jahr,1,2); + Zeile:=concat(Zeile,leftpadch(Tag,'0',2),'/',leftpadch(Monat,'0',2),'/',Jahr); + Zeile:=concat(Zeile,' ',leftpadch(Stunde,' ',2),':',leftpadch(Minute,'0',2)); + case ToggleJ of + normal : begin + Zeile:=concat(Zeile,leftpadch(Groesse,' ',10)); + end; + spez1 : begin + Zeile:=concat(Zeile,' '); + if $20=(Dat.fil[df].attr and $20) then + Zeile:=concat(Zeile,'A') else Zeile:=concat(Zeile,'-'); + if $4=(Dat.fil[df].attr and $4) then + Zeile:=concat(Zeile,'S') else Zeile:=concat(Zeile,'-'); + if $2=(Dat.fil[df].attr and $2) then + Zeile:=concat(Zeile,'H') else Zeile:=concat(Zeile,'-'); + if $1=(Dat.fil[df].attr and $1) then + Zeile:=concat(Zeile,'R') else Zeile:=concat(Zeile,'-'); + end; + end; + end; + Zeile:=pad(Zeile,xdiff-2); + writeXY(1,x,Zeile); + end; + + + + + procedure Datei.Dateienwrite(m:boolean;anf:word); + var dz,dzmax :word; + zstr :string[9]; + + begin + If dat.filanz>ydiff-3 then dzmax:=dat.fanf+ydiff-3 else dzmax:=dat.filanz; + for dz:=dat.fanf to dzmax do + begin + If (((dat.fpos>=dz) and (anf<=dz)) or + ((dat.fpos<=dz) and (anf>=dz))) and m then + dwrite(true,dz-dat.fanf+1,dz) else dwrite(false,dz-dat.fanf+1,dz); + end; + textcolor(Winfo); textbackground(Winba); + For dz:=(dzmax-dat.fanf)+2 to ydiff-2 do + writeXY(1,dz,pad('',xdiff-2)); + Unterfenster; + end; + + + + + procedure Datei.datselect(m:boolean;anf:word); + var files : boolean; + z : byte; + begin + files:=false; + If dat.fpos>dat.filanz then + dat.fpos:=dat.filanz; + If dat.fpos<1 then + dat.fpos:=1; + If (dat.fpos>dat.fanf+ydiff-3) then + begin + dat.fanf:=dat.fpos-(ydiff-3); files:=true; + end; + If dat.fposdat.fanf+(ydiff-3) then anf:=dat.fanf+(ydiff-3); + + IF files then + Dateienwrite(m,anf) else + begin + + If anfdat.filanz then Edpos:=dat.filanz; + If Edpos<1 then Edpos:=1; + If (Edpos>dat.fanf+ydiff-3) then + files:=true; + If EdposEdpos)then + Datselect(false,dat.fpos); + dat.fpos:=Edpos; + + Datselect(true,dat.fpos); + end; + + + procedure Datei.Selcount; + begin + dat.ver[dat.vpos].files:=0; + for z:=2 to dat.filanz do + If dat.fil[z].select then inc(dat.ver[dat.vpos].files); + + end; + + + procedure Datei.datmark (anf,ende: word); + var dfpos : word; + seite : boolean; + begin + seite:=false; + If anf <= 1 then exit; + If ende = 1 then ende :=2; + If ende-1 > dat.filanz then ende :=dat.filanz; + If ende < dat.fanf then seite:=true; + If ende > (dat.fanf+ydiff-3) then seite:=true; + If anf > (dat.fanf+ydiff-3) then anf :=dat.fanf+ydiff-2; + If anf < dat.fanf then anf :=dat.fanf-1; + If dat.fpos > dat.filanz then dat.fpos:=dat.filanz; + + If (dat.fpos<>ende) then + begin + dfpos:=dat.fpos; + dat.fpos:=ende; + + If (((dat.fpos>=dfpos) and (anf>=dfpos)) or + ((dat.fpos<=dfpos) and (anf<=dfpos))) and not seite then + begin + If (dfpos>dat.fpos) and (anfdfpos) then + begin + dec(dat.fpos); datselect(false,dfpos); inc(dat.fpos); + end; + end; + + If ((dfpos>dat.fpos) and (anf>=dat.fpos)) or + ((dfpos=dat.fanf) and (z=dat.fanf) and (z1) then + begin + Packdateiwrite(vpos);Listdatei; + Floschen; + UnselectAll; + end; + + + end; + +begin + chver(dat.ver[1].name); + If Uv then + begin + z:=dat.vpos; + while (dat.ver[dat.vpos].posdat.vpos do + begin + DatLoschen(z); + If RmVer(fullpath(z)) then + begin + VerzLosch(z); + end; + dec(z); + end; + DatLoschen(z); + end; + + rm_dir:=RmVer(fullpath(dat.vpos)); + If rm_dir then + begin + rm_vpos:=dat.vpos; + {vselect(Vjump(dat.vpos,1,false));} + verselect(false,dat.vpos); + dat.vpos:=Vjump(dat.vpos,1,false); + verselect(false,dat.vpos); + VerzLosch(rm_vpos); + end; + Drivewrite(True); +end;*) + + + + + Destructor Datei.Done; + begin + end; + +begin +end. \ No newline at end of file diff --git a/UNITS/TEST.PAS b/UNITS/TEST.PAS new file mode 100644 index 0000000..f1dcef8 --- /dev/null +++ b/UNITS/TEST.PAS @@ -0,0 +1,80 @@ +program Test; +uses CRT,DOS,KBM; + + + +procedure Verzlesen; +const vertiefe = 20; + vtiefe = 20; +var Dirinfo :Searchrec; + vername : array [0..vertiefe] of String[12]; + drv : string; + enter, + ende : boolean; + verstr : pathstr; + tiefe : byte; + w : word; + Verzmerk: pathstr; + +begin + clrscr; + enter:=true;ende:=false;drv:='C:\'; + tiefe:=vtiefe; + getdir(ord(drv[1])-64,Verzmerk); + chdir(drv); + repeat + If enter then + begin + findFirst('*.*', $37, DirInfo); { Anfang } + while (((Dirinfo.name= '.') or (Dirinfo.name='..')) + or (16<>(dirinfo.attr and 16))) and (doserror=0) do + begin { Info } + findnext(DirInfo); + end; + vername[tiefe]:=Dirinfo.name; + end else + begin + findFirst('*.*', $37, DirInfo); { Weiter } + while (Dirinfo.name<>vername[tiefe]) and (Doserror=0) do + findnext(DirInfo); + If Doserror=0 then + repeat + findnext(dirinfo); { Info } + until (16=(dirinfo.attr and 16)) or (doserror>0); + {End IF} + vername[tiefe]:=Dirinfo.name; + end; + + If (doserror>0) then + begin + ende:=true; + If tiefe > vtiefe then { Exit } + begin + chdir('..'); + dec(tiefe); + Enter:=false;ende:=false; + end; + end else + begin + {$I-}chdir(vername[tiefe]);{I+} { Enter } + If ioresult=0 then + begin + gotoxy(1,1); + write(Vername[tiefe]); + verstr:=Fexpand(''); + inc(tiefe); + Enter:=true; + ende:=false; + end else + Enter:=false; + end; + until (tiefe=vtiefe) and ende or not (Doserror in [0,18]); + chdir(Verzmerk); + {EndIF} +end; + + +begin + MouShowMouse; + Verzlesen; +end. \ No newline at end of file diff --git a/UNITS/TKDISK.PAS b/UNITS/TKDISK.PAS new file mode 100644 index 0000000..46bf007 --- /dev/null +++ b/UNITS/TKDISK.PAS @@ -0,0 +1,339 @@ +UNIT TKDisk; + +INTERFACE +uses Tkstring,Dos,TKstream; + +TYPE + DrRec = Record + Dr :string[26]; + Ch :string[26]; + end; + + +CONST + stdin : WORD = 0; + stdout : WORD = 1; + stderr : WORD = 2; + RedOutPath : Dirstr = 'c:\'; + RedOutName : FileNameStr = 'STDOUT.RED'; + + +VAR + oldout : WORD; + newout : WORD; + olderr : WORD; + Err : WORD; + Redfile: Pathstr; + + {-Lenkt die Bildschirmausgabe in eine Datei} +FUNCTION RedOut : WORD; + {-Restauriert die Bildschirmausgabe} +FUNCTION RedBack : WORD; + {-Sucht nach einer angegebenen Datei ber Path} +FUNCTION ReadProgDir (P : PathStr) : Dirstr; + {-Sucht nach allen vorhandenen Laufwerken} +PROCEDURE DriveKind (var D: DrRec); + {-Wechselt in ein Verzeichnis} +FUNCTION Chver (P:PathStr) : Boolean; + {-Gibt das Verzeichnis auf dem angegebenen Laufwerk zurck} +FUNCTION Getver(Dr:byte;VAR Path:PathStr) : Boolean; + {-Erzeugt den angegebenen Pfad} +FUNCTION Mkver(S:PathStr) : Boolean; + {-Lscht den angegebenen Pfad} +FUNCTION Rmver(S:PathStr) : Boolean; + {-Ermittelt den freien Platz auf dem Lw} +FUNCTION DiskFrei(Drive:Byte) : Longint; + {-Ermittelt die Gre des Lw} +FUNCTION DiskGrosse(Drive:Byte) : Longint; + {Wandelt einen Lwbuchstaben in eine Zahl um} +FUNCTION DrvLet_Num(Drive:Char) : Byte; + +IMPLEMENTATION + +var Drive : DrRec; + + FUNCTION RedOut : WORD; + BEGIN + Redfile:=addbackslash(justpathname(paramstr(0)))+RedOutName+#0; + ASM + + MOV BX, stdout + MOV AH, 45h + INT 21h (* duplicate stdout *) + JC @Error (* failed *) + + MOV oldout, AX (* save stdout *) + + MOV CX, 0 (* normal attribute *) + MOV DX, OFFSET redfile + 1 + MOV AH, 3Ch + INT 21h + JC @Error (* failed *) + + MOV newout, AX + + MOV BX, AX (* redirect stdout hdle to *) + MOV CX, stdout (* track the new file hdle *) + MOV AH, 46h + INT 21h + JC @Error (* failed *) + + MOV Err, 0 + JMP @ok + @Error: + MOV Err, AX (* Error code *) + @Ok: + + { Zugriff auf IO Ports sperrren VGA} + MOV AH, 12h + MOV BL, 32h + MOV AL, 1 + INT 10h + + END; + END; + + FUNCTION RedBack : WORD; + BEGIN + ASM + MOV BX, oldout (* restore original handle *) + MOV CX, stdout + MOV AH, 46h + INT 21h + JC @Error2 (* failed *) + + MOV BX, oldout (* close orig. handle *) + MOV AH, 3Eh + INT 21h + JC @Error2 (* failed *) + + MOV BX, newout (* close dup'd handle *) + MOV AH, 3Eh + INT 21h + JC @Error2 (* failed *) + + MOV Err, 0 + JMP @ok2 + @Error2: + MOV Err, AX + @Ok2: + + { Zugriff auf IO Ports freigeben VGA} + MOV AH, 12h + MOV BL, 32h + MOV AL, 0 + INT 10h + END; + END; + + + +{-------------------------------------------------------------------------} +FUNCTION ReadProgDir (P:PathStr) : Dirstr; +var + Progdir : Dirstr; + Dir : String; + Dirinfo : Searchrec; + I : byte; + +Begin + Progdir:=justpathname(P); + If progdir = '' then + begin + dir:=addbackslash(justpathname(paramstr(0))); + findfirst(dir+P,anyfile,dirinfo); + if doserror <> 0 then + begin + dir := getenv('PATH'); + while (dir<>'')and (dir<>';') do + begin + I:=pos(';',Dir); + If I=0 then I:=length(dir); + findfirst(Addbackslash(copy(dir,1,pred(I)))+P,Anyfile,Dirinfo); + If doserror =0 then + begin + progdir := copy(dir,1,pred(I)); + break; + end + else delete(dir,1,I); + {endif} + end{while}; + end{If} else + progdir:=dir; + end{If}; + If (progdir[length(progdir)]='\') and (progdir[length(progdir)-1]<>':') + then dec(byte(progdir[0])); + readprogdir := progdir; +end; + + +PROCEDURE DriveInit; +var lw : byte; + wechsel,fest: boolean; + +begin + Drive.Dr:=''; Drive.Ch:=''; + for lw:=1 to 26 do + begin + Regs.ah := $44; + Regs.al := $8; + Regs.bl := lw; + intr($21, Regs); + wechsel:=false;fest:=false; + If Regs.ax = 0 then wechsel:=true; + If Regs.ax = 1 then fest:=true; + Regs.ah := $44; + Regs.al := $e; + Regs.bl := lw; + intr($21, Regs); + If (wechsel and ((Regs.al=0) or (Regs.al=lw))) or fest then + begin + Drive.Dr:=Drive.Dr+chr(lw+64); + If wechsel then + begin + Drive.Ch:=Drive.Ch+'0' + end else + begin + Regs.ax := $1500; { CD-Romlaufwerk } + Regs.bx := $0000; + Intr ($2F,Regs); {Drives BX} {Drive CX} + If (LW>Regs.cx) and (LW<=Regs.cx+Regs.bx) and (Regs.bx>0) then + Drive.Ch:=Drive.Ch+'0' else + Drive.Ch:=Drive.Ch+'1'; + end; + end; + end; +end; + +{-------------------------------------------------------------------------} +PROCEDURE DriveKind(var D: DrRec); +var z,z1 : byte; +begin + If length(D.Dr)>0 then + begin + D.Ch[0]:=D.Dr[0]; + for z:=1 to length(D.Dr) do + for z1:=1 to length(Drive.Dr) do + If upcase(D.Dr[z])=Drive.Dr[z1] then + begin + D.Ch[z]:=Drive.Ch[z1]; break; + end; + {EndIf} + {EndFor} + {EndFor} + end else + begin + D:=Drive; + end; +end; + + +{-------------------------------------------------------------------------} +FUNCTION Chver (P:PathStr) : boolean; +begin + If (P[length(P)]='\') and not ((length(P)=3) and (P[3]='\')) then + Dec(Byte(P[0])); + {$I-}chdir(P);{$I+} + chver:= IOresult=0; Doserror:=0; +end; + +{-------------------------------------------------------------------------} +FUNCTION Getver(Dr:byte;VAR Path:PathStr) : boolean; +begin + {$I-} getdir(dr,path); {$I+} + getver:= Ioresult=0; Doserror:=0; +end; + +{-------------------------------------------------------------------------} +(*FUNCTION Mkver(S:String) : Boolean; +var Verzeichnis : Pathstr; + Verz : string; +begin + getver(0,Verzeichnis); + S:=addbackslash(S); + If length(S) > 1 then + If S[2]=':' then + begin + If not chver(S[1]+':'+'\') then + begin + Mkver:=false; chver(Verzeichnis); exit; + end; + delete(S,1,2); + end; + {EndIF} + If pos('\',S)=1 then delete(S,1,1); + while (S<>'') and (S<>'\') do + begin + Verz :=copy(S,1,pos('\',S)-1); + If not chver(Verz) then + begin + {$I-} mkdir(Verz); {$I+} + If (Ioresult>0) or not chver(Verz) then + begin + Mkver:=false; chver(Verzeichnis); exit; + end; + end; + delete(S,1,pos('\',S)); + end; + chver(Verzeichnis); + Mkver:=true; +end;*) + + +FUNCTION Mkver(S:Pathstr) : Boolean; +const AR : Acceptrec=(' OK ','',''); +var M : Message; +begin + M:='Fehler beim Erstellen des Verzeichnisses:'; + repeat + {$I-} MkDir(S); {$I+} + Mkver:= Inoutres=0; + If (Inoutres=0) and not chver(S) then + begin + IO_Error(M,'IOERROR.MSG',3,AR); Mkver:=false; + end; + until Testerror(M); +end; + + +FUNCTION Rmver(S:PathStr) : Boolean; +var M : Message; +begin + M:='Fehler beim Lschen des Verzeichnisses:'; + repeat + {$I-} RmDir(S); {$I+} + RmVer:= Inoutres=0; + until Testerror(M); +end; + + + +FUNCTION DiskFrei(Drive:Byte) : Longint; +var frei : Longint; +begin + frei:=diskfree(Drive); + If frei=-1 then frei:=0; + DiskFrei:=frei; +end; + + +FUNCTION DiskGrosse(Drive:Byte) : Longint; +var grosse : Longint; +begin + grosse:=diskfree(Drive); + If grosse=-1 then grosse:=0; + DiskGrosse:=grosse; +end; + + +FUNCTION DrvLet_Num(Drive:Char) : Byte; +begin + If ord(Drive)>$40 then + DrvLet_Num:=ord(Drive)-$40 else + DrvLet_Num:=0; +end; + + +BEGIN + DriveInit; +END. \ No newline at end of file diff --git a/UNITS/TKSAA.PAS b/UNITS/TKSAA.PAS new file mode 100644 index 0000000..d13b53a --- /dev/null +++ b/UNITS/TKSAA.PAS @@ -0,0 +1,671 @@ +Unit TKSAA; + +Interface +uses Crt,Kbm,Tkwin,Tkstring,Tkvideo; + + +Const Buttonfo : byte = lightgray; + Buttonba : byte = blue; + ButtonSe : byte = white; + ButtonKe : byte = yellow; + + Editfo : byte = black; + Editba : byte = lightgray; + + +type + + + Buttontyp = Record + X : byte; + Y : byte; + M : Message; + P : byte; + T : Taste; + S : boolean; + end; + + Button = Record + Bu : array [1..26] of Buttontyp; + Anz : byte; + Akt : boolean; + Pos : byte; + FaS : byte; + FaN : byte; + FaH : byte; + Fafen : byte; + Schatten : boolean; + Sel : boolean; + end; + + RaButtontyp = Record + X : byte; + Y : byte; + M : Message; + end; + + RaButton = Record + Rb : array [1..19] of Rabuttontyp; + Anz : byte; + Sel : byte; + Pos : byte; + Akt : boolean; + end; + + SelButtontyp = Record + X : byte; + Y : byte; + M : Message; + S : boolean; + end; + + SelButton = Record + Sb : array [1..10] of SelButtontyp; + Anz : byte; + Pos : byte; + Akt : boolean; + end; + + Edit = Record + X : byte; + Y : byte; + M : String; + P : boolean; + T : String; + la : byte; + Sp : byte; + Pos : byte; + Akt : boolean; + end; + +function MouseEventinBox (Button,x1,y1,x2,y2:byte) : boolean; +procedure Getevent; + +{----------------------- Button ---------------------------} +PROCEDURE Initbutton (var But : Button; X,Y:Integer; M:string;T:Taste; Nr:byte); +PROCEDURE Setbutton (var But : Button); +PROCEDURE Activebutton (var But : Button); +FUNCTION EventThisbutton (var But : Button) : byte; +{----------------------- RadioButton ----------------------} +PROCEDURE InitRadioButton (var RBut : RaButton; X,Y:Integer; M:string; Nr:byte); +PROCEDURE SetRadioButton (var RBut : RaButton); +PROCEDURE ActiveRadioButton (var Rbut : RaButton); +FUNCTION EventRadioButton (var Rbut : RaButton) : boolean; +{----------------------- SelButton ------------------------} +PROCEDURE InitSelButton (var Sbut : SelButton ; X,Y:Integer; M:string; S:boolean; Nr:byte); +PROCEDURE SetSelButton (var SBut : SelButton); +PROCEDURE ActiveSelButton (var SBut : SelButton); +FUNCTION EventSelButton (var SBut : SelButton) : boolean; +{----------------------- Zeileneditor ---------------------} +PROCEDURE InitEditor (var Edi : Edit; X,Y : integer; M : Message; P : boolean; + T : string; la: byte); +PROCEDURE SetEditor (var Edi : Edit); +PROCEDURE ActiveEditor (var Edi : Edit); +FUNCTION EventEditor (var Edi :Edit) : boolean; + +Implementation + + + + + +function MouseEventinBox (Button,x1,y1,x2,y2:byte) : boolean; +begin + If (Button=ev.Ereignis) and + (ev.spalterel+1>=x1) and (ev.spalterel+1<=x2) and + (ev.zeilerel+1 >=y1) and (ev.zeilerel+1 <=y2) and + ((fenanz>0) and (aktber=fenanz)) then + begin + MouseEventinBox:=true; + end else + MouseEventinBox:=false; +end; + + +procedure Getevent; +begin + KbClrevent; + repeat + KbmEventWait( EV_ALL, ev ); + until (ev.Ereignis<>EV_MOU_MOVE) and (ev.Ereignis<>EV_KEY_UNKNOWN) and (ev.Ereignis<>EV_KEY_Status) + or (ev.Buttons in [1,2]); +end; + + + +{---------------------------------- Buttons ---------------------------------} + +procedure Paintbutton(But : Button); +var Nr : byte; + x : byte; +begin + for Nr:=1 to But.anz do + begin + textbackground(But.FaH); + If But.Bu[Nr].S then + begin + If But.Schatten then + begin + textcolor(black); textbackground(But.FaFen); + writeXY(But.Bu[Nr].X,But.Bu[Nr].Y,' '); + for x:=1 to length(But.Bu[Nr].M) do + writeXY(But.Bu[Nr].X+x,But.Bu[Nr].Y+1,' '); + textbackground(But.FaH); + end else + textbackground(But.FaN); + end; + If But.Bu[Nr].S and But.Schatten then + x:=1 else x:=0; + If But.Bu[Nr].P>0 then + begin + If But.Pos=Nr then textcolor(But.Fas) else textcolor(But.FaN); + If But.Akt and But.Schatten and (But.Pos=Nr) then + writeXY(But.Bu[Nr].X+x,But.Bu[Nr].Y,concat('',copy(But.Bu[Nr].M,2,But.Bu[Nr].P-1))) else + writeXY(But.Bu[Nr].X+x,But.Bu[Nr].Y,copy(But.Bu[Nr].M,1,But.Bu[Nr].P-1)); + textcolor(ButtonKe); + writeXY(But.Bu[Nr].X+But.Bu[Nr].P-1+x,But.Bu[Nr].Y,But.Bu[Nr].M[But.Bu[Nr].P]); + If But.Pos=Nr then textcolor(But.Fas) else textcolor(But.FaN); + If But.Akt and But.Schatten and (But.Pos=Nr) then + writeXY(But.Bu[Nr].X+But.Bu[Nr].P+x,But.Bu[Nr].Y, + concat(copy(But.Bu[Nr].M,But.Bu[Nr].P+1,length(But.Bu[Nr].M)-But.Bu[Nr].P-1),'')) else + writeXY(But.Bu[Nr].X+But.Bu[Nr].P+x,But.Bu[Nr].Y,copy(But.Bu[Nr].M,But.Bu[Nr].P+1,length(But.Bu[Nr].M))); + end else + begin + If But.Pos=Nr then textcolor(But.Fas) else textcolor(But.FaN); + writeXY(But.Bu[Nr].X+x,But.Bu[Nr].Y,But.Bu[Nr].M); + end; + If But.Schatten and not But.Bu[Nr].S then + begin + textcolor(black); textbackground(But.FaFen); + writeXY(But.Bu[Nr].X+1,But.Bu[Nr].Y+1,leftpadch('','',length(But.Bu[Nr].M))); + writeXY(But.Bu[Nr].X+length(But.Bu[Nr].M),But.Bu[Nr].Y,''); + end; + end; +end; + + + + +procedure Setbutton(var But : Button); +begin + But.Akt:=false; Paintbutton(But); +end; + + +procedure Activebutton(var But : Button); +begin + But.Akt:=true; Paintbutton(But); + Getevent; +end; + + +procedure Initbutton(var But : Button; X,Y:Integer; M:string; T:Taste; Nr:byte); +begin + But.Bu[Nr].X:=X; But.Bu[Nr].Y:=Y; + But.Bu[Nr].P:=Pos('~',M); + while Pos('~',M)>0 do + delete(M,Pos('~',M),1); + But.Bu[Nr].M:=M;But.Bu[Nr].T:=T; But.Bu[Nr].S:=false; + But.Pos:=1; But.Akt:=false; But.Schatten:=true; But.Fafen:=fenba; + But.FaH:=Buttonba; But.FaS:=ButtonSe; But.FaN:=Buttonfo; +end; + + + +function EventThisbutton (var But : Button ) : byte; +var ze : char; + i : byte; + Nr : byte; +begin + {If (fenanz>0) and (aktber<>fenanz) then exit;} + EventThisbutton:=0; + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + CLEFT : If (But.Pos > 1) and But.Akt then dec(But.Pos); + CRIGHT: If (But.Pos < But.Anz) and But.Akt then inc(But.Pos); + end; + end; + + for Nr:=1 to But.Anz do + begin + ze:=upcase(But.Bu[Nr].M[But.Bu[Nr].P]); + case ev.Ereignis of + EV_KEY_PRESSED : + begin + case ev.key of + CR : If (Nr=But.Pos) then EventThisbutton := Nr; + end; + If (upword(ev.key) = But.Bu[Nr].T) then EventThisbutton := Nr; + end; + EV_LEFT_REL: + begin + If (ev.spalterel+2>But.Bu[Nr].X) and (ev.spalterel+1But.Bu[i].X) and (ev.spalterel+10) and (aktber=fenanz)) then + begin + But.Bu[i].S:=true; + end; + end; + EV_MOU_MOVE : + begin + If ev.Buttons=1 then + If (ev.spalterel+2>But.Bu[Nr].X) and (ev.spalterel+10) and (aktber=fenanz))then + begin + But.Bu[Nr].S:=true; + end else + But.Bu[Nr].S:=false; + end; + end; + end; +end; + + +{----------------------------- RadioButton ----------------------------------} + +procedure PaintRadioButton(RBut : RaButton); +var Nr : byte; +begin + textcolor(fenfo);textbackground(fenba); cursor_off; + For Nr:=1 to Rbut.Anz do + begin + WriteXY(RBut.RB[Nr].X,RBut.RB[Nr].Y,'('); + If RBut.Sel=Nr then + WriteXY(RBut.RB[Nr].X+1,RBut.RB[Nr].Y,#254) else + WriteXY(RBut.RB[Nr].X+1,RBut.RB[Nr].Y,' '); + WriteXY(RBut.RB[Nr].X+2,RBut.RB[Nr].Y,')'); + WriteXY(RBut.RB[Nr].X+3,RBut.RB[Nr].Y,concat(' ',RBut.RB[Nr].M)); + end; +end; + + + +procedure InitRadioButton (var RBut : RaButton; X,Y:Integer; M:string; Nr:byte); +begin + RBut.Rb[Nr].X:=X; RBut.Rb[Nr].Y:=Y; RBut.Rb[Nr].M:=M; RBut.Pos:=1; RBut.Akt:=true; +end; + + + +procedure SetRadioButton (var RBut : RaButton); +begin + If RBut.Akt then PaintRadioButton(RBut); RBut.Akt:=false; +end; + + + +procedure ActiveRadioButton (var RBut : RaButton); +begin + PaintRadiobutton(Rbut); Rbut.Akt:=true; + gotoxy(RBut.RB[RBut.Pos].X+1,RBut.RB[RBut.Pos].Y); cursor_on; + Getevent; cursor_off; +end; + + +function EventRadioButton (var Rbut : RaButton) : boolean; +var i:byte; +begin + EventRadioButton:=false; + case ev.Ereignis of + EV_KEY_PRESSED : + If Rbut.Akt then + case ev.key of + SPACE : begin + Rbut.Sel := Rbut.Pos; + EventRadioButton:=true; + end; + CDOWN : begin + If Rbut.Pos1 then dec(Rbut.Pos) else Rbut.Pos:=Rbut.Anz; + EventRadioButton:=true; + end; + end; + end; + If ((fenanz>0) and (aktber=fenanz)) then + case ev.Ereignis of + EV_LEFT_REL : + begin + for i:=1 to Rbut.anz do + begin + If (ev.spalterel+2Rbut.Rb[i].X) and + (ev.zeilerel+1=RBut.Rb[i].Y) then + begin + EventRadioButton:=true; Rbut.Sel:=i; + end; + end; + end; + EV_LEFT_PRESS : + begin + for i:=1 to Rbut.anz do + If (ev.spalterel+2Rbut.Rb[i].X) and + (ev.zeilerel+1=RBut.Rb[i].Y) then + begin + EventRadioButton:=true; Rbut.Pos:=i; + end; + end; + end; +end; + + +{----------------------------------- SelButton ------------------------------} + +procedure PaintSelButton (SBut : SelButton); +var Nr : byte; +begin + textcolor(fenfo);textbackground(fenba); cursor_off; + For Nr:=1 to Sbut.Anz do + begin + WriteXY(Sbut.SB[Nr].X,Sbut.SB[Nr].Y,'['); + If Sbut.Sb[Nr].S then + WriteXY(Sbut.SB[Nr].X+1,Sbut.SB[Nr].Y,'x') else + WriteXY(Sbut.SB[Nr].X+1,Sbut.SB[Nr].Y,' '); + WriteXY(Sbut.SB[Nr].X+2,Sbut.SB[Nr].Y,']'); + WriteXY(Sbut.SB[Nr].X+3,Sbut.SB[Nr].Y,concat(' ',Sbut.SB[Nr].M)); + end; +end; + + +procedure InitSelButton (var Sbut : SelButton; X,Y:Integer; M:string; S: boolean; Nr:byte); +begin + SBut.Sb[Nr].X:=X; SBut.Sb[Nr].Y:=Y; SBut.Sb[Nr].M:=M; Sbut.Sb[Nr].S:=S; SBut.Pos:=1; + SBut.Akt:=true; +end; + + +procedure SetSelButton (var SBut : SelButton); +begin + If Sbut.Akt then PaintSelButton(SBut); Sbut.Akt:=false; +end; + +procedure ActiveSelButton (var SBut : SelButton); +begin + PaintSelButton(Sbut); Sbut.Akt:=true; + gotoxy(SBut.SB[SBut.Pos].X+1,SBut.SB[SBut.Pos].Y); cursor_on; + Getevent; cursor_off; +end; + + + +function EventSelButton (var SBut : SelButton) : boolean; +var i : byte; +begin + EventSelButton:=false; + case ev.Ereignis of + EV_KEY_PRESSED : + If Sbut.Akt then + case ev.key of + SPACE : begin + If Sbut.Sb[Sbut.Pos].S then Sbut.Sb[Sbut.Pos].S:=false else Sbut.Sb[Sbut.Pos].S:=true; + EventSelButton:=true; + end; + CDOWN : begin + If Sbut.Pos1 then dec(Sbut.Pos) else Sbut.Pos:=Sbut.Anz; + EventSelButton:=true; + + end; + end; + end; + If ((fenanz>0) and (aktber=fenanz)) then + case ev.Ereignis of + EV_LEFT_REL : + begin + for i:=1 to Sbut.anz do + begin + If (ev.spalterel+2Sbut.Sb[i].X) and + (ev.zeilerel+1=SBut.Sb[i].Y) then + begin + EventSelButton:=true; If Sbut.Sb[i].S then Sbut.Sb[i].S:=false else Sbut.Sb[i].S:=true; + end; + end; + end; + EV_LEFT_PRESS : + begin + for i:=1 to Sbut.anz do + If (ev.spalterel+2Sbut.Sb[i].X) and + (ev.zeilerel+1=SBut.Sb[i].Y) then + begin + EventSelButton:=true; Sbut.Pos:=i; + end; + end; + end; +end; + +{---------------------------------- Editor ----------------------------------} + + +procedure PaintEditor(Edi : Edit); +begin + textcolor(fenfo); textbackground(fenba); + If Edi.P then writeXY ((Edi.X-length(Edi.M)-1),Edi.Y,Edi.M) else + writeXY (Edi.X, Edi.Y-1, Edi.M); + textcolor(Editfo); textbackground(Editba); + writeXY(Edi.X, Edi.Y, pad(Edi.T,Edi.la+1)); +end; + + +procedure InitEditor (var Edi : Edit; X,Y : integer; M : Message; P : boolean; + T : string; la: byte); +begin + Edi.X:=X; Edi.Y:=Y; + If length(T)>la then delete(T,la+1,length(T)-la); + Edi.M:=M; Edi.P:=P; + Edi.T:=T; Edi.Pos:=length(T)+1; Edi.La:=la; + Edi.Akt:=true; +end; + + +procedure SetEditor (var Edi : Edit); +begin + If Edi.Akt then PaintEditor (Edi); Edi.Akt:=false; +end; + + +procedure ActiveEditor (var Edi : Edit); +var mla,i : byte; + ch : array [1..80] of char; + +begin + textcolor(Editfo); textbackground(Editba); + + for i:=1 to Edi.la do + ch[i]:=Edi.T[i]; + + mla:= length(Edi.T); + Edi.Sp:=Edi.X+Edi.Pos-1; + gotoxy(Edi.Sp,Edi.Y); + if einf = true then Cursor_Set(18) else Cursor_On; + repeat + Getevent; + + If ev.Ereignis=EV_KEY_PRESSED then + begin + + if ev.key=INSERTKEY then { Einf } + begin + if einf=false then + begin + einf:=true; + Cursor_Set(18); + end else + begin + einf:=false; + Cursor_On; + end; + end; + + if (Edi.Pos<=Edi.la) and ( (ev.key>31) and (ev.key<127) + or (ev.key=129) or (ev.key=132) or (ev.key=142) or (ev.key=148) or (ev.key=153) or (ev.key=154) ) + or (ev.key=225) then + begin + if (not einf) then + begin + for i:=mla downto Edi.Pos do + begin + ch[i+1]:=ch[i]; + if i 1 then + begin + ch[mla+1]:=' '; + for i:=Edi.Pos-1 to mla do + begin + ch[i]:=ch[i+1]; + writeXY(Edi.Sp+i-Edi.Pos,Edi.Y,ch[i]); + end; + dec(mla);dec(Edi.Pos);dec(Edi.Sp); + gotoxy(Edi.Sp,Edi.Y); + end; + end; + + if ev.key=CLEFT then { Links } + begin + if (Edi.Pos > 1) then + begin + dec(Edi.Pos);dec(Edi.Sp);gotoxy(Edi.Sp,Edi.Y); + end; + end; + + if ev.key=CRIGHT then { Rechts } + begin + if Edi.Pos <= mla then + begin + inc(Edi.Pos);inc(Edi.Sp);gotoxy(Edi.Sp,Edi.Y); + end; + end; + + if ev.key=DELETEKEY then { Entf } + begin + ch[mla+1]:=' '; + for i:=Edi.Pos to mla do + begin + ch[i]:=ch[i+1]; + writeXY(Edi.Sp+i-Edi.Pos,Edi.Y,ch[i]); + end; + If Edi.Pos <= mla then dec(mla); + gotoxy(Edi.Sp,Edi.Y); + end; + + if ev.key=CHOME then { Home } + begin + Edi.Sp:=Edi.Sp-Edi.Pos+1; + gotoxy(Edi.Sp,Edi.Y); + Edi.Pos:=1; + end; + + if ev.key=CEND then { End } + begin + Edi.Sp:=Edi.Sp+mla-Edi.Pos+1; + gotoxy(Edi.Sp,Edi.Y); + Edi.Pos:=mla+1; + end; + end; + + until (ev.key=CR) or (ev.key=CUP) or (ev.key=CDOWN) or (ev.key=TAB) or (ev.key=ESC) or + (ev.key=CPGUP) or (ev.key=CPGDN) or (ev.key=BACKTAB) or ((ev.key>=315) and (ev.key<=324) or + (ev.Buttons in [1,2]) or (ev.Ereignis=EV_LEFT_REL) or (ev.key>=ALT_Q) and (ev.key<=ALT_M)); + Edi.T:=''; + for i:=1 to mla do + begin + Edi.T:=(concat(Edi.T,ch[i])); + end; + Cursor_Off; Edi.Akt:=true; +end; + + +function EventEditor (var Edi: Edit) : boolean; +begin + EventEditor:=false; + case ev.Ereignis of + EV_KEY_PRESSED : + begin + If Edi.Akt then EventEditor:=true; + end; + end; + If ((fenanz>0) and (aktber=fenanz)) then + case ev.Ereignis of + EV_LEFT_REL: + begin + If (ev.spalterel+2>Edi.X) and (ev.spalterelEdi.X) and (ev.spalterelEdi.X) and (ev.spalterelEdi.X) and (ev.spalterelEdi.X) and (ev.spalterel+1=Edi.X+length(Edi.T)) then + begin + Edi.Pos:=length(Edi.T)+1; + end; + If (ev.spalterel+2<=Edi.X) then + begin + Edi.Pos:=1; + end; + end; + end; + end; + +end; + + + +begin +end. + + diff --git a/UNITS/TKSTREAM.PAS b/UNITS/TKSTREAM.PAS new file mode 100644 index 0000000..ec1832e --- /dev/null +++ b/UNITS/TKSTREAM.PAS @@ -0,0 +1,418 @@ +unit TKstream; +Interface +Uses Dos,Crt,Tkstring,Tkwin,Kbm,Tksaa,Tkvideo; + +Const + Message4Col : byte = yellow; + Om = 'Fehler beim ffnen von '; + Crm = 'Fehler beim Anlegen von '; + Rm = 'Fehler beim Lesen aus '; + Wm = 'Fehler beim Schreiben in '; + Cm = 'Fehler beim Schlieen von '; + Em = 'Fehler beim Lschen von '; + +Type + Acceptrec = array[1..3] of string[25]; + + +Urstream = Object + Openmsg : Message; + Createmsg: Message; + Readmsg : Message; + WriteMsg : Message; + Closemsg : Message; + Erasemsg : Message; + OK : Boolean; + {Streamerror: Integer;} + Result : word; + Constructor Init (Name : Pathstr); + Destructor Done; Virtual; + procedure Close; Virtual; + procedure Reseterror; + function Isok : boolean; + + {Function Streamresult : Integer;} + End{Object Urstream}; + +Textstream = Object(Urstream) + F : Text; + Constructor Init (Name : Pathstr); + procedure Open; Virtual; + procedure Create; Virtual; + procedure Close; Virtual; + procedure Append; Virtual; + procedure Readln (var S:String); Virtual; + procedure Writeln(S:string); Virtual; + function Eof : boolean; + procedure DelFile; Virtual; + End{Object Textstream}; +TypedStream = Object(Urstream) + F : File; + Recsize : Word; + Constructor Init (Name : Pathstr;Rsize: Word); + procedure Open; Virtual; + procedure Create; Virtual; + procedure Close; Virtual; + procedure Read(var R; P: Longint; Anz: Word); Virtual; + procedure Write(var R; P: Longint; Anz: Word); Virtual; + procedure Remove(P: Longint; Anz: Longint); Virtual; + procedure Seek(P: Longint); Virtual; + function Eof : Boolean; Virtual; + function Pos : Longint; Virtual; + function Size: Longint; Virtual; + procedure DelFile; Virtual; + End{Object TypedStream}; + + +Function Testerror(var M :Message): Boolean; + +function IO_Error(M: Message; Name: filenameStr; IO_R: integer; Ar: Acceptrec) : byte; + + +Implementation + +{----------------------- Fehlerprozeduren------------------------------} + + +function IO_Error(M: Message; Name: filenameStr; IO_R: integer; Ar: Acceptrec) : byte; +var T : text; + zeile : string; + Banz,i,la : byte; + Bu : Button; + weiter : boolean; + IO_Str : string; + z,l : byte; + Verz : pathstr; + found : boolean; + +begin { Datei } + str(IO_R,IO_Str); Doserror:=0; i:=IOresult; + If pos('.',Name)=0 then Name:=trim(justname(Name))+'.err'; + Verz:=addbackslash(justpathname(paramstr(0)))+Name; + assign(T,Verz); + {$I-} reset(T); found:=false; + while not EOF(T) and (Doserror=0) do + begin + readln(T,Zeile); + If trim(copy(Zeile,1,pos(':',zeile)-1)) = IO_Str then + begin + delete(Zeile,1,pos(':',zeile)); Zeile:=trim(Zeile); found:=true; break; + end; + end; close(T);{$I+} i:=Ioresult; Doserror:=0; + If not found then + Zeile:=concat('Fehlercode: ',IO_Str); + If length(Zeile) > Messlange then delete(Zeile,Messlange,length(Zeile)-Messlange+1); + If not openwindow(Messlange-2,4,fen2fo,fen2ba,'Fehler') then exit; + textcolor(Message4Col); + writexy(2,1,M); + writeXY(1,2,center(Zeile,Messlange)); + Banz:=0;la:=2; + for i:=1 to 3 do + If Ar[i]>'' then + begin + inc(Banz); + inc(la,length(Ar[i])+4); + end; + la:=(Messlange Div 2) - (la Div 2); + inc(la,4); + for i:=1 to 3 do + begin + If Ar[i]>'' then + begin + InitButton(Bu,la,4,Ar[i],EV_NO_EVENT,i); + inc(la,length(Ar[i])+4); + end; + end; + Bu.anz:=Banz; Bu.FaFen:=fen2ba; + I:=1; weiter:=false; + repeat + Setbutton(Bu); + Activebutton(Bu); + L:=EventThisbutton(Bu); + for z:=1 to Banz do + If L=Z then + begin + weiter:=true; break; + end; + If ev.Ereignis=EV_KEY_PRESSED then + case ev.key of + CLEFT : If I>1 then dec(I) else I:=Banz; + CRIGHT : If I1); +end; + + + +{------------------------ Dateiprozeduren -----------------------------} + +Constructor Urstream.Init(Name: Pathstr); +begin + Openmsg := concat(Om ,ShrinkPath(Name,Messlange-length(Om) -3)); + Createmsg:= concat(Crm ,ShrinkPath(Name,Messlange-length(Crm)-3)); + Readmsg := concat(Rm ,ShrinkPath(Name,Messlange-length(Rm) -3)); + WriteMsg := concat(Wm ,ShrinkPath(Name,Messlange-length(Wm) -3)); + CloseMsg := concat(Cm ,ShrinkPath(Name,Messlange-length(Cm) -3)); + Erasemsg := concat(Em ,ShrinkPath(Name,Messlange-length(Em) -3)); + Ok:=true; +end; + + + +Destructor Urstream.Done; +begin + Close; +end; + + +Procedure Urstream.Close; +begin +end; + +procedure Urstream.Reseterror; +begin Ok := True; End; + + +function Urstream.Isok : boolean; +begin Isok := Ok; End; + + + +{-----------Textstream Behandlung von Textdateien------------} + +Constructor Textstream.Init(Name : Pathstr); +begin + Urstream.Init(Name); + Assign(F,Name); +end; + +procedure Textstream.open; +begin + repeat + {$I-} Reset(F); {$I+} + Ok := Inoutres=0; + until Testerror(openmsg); +end; + + +procedure Textstream.Create; +begin + repeat + {$I-} Rewrite(F); {$I+} + OK := Inoutres=0; + until Testerror(createmsg); +end; + + +procedure Textstream.close; +begin + repeat + {$I-} If Textrec(F).Mode <> FmClosed then + System.close(F); {$I+} + Ok:= Inoutres=0; + until Testerror(closemsg); +end; + +procedure Textstream.append; +begin + repeat + {$I-} System.Append(F) {$I+}; + Ok:=Inoutres=0; + until Testerror(openmsg); +end; + +procedure Textstream.Readln(var S: String); +begin + repeat + {$I-} System.readln(F, S); {$I+} + OK := Inoutres=0; + until testerror(readmsg); +end; + +procedure Textstream.writeln(S:String); +begin + repeat + {$I-} System.Writeln(F,S); {$I+} + OK := Inoutres=0; + until Testerror(writeMsg); +end; + +function Textstream.Eof : boolean; +begin + repeat + {$I-} Eof := System.Eof(F); {$I+} + OK := Inoutres=0; + until Testerror(readmsg); + If not Ok then Eof:=true; +end; + +procedure Textstream.DelFile; +begin + repeat + {$I-} Erase(F); {$I+} + OK := Inoutres=0; + until Testerror(Erasemsg); +end; + + +{--------------allgem. Object fr typisierte Dateien---------------} +Constructor Typedstream.Init(Name : Pathstr; Rsize: Word); +begin + urstream.Init(name); + assign(F, Name); + Recsize := RSize; +end; + +procedure Typedstream.Open; +begin + repeat + {$I-} Reset(F, Recsize); {$I+} + OK := Inoutres=0; + until Testerror(Openmsg); +end; + +procedure Typedstream.Create; +begin + repeat + {$I-} Rewrite(F,Recsize); {$I+} + OK := Inoutres=0; + until Testerror(createmsg); +end; + +procedure Typedstream.Close; +begin + repeat + {$I-} If (Filerec(F).Mode = fmInput) or (Filerec(F).Mode = fmInOut) then + System.close(f); {$I+} + OK := Inoutres=0; + until testerror(Closemsg); +end; + + +procedure Typedstream.read(var R; P: Longint; Anz: Word); +begin + If P = -1 then P:=Pos; {sequentielles Lesen} + If OK then + repeat + seek(P); + {$I-} Blockread (F, R, Anz, Result); {$I+} + If (Inoutres=0) and (Result < Anz) then Inoutres:=100; + Ok := Inoutres=0; + until testerror(readmsg); + {EndIf} +end; + +procedure Typedstream.Write(var R; P: Longint; Anz: Word); +begin + If P = -1 then P:=Pos; {sequentielles Schreiben} + If OK then + repeat + seek(P); + {$I-} Blockwrite(F, R, Anz, Result); {$I+} + If (Inoutres=0) and (Result < Anz) then Inoutres:=101; + Ok := Inoutres=0; + until Testerror(writemsg); + {End IF} +end; + + +procedure Typedstream.Remove(P:Longint; Anz: Longint); +const AR : Acceptrec=(' Ok ','',''); +var + I : Longint; + B : Pointer; + M : Message; +begin + M:='Datei kann nicht gekrzt werden !'; + Getmem(B, FileRec(F).Recsize); + If B =Nil then begin + I:=IO_Error(M,'IOERROR.MSG',203,AR); + OK:=False; + Exit; + End{If}; + I:=P+Anz; Seek(I); + while (not eof) and OK do begin + read(B^,I,1); + If OK then Write(B^,I-Anz,1); + Inc(I); Seek(I); + end{While}; + If Ok then Begin + I:=Size-Anz; + repeat + seek(I); {$I-} Truncate(f); {$I+} + OK := Inoutres=0; + until Testerror(M); + seek(P); + End{IF}; + Freemem(B,Filerec(F).Recsize); +end; + + +procedure TypedStream.Seek(P : Longint); +begin + repeat + {$I-} System.Seek(F, P); {$I+} + OK:=InoutRes =0; + until Testerror(Readmsg); +end; + + +function Typedstream.Eof : boolean; +begin + repeat + {$I-} Eof :=System.Eof(f); {$I+} + OK := Inoutres=0; + until TestError(Readmsg); + If not OK then Eof:=true; +end; + + +function Typedstream.Pos : Longint; +begin + repeat + {$I-} Pos:=System.Filepos(F); {$I+} + OK := Inoutres=0; + until Testerror(Readmsg); + If not OK then Pos:=0; +end; + + +function Typedstream.Size : longint; +begin + repeat + {$I-} Size:=System.Filesize(F); {$I+} + OK := Inoutres=0; + until Testerror(readmsg); + If not OK then Size:=0; +end; + + +procedure Typedstream.DelFile; +begin + repeat + {$I-} Erase(F); {$I+} + OK := Inoutres=0; + until Testerror(Erasemsg); +end; + + +{---------------------- Dos-Funktionen --------------------------------} + + +begin +end. + + + + + diff --git a/UNITS/TKVIDEO.PAS b/UNITS/TKVIDEO.PAS new file mode 100644 index 0000000..bb0a4f4 --- /dev/null +++ b/UNITS/TKVIDEO.PAS @@ -0,0 +1,411 @@ +Unit Tkvideo; + +Interface + + USES Crt, Dos, kbm ; + + const + einf : boolean=false; + Farbe : Byte = 1; {Arrayposition} + + var OrigMode : BYTE; + MonoChr : Boolean; + + TYPE RecArray = ARRAY [1..192] of Byte; + RegArray = ARRAY [1..2] OF RecArray; + + Time = Record + Hour:Word; + Min :Word; + Sec :Word; + HSec:Word; + End; + + + +FUNCTION Schirmanfang: Longint; +PROCEDURE TKclrscr; + +{-------- Ein/Ausblendfunktionen ---------} +PROCEDURE Einblenden; +PROCEDURE Ausblenden; +PROCEDURE BlackScreen; +PROCEDURE ProgColors(Color:Byte); + +{--------- Cursorfunktionen --------------} +PROCEDURE Cursor_ON; +PROCEDURE Cursor_OFF; +PROCEDURE Cursor_Set(C : Word); + + + +Implementation + + + + +CONST BlendDauer : WORD = 3; {in HSec} + M : WORD = 0; + FarbArray : RegArray = ((0 , 0 , 0 , {SCHWARZ , 0, 0, 0} + 0 , 0 , 30 , {BLAU , 0, 0, 42} + 0 , 42 , 0 , {GRN , 0, 42, 0} + 0 , 42 , 42 , {ZYAN , 0, 42, 42} + 42 , 0 , 0 , {ROT , 42, 0, 0} + 42 , 0 , 42, {MAGENTA , 42, 0, 42} + 42 , 42 , 0 , {BRAUN , 42, 42, 0} + 42 , 42 , 42 , {HELLGRAU , 42, 42, 42} + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 42 , 21 , 0 , { Maus, Background , 42, 21, 0} + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 21 , 21 , 21 , {DUNKELGRAU , 21, 21, 21} + 21 , 21 , 63 , {HELLBLAU , 21, 21, 63} + 21 , 63 , 21 , {HELLGRN , 21, 63, 21} + 21 , 63 , 63 , {HELLZYAN , 21, 63, 63} + 63 , 21 , 21 , {HELLROT , 63, 21, 21} + 63 , 21 , 63 , {HELLMAGENTA, 63, 21, 63} + 63 , 63 , 21 , {GELB , 63, 63, 21} + 63 , 63 , 63 ), {Wei , 63, 63, 63} + + (0 , 0 , 0 , {SCHWARZ , 0, 0, 0} + 0 , 0 , 42 , {BLAU , 0, 0, 42} + 0 , 24 , 0 , {GRN , 0, 42, 0} + 0 , 42 , 42 , {ZYAN , 0, 42, 42} + 42 , 0 , 0 , {ROT , 42, 0, 0} + 42 , 0 , 42, {MAGENTA , 42, 0, 42} + 42 , 42 , 0 , {BRAUN , 42, 42, 0} + 42 , 42 , 42 , {HELLGRAU , 42, 42, 42} + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 42 , 21 , 0 , { Maus, Background , 42, 21, 0} + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 0 , 0 , 0 , + 21 , 21 , 21 , {DUNKELGRAU , 21, 21, 21} + 21 , 21 , 63 , {HELLBLAU , 21, 21, 63} + 21 , 63 , 21 , {HELLGRN , 21, 63, 21} + 21 , 63 , 63 , {HELLZYAN , 21, 63, 63} + 63 , 21 , 21 , {HELLROT , 63, 21, 21} + 63 , 21 , 63 , {HELLMAGENTA, 63, 21, 63} + 63 , 63 , 21 , {GELB , 63, 63, 21} + 63 , 63 , 63 )); {Wei , 63, 63, 63} + + + +VAR UrspArray, + AusbArray : RecArray; + Counter,C2 : BYTE; + Regs : Registers; + ExitOld : pointer; { Zeiger auf die alte Exit-Prozedur } + schirm : Pointer; + cur_set : word; + Start,Stop : Time; + zahler : word; + +FUNCTION Schirmanfang: Longint; +begin + if lastmode = 7 then + Schirmanfang := $b000 + else + Schirmanfang := $b800; +end; + + + +PROCEDURE TKclrscr; +var ofs,qofs,zofs:integer; + vioseg :longint; + z,r : byte; +begin + vioseg:=Schirmanfang; + for r:=0 to crtymax-1 do + begin + for z:=crtymax downto r do + begin + for ofs:=0 to crtxmax-1 do + begin + qofs:=( ((z-1)*crtxmax+ofs)*2 ); + zofs:=( ((z)*crtxmax+ofs)*2); + If z>0 then + begin + mem[vioseg:zofs+1]:=mem[vioseg:qofs+1]; + mem[vioseg:zofs]:=mem[vioseg:qofs]; + end else begin + mem[vioseg:zofs+1]:=7; + mem[vioseg:zofs]:=0; + end; + end; + end; + delay(1); + end; + window(1,1,crtxmax,crtymax); + gotoxy(1,1);textbackground(black); textcolor(lightgray); +end; + + +{--------------------- Ein/Ausblendfunktionen ---------------} + + + +PROCEDURE Dauer(Sta,Sto : Time); +var T,D : word; +BEGIN + inc(Zahler); + T:=((Sto.Min*600+Sto.Sec*100+Sto.HSec)- + (Sta.Min*600+Sta.Sec*100+Sta.HSec))*10; + If T(BlendDauer*Zahler-T) then + begin + dec(M,BlendDauer*Zahler-T); + end else + begin + delay((BlendDauer*Zahler-T)-M); + end; + end else + begin + D:=T-BlendDauer*Zahler; + inc(M,D); + If M>BlendDauer then dec(M,BlendDauer) else + delay(BlendDauer-M); + end; +END; + +PROCEDURE PushRegs; +BEGIN + Regs.AX:=$1017; + Regs.BX:=0; + Regs.CX:=64; + Regs.ES:=Seg(UrspArray); + Regs.DX:=Ofs(UrspArray); + Intr($10, Regs); +END; + +PROCEDURE PopRegs(PopArray : RecArray); +BEGIN + Regs.AX:=$1012; + Regs.BX:=0; + Regs.CX:=64; + Regs.ES:=Seg(PopArray); + Regs.DX:=Ofs(PopArray); + Intr($10, Regs); +END; + +PROCEDURE BlackScreen; +BEGIN + FOR Counter:=1 TO 192 DO AusbArray[Counter]:=0; + Regs.AX:=$1012; + Regs.BX:=0; + Regs.CX:=64; + Regs.ES:=Seg(AusbArray); + Regs.DX:=Ofs(AusbArray); + Intr($10, Regs); +END; + +PROCEDURE ProgColors(Color:Byte); +BEGIN + Farbe:=Color; + Regs.AX:=$1012; + Regs.BX:=0; + Regs.CX:=64; + Regs.ES:=Seg(FarbArray[Farbe]); + Regs.DX:=Ofs(FarbArray[Farbe]); + Intr($10, Regs); +END; + + +PROCEDURE Ausblenden; +VAR Weiter : BOOLEAN; + Regs : Registers; +BEGIN + IF OrigMode in [1..6,9] THEN BEGIN + AusbArray:=FarbArray[Farbe]; + M:=0; zahler:=0; + with Start do + GetTime (Hour,Min,Sec,Hsec); + REPEAT + Weiter:=FALSE; + FOR Counter:=1 TO 192 DO + IF AusbArray[Counter]>0 THEN BEGIN + Weiter:=TRUE; + Dec(AusbArray[Counter]); + END; + Regs.AX:=$1012; + Regs.BX:=0; + Regs.CX:=192; + Regs.ES:=Seg(AusbArray); + Regs.DX:=Ofs(AusbArray); + Intr($10, Regs); + with Stop do + GetTime (Hour,Min,Sec,Hsec); + Dauer(Start,Stop); + UNTIL NOT Weiter; + END; + TextBackground(Black); + TextColor(Lightgray); + window(1,1,crtxmax,crtymax); + ClrScr; + PopRegs(UrspArray); +END; + + +PROCEDURE Einblenden; +CONST HighVar : BYTE = 0; + +VAR Weiter : BOOLEAN; + +BEGIN + IF OrigMode<>7 THEN BEGIN + FOR Counter:=1 TO 192 DO IF HighVar Fehler} + CtrlCode : Word; + Constructor Init(XMin,YMin,XMax,YMax : Byte); + Procedure AppendLine(S : OutString; X,leng : byte; jump: word); Virtual; + Procedure SortListe(Pos :byte); Virtual; + Procedure OutLine(P: HeapLine; Y, Attr : Byte); {intern} + Procedure OutListe; Virtual; {Ausg. aktuelle Seite} + Procedure LineUp; Virtual; + Procedure LineDown; Virtual; + Procedure LinePgUp; Virtual; + Procedure LinePgDn; Virtual; + Procedure LineTop; Virtual; + Procedure LineLast; Virtual; + Procedure SetLinePS(L : Word); Virtual; + Procedure CtrlLines; Virtual; + Procedure ViewLines; Virtual; {Anzeige. mit Rollen} + Function IsOK : Boolean; {Fehlertest + Reset OK} + Function GetLine(L:Word) : OutString; Virtual; + Function GetLineNumber : Word; {Ret.Nr.d.selektierten Z.} + Procedure ClrLine (L:Word); + Procedure ClrListe; Virtual; {Heapkette lschen} + Destructor Done; + End{Object ListView0}; + + + {--------- Objekt zur Auswahl aus einer Liste ----------} + + SelectView0 = Object(Listview0) + SetBalken : Boolean; + + DKlick, + SelEnde : Boolean; + SelectPtrOld, + SelectPtr : HeapLine; {Ptr. auf ausgew. Zeile} + MarkActive : boolean; + SelectLineOld, + SelectLine : Word; {Nr.d.ausgew. Zeile, + 0 ==> Keine ausgew.} + Constructor Init(XMin,YMin,XMax,YMax,Scrba : Byte); + Procedure OutLine(P: HeapLine; Y:byte; sel:boolean); {intern} + Procedure OutListe; Virtual; + Procedure OutBalken; Virtual; + Procedure LineUp; Virtual; + Procedure LineDown; Virtual; + Procedure LineTop; Virtual; + Procedure LineLast; Virtual; + Procedure LinePgUp; Virtual; + Procedure LinePgDn; Virtual; + Procedure SetLinePS(L : Word); Virtual; + Procedure CtrlLines; Virtual; + Procedure ViewLines; Virtual; {Anzeige. mit Rollbalken} + Procedure SetMarkMode(A: Boolean); + Procedure Mark; + Procedure WrXY(X,Y: byte; S: string; sele : boolean); + Procedure AppendHelp(S: OutString; jump: word); + Function GetJumpNumber : Word; {Ret.Jump.d.selektierten Z.} + Function GetLineNumber : Word; {Ret.Nr.d.selektierten Z.} + Function GetSelLine : OutString;{Ret. selektierte Zeile} + Procedure DelLine; + Procedure ClrListe; Virtual; + Destructor Done; + End{SelectView0}; + + Selectview1=Object(Selectview0) + Procedure AppendStr (S : OutString); + Function GetLine(L:Word) : OutString; Virtual; + Function GetSelLine : Outstring; + End{SelectView1}; +{---------- Funktion zum Erkennen eines Doppelklick mit der Maus -----} +Function DoppelKlick : Boolean; + +Implementation +{==============================================================} +const ti : longint =0; {Variablen fr Doppelklick} + ze : word =0; + + +Function DoppelKlick : Boolean; +Begin + Doppelklick:=false; + If ev.ereignis=EV_Left_Press then + begin + If ((ev.Zeit-ti)<7) and (ev.zeilerel=ze) then + begin + Doppelklick:=true; + end; + ti:=ev.Zeit; + ze:=ev.zeilerel; + end; +end; + + +{------------------ Laufleiste ------------------------} + +Constructor LaufLeiste.Init(XMin, YMin, YMax : Byte); +Begin + PosX := XMin; PosY := YMin; PosY2 := YMax; + IndexPos := 0; LaufPos:=1; Lines := 0; +End; + + +Procedure LaufLeiste.SetLines(L : Word); +Begin + Lines := L; +End; + + +Procedure LaufLeiste.OutLaufleiste; +Var + I : Word; +Begin + textcolor(Balkenf); textbackground(Balkenb); + WriteXY(PosX, PosY, #24); + For I := PosY+1 To PosY2-1 Do + If I <> IndexPos+PosY then + WriteXY(PosX, I, #177); + {EndIF} + {EndFor} + WriteXY(PosX, PosY2, #25); + SetLaufindex(LaufPos); +End; + + +Procedure LaufLeiste.SetLaufindex(L : Word); +Var + I, MaxIX : Real; + I2 : LongInt; + diff : byte; +Begin + textcolor(Balkenf); textbackground(Balkenb); + {----- neue Position berechnen -----} + IF (Pred(Lines) > (PosY2-PosY)) and (Lines>0) Then Begin + If (Lines-L) < (PosY2 - PosY) then + diff := (PosY2 - PosY) -(Lines-L) + else diff:=0; + MaxIX := PosY2 - PosY - 2; + I := ((MaxIX * Pred(L)) / Pred(Lines-(PosY2-PosY)+diff)) + 1; + End + Else + I := 0 + {EndIF}; + I2 := Round(I); + IF IndexPos <> I2 Then Begin + {----- alten Laufindex lschen -----} + IF IndexPos <> 0 Then + WriteXY(PosX, PosY+IndexPos, #177); + {EndIF} + IndexPos := I2; + {----- neuen Laufindex setzen -----} + IF IndexPos <> 0 Then + WriteXY(PosX, PosY+IndexPos, #254); + {EndIF} + End{IF}; + LaufPos:=L; +End; + + +Function LaufLeiste.GetPos : Word; +Var + X, Y : Word; + I, L, MaxIX : real; + L2 : LongInt; + OldIX: Byte; + Label Ende; +Begin + GetPos := 0; + {----- Mausklick in der Laufleiste -----} + IF MouseEventInBox(EV_LEFT_PRESS, PosX, PosY, PosX, PosY) Then Begin + Ev.CtrlCode := CUp; Mouse:=true; Goto Ende; + End{IF}; + IF MouseEventInBox(EV_LEFT_PRESS, PosX, PosY2, PosX, PosY2) Then Begin + Ev.CtrlCode := CDown; Mouse:=true; Goto Ende; + End{IF}; + IF MouseEventInBox(EV_LEFT_PRESS, PosX, PosY+1, PosX, IndexPos+PosY-1) Then Begin + Ev.CtrlCode := CPgUp; Mouse:=true; Goto Ende; + End{IF}; + IF MouseEventInBox(EV_LEFT_PRESS, PosX, IndexPos+PosY+1, PosX, PosY2-1) Then Begin + Ev.CtrlCode := CPgDn; Mouse:=true; Goto Ende; + End{IF}; + {----- Laufindex mit der Maus ziehen ? -----} + IF MouseEventinBox(EV_LEFT_PRESS, PosX, IndexPos+PosY, PosX, IndexPos+PosY) + Then Begin + While AktBut=1 Do Begin + X := AktX+1; Y:=AktY+1; + IF (X = PosX+lo(WindMin)) and (Y > PosY+hi(WindMin)) and + (Y < PosY2+hi(WindMin)) Then Begin + I := Y - hi(WindMin) - PosY-1; + MaxIX := PosY2 - PosY - 2; + L := ((I * Pred(Lines-(PosY2-PosY))) / MaxIX) + 1; + L2 := Round(L); + SetLaufindex(L2); + GetPos := L2; + End{IF}; + End{While}; + End; + Ende : +End; + + +Destructor LaufLeiste.Done; +Begin +End; + +{---------- Methoden Objekt zur Listenausgabe ------------} +Constructor ListView0.Init(XMin, YMin, XMax, YMax : Byte); +Begin + LaufLeiste.Init(XMax, YMin, YMax); + StartLine := NIL; PS := NIL; PSLast := NIL; + AktLine := 0; OK := True; Scrollf:=Scrollfo; Scrollb:=Scrollba; + X1 := XMin; Y1 := YMin; X2 := XMax; Y2 := YMax; +End; + + +Procedure ListView0.AppendLine(S : OutString; X,leng : byte; jump: word); +const AR : Acceptrec = (' OK ','',''); +Var + P, P1 : HeapLine; + SH : HeapString; + Scut : Outstring; + CtrlAnz : byte; +Begin + Scut := S; CtrlAnz:=0; + while pos('^',Scut) > 0 do + begin + delete(Scut,pos('^',Scut),2); + inc(CtrlAnz); + end; + IF Length(Scut) >= (X2-X1) Then Begin {Zeile zu lang ?} + begin + S[0] := Char(X2-X1-1+2*CtrlAnz); + S[X2-X1+2*CtrlAnz] := #26; + end; + End{IF}; + SH := StringToHeap(S); + New(P); {Zeile ==> Heap} + IF (P <> NIL) and (SH <> NIL) Then Begin {Heap Error ?} + P^.S := SH; P^.Mark := False; + P^.X := X; P^.length:= leng; P^.jump:=jump; + P^.PPred := NIL; P^.PNext := NIL; PSLast:=NIL; + IF StartLine = NIL Then Begin {1. Zeile ?} + StartLine := P; PS := P; + Lines := 1; AktLine := 1; + End + Else Begin + P1 := StartLine; + While P1^.PNext <> NIL Do P1 := P1^.PNext; + P1^.PNext := P; P^.PPred := P1; + Inc(Lines); + End{IF}; + End + Else Begin + OK := False; + IF P <> NIL Then Dispose(P); + DisposeString(SH); + IF IO_Error('Fehler bei Anzeige:', 'IOERROR.MSG',203,AR)=1 Then; + End{IF}; +End; + + + +Procedure ListView0.SortListe (Pos : byte); +Var + P : HeapLine; + SH : HeapString; + B : Boolean; + I,J : Word; + S1,S2: string; +Begin + IF (StartLine <> NIL) and (StartLine^.PNext <> NIL) + Then Begin + For I:=1 To Pred(Lines) Do Begin + P := StartLine; + For J:=1 To Lines-I Do Begin + S1:=StringFromHeap(P^.PNext^.S); delete(S1,1,Pos); + S2:=StringFromHeap(P^.S); delete(S2,1,Pos); + IF CompUCString(S1, S2) = Less + Then Begin + SH := P^.PNext^.S; B := P^.PNext^.Mark; + P^.PNext^.S := P^.S; P^.PNext^.Mark := P^.Mark; + P^.S := SH; P^.Mark := B; + End{IF}; + IF P^.PNext^.PNext <> NIL Then P := P^.PNext; + End{For}; + End{For}; + End{IF}; +End; + + +Procedure ListView0.OutLine(P: HeapLine; Y, Attr : Byte); {intern} +Var + OAttr : Byte; +Begin + OAttr := TextAttr; TextAttr := Attr; + IF (P <> NIL) Then Begin + IF P^.Mark Then WriteXY(X1, Y, '') Else WriteXY(X1, Y, ' '); + WriteXY(X1+1, Y, Pad(StringFromHeap(P^.S), Pred(X2-X1))); + End + Else + WriteXY(X1, Y, Pad('', X2-X1)); + {EndIF} + TextAttr := OAttr; +End; + + +Procedure ListView0.OutListe; +Var + PW : HeapLine; + I : Byte; +Begin + IF (PS <> PSLast) or (PSLast = NIL) Then Begin + PW := PS; + For I := Y1 To Y2 Do Begin {von 1. letzte BS-Zeile} + OutLine(PW, I, Scrollf); + IF PW <> NIL Then PW:=PW^.PNext; + End{FOR}; + PSLast := PS; + End{IF}; +End; + + +Procedure ListView0.LineUp; +Begin + IF (StartLine <> NIL) and (PS^.PPred <> NIL) Then Begin + PS := PS^.PPred; Dec(AktLine); + End{IF}; +End; + + +Procedure ListView0.LineDown; +Begin + IF (StartLine <> NIL) and (PS^.PNext <> NIL) and (Lines>AktLine+Y2-Y1) Then Begin + PS := PS^.PNext; Inc(AktLine); + End{IF}; +End; + + +Procedure Listview0.LinePgUp; +var z : byte; +begin + For z:=Y1+1 To Y2 do Listview0.LineUp; +end; + + +Procedure Listview0.LinePgDn; +var z: byte; +begin + For z:=Y1+1 To Y2 do Listview0.LineDown; +end; + +Procedure ListView0.LineTop; +Begin + PS := StartLine; + IF StartLine <> NIL Then + begin + Laufpos:=1; AktLine := 1; + end; +End; + + +Procedure ListView0.LineLast; +Var + I : Byte; +Begin + IF StartLine <> NIL Then + For I:=AktLine to Lines do ListView0.LineDown; + {EndIf} +End; + + +Procedure ListView0.SetLinePS(L : Word); +Begin + IF L > 0 Then Begin + ListView0.LineTop; + While (AktLine < L) Do ListView0.LineDown; + End{IF}; +End; + + +Procedure Listview0.CtrlLines; +var ev2: Event; +begin + Mouse :=False; + CtrlCode:=0; + {----- Balken mit Maus direkt bewegen -----} + case ev.Buttons of + 1 : begin + IF MouseEventInBox(EV_LEFT_PRESS, X1, Y1, X2, Pred((Y2-Y1+1) Div 2) + Y1) or + MouseEventInBox(EV_MOU_Move, X1, Y1, X2, Pred((Y2-Y1+1) Div 2) + Y1) Then + begin + Ev.CtrlCode := CUp; Mouse:=true; + end; + If MouseEventInBox(EV_LEFT_PRESS, X1, Y2-Pred((Y2-Y1+1) Div 2), X2, Y2) or + MouseEventInBox(EV_MOU_Move, X1, Y2-Pred((Y2-Y1+1) Div 2), X2, Y2) Then + begin + Ev.CtrlCode := CDown; Mouse:=true; + end; + {EndIF} + end; + End{Case}; + + SetLinePS(GetPos); + + If Mouse then + begin + ev2.Ereignis:=0; { Mausetaste gedrckt halten } + while ev2.Ereignis=0 do + begin + KbmPeekEvent( ev2 ); + If ev2.Ereignis<>0 then + break; + delay(80); + Case Ev.CtrlCode OF + CUp : LineUp; + CDown : LineDown; + CPgUp : LinePgUp; + CPgDn : LinePgDn; + End{Case}; + OutLaufLeiste; + OutListe; + SetLaufindex(AktLine); + end;{While} + end else + begin + Case Ev.CtrlCode OF + CUp : LineUp; + CDown : LineDown; + CPgUp : LinePgUp; + CPgDn : LinePgDn; + CHome : LineTop; + CEnd : LineLast; + End{Case}; + end{IF}; +end; + + +Procedure ListView0.ViewLines; +{Anzeige des Textes mit Rollen und Blttern} +Begin + OutLaufLeiste; + OutListe; + SetLaufindex(AktLine); +End; + + +Function ListView0.IsOK : Boolean; +Begin + IsOK := OK; OK := True; +End; + + +Function ListView0.GetLineNumber : Word; +var P: HeapLine; + Z: word; +begin + Z:=0; P:=StartLine; + while (P^.PPred<>PS) and (P<>NIL) do + begin + inc(z); + P:=P^.PNext; + end; + GetLineNumber:=Z; +end; + + + +Function ListView0.GetLine(L:Word) :Outstring; +var P: HeapLine; + Z: word; +begin + GetLine:=''; + Z:=0; P:=StartLine; + while (P<>NIL) and (Z NIL Do Begin + P := StartLine; StartLine := P^.PNext; + DisposeString(P^.S); + Dispose(P); + End{While}; + SetLines(0); + StartLine := NIL; PS := NIL; PSLast := NIL; + AktLine := 0; OK := True; +End; + + +Destructor ListView0.Done; +Begin + Laufleiste.Done; + ClrListe; +End; + + +{--------- Methoden fuer Objekt zur Auswahl aus einer Liste -----} + +Procedure SelectView0.AppendHelp(S : OutString; jump: word); +var Scut : string; + X,leng : byte; +begin + Scut := S; + If pos('^c',Scut) > 0 then + begin + while pos('^',Scut) < pos('^c',Scut) do + delete(Scut,pos('^',Scut),2); + X := pos('^c',Scut)+1; + delete(Scut,pos('^c',Scut),2); + while pos('^',Scut) < pos('^c',Scut) do + delete(Scut,pos('^',Scut),2); + leng := pos('^c',Scut)-X; + X:=X+X1-2; + end; + AppendLine (S ,X ,leng, jump); +end; + +Constructor SelectView0.Init(XMin,YMin,XMax,YMax,Scrba: Byte); +begin + ListView0.Init(XMin, YMin, XMax, YMax); + SetBalken := True; MarkActive:=false; + SelectPtrOld := NIL; SelectLineOld := 0; + SelectPtr := NIL; SelectLine := 0; + Balkenf := Scrba; Balkenb:=Balkenback; + Scrollb:=Scrba; +end; + +Procedure SelectView0.WrXY(X,Y: byte; S: string; sele : boolean); { Mehrfarbige Ausgabe eines Str} +const Statusanz = 2; +var OAttr : Byte; + Xpos : byte; + MStat : char; + Status : array [1..Statusanz] of char; + Zst,z : byte; + Scut : string; + vor : boolean; + +begin + OAttr:=Textattr; + Xpos:=X; Zst := 0; textcolor(Scrollf); textbackground(Scrollb); + repeat + Scut:=S; + while (pos('^',S) = 1) do + begin + MStat:=S[2]; { Status einlesen } + If Zst>0 then { berprfen . ob St vorhanden } + begin + for z:=1 to Zst do + If Status[z]=Mstat then + begin + vor:=true; break; + end else + vor:=false; + {End IF} + {End For} + End else + vor:=false; + {End IF} + If not vor and (zst<=Statusanz) then + begin { Alles setzen } + inc(Zst); Status[Zst]:=Mstat; + case Status[Zst] of + 'c' : If sele then + begin + textcolor(ActSelfo); textbackground(ActSelba); + end else + begin + textcolor(Selfo); textbackground(Scrollb); + end; + 'y' : textcolor(yCol); + 'w' : textcolor(wCol); + 'W' : textbackground(wCol); + End{Case}; + end else + begin { Alles zurcksetzen } + case Status[Z] of + 'c' : begin + textcolor(Scrollf); textbackground(Scrollb); + end; + 'y' : textcolor(Scrollf); + 'w' : textcolor(Scrollf); + 'W' : textbackground(Scrollb); + End{Case}; + Status[z]:=Status[Zst]; dec(Zst); + end; + delete(S,1,2); Scut:=S; + end{While}; + If pos('^',S) > 0 then + begin + delete(S,1, pos('^',S)-1); + delete(Scut,pos('^',Scut),length(Scut)); + end else + begin + delete(S,1, length(S)); + end; + writeXY(Xpos,Y,Scut); inc(Xpos,length(Scut)); + until length(S) = 0; + Textattr:=OAttr; +end; + + + + + +Procedure SelectView0.OutLine(P: HeapLine; Y: byte; sel :boolean); +var SH,Scut : string; + CtrlAnz : byte; +Begin + CtrlAnz:=0; + IF (P <> NIL) Then Begin + IF P^.Mark Then WrXY(X1, Y, '', sel ) + Else WrXY(X1, Y, ' ', sel); + Sh := StringFromHeap(P^.S); + Scut := SH; + while pos('^',Scut) > 0 do + begin + delete(Scut,pos('^',Scut),2); + inc(CtrlAnz); + end; + WrXY(X1+1, Y, Pad(SH, Pred(X2-X1)+CtrlAnz*2), sel); + End + Else + WrXY(X1, Y, Pad('', X2-X1), sel); + {EndIF} +end; + +Procedure SelectView0.OutListe; +Var + PW : HeapLine; + I : Byte; +Begin + IF SelectPtr = NIL Then LineTop; + IF (PS <> PSLast) or (PSLast = NIL) Then Begin + PW := PS; + For I := Y1 To Y2 Do Begin {von 1. letzte BS-Zeile} + If (SelectPtr = PW) and (SelectPtr<>nil) then + OutLine(PW, I, true) else + OutLine(PW, I, false); + IF PW <> NIL Then PW:=PW^.PNext; + End{FOR}; + PSLast := PS; + End{IF}; +End; + +Procedure SelectView0.Outbalken; +begin + IF StartLine = NIL Then Exit; + IF (SelectLine <> SelectLineOld) or (SelectPtr <> SelectPtrOld) or + SetBalken + Then Begin + IF (SelectLineOld >= AktLine) and (SelectLineOld <= AktLine+(Y2-Y1)) + Then + OutLine(SelectPtrOld, Y1+SelectLineOld-AktLine, false); + {EndIF} + IF (SelectLine >= AktLine) and (SelectLine <= AktLine+(Y2-Y1)) + Then + OutLine(SelectPtr, Y1+SelectLine-AktLine, true); + {EndIF} + SetBalken := False; + SelectLineOld := SelectLine; SelectPtrOld := SelectPtr; + End{IF}; +end; + + + +Procedure SelectView0.LineUp; +var SelPtrCount : HeapLine; + SelCount,SelLineOld : Word; +begin + IF (StartLine <> NIL) Then + Begin + SelCount:=SelectLine; SelLineOld:=SelectLine; + SelPtrCount:=SelectPtr; + while ((SelectPtr^.Jump = 0) or (SelectLine = SelLineOld)) and + (SelCount >= AktLine) and (SelPtrCount^.PPred <>NIL) do + begin + SelPtrCount:=SelPtrCount^.PPred; Dec(SelCount); + If (SelPtrCount^.Jump > 0) then + begin + SelectPtr:=SelPtrCount; SelectLine:=SelCount; + end; + end;{While} + If (SelectLine = SelLineOld) or (SelectLine < AktLine) Then + ListView0.LineUp; + End{IF}; +end; + + + + +Procedure SelectView0.LineDown; +var SelCount,SelLineOld : Word; + SelPtrCount : HeapLine; +begin + IF (StartLine <> NIL) Then + Begin + SelCount:=SelectLine; SelLineOld:=SelectLine; + SelPtrCount:=SelectPtr; + while ((SelectPtr^.Jump = 0) or (SelectLine = SelLineOld)) and + (SelCount <= AktLine+Y2-Y1) and (SelPtrCount^.PNext <> NIL) do + begin + SelPtrCount:=SelPtrCount^.PNext; Inc(SelCount); + If (SelPtrCount^.Jump > 0) then + begin + SelectPtr:=SelPtrCount; SelectLine:=SelCount; + end; + end;{While} + SelEnde :=(Selcount = Lines); + If (SelectLine = SelLineOld) or (SelectLine>AktLine+Y2-Y1) Then + ListView0.LineDown; + End{IF} else + Selende:=true; +end; + + + +Procedure SelectView0.LinePgUp; +var SelCount : Word; + SelPtrCount : HeapLine; + z : word; +begin + If AktLine=1 then + begin + Selectview0.LineTop; exit; + end; + For z:=Y1+1 To Y2 do Listview0.LineUp; + IF (StartLine <> NIL) and (SelectPtr^.PPred <> NIL) and (SelectLine>AktLine) Then + Begin + SelCount:=SelectLine; SelPtrCount := SelectPtr; + repeat + SelPtrCount:=SelPtrCount^.PPred; Dec(SelCount); + If (SelPtrCount^.Jump > 0) then + begin + SelectPtr:=SelPtrCount; SelectLine:=SelCount; + end; + until ((SelectPtr^.Jump >0) and (SelectLine <= AktLine+Y2-Y1)) or (SelCount <= AktLine) or + (SelPtrCount^.PPred = NIL); + End{IF}; +end; + + + + + +Procedure SelectView0.LinePgDn; +var SelCount : Word; + SelPtrCount : HeapLine; + z : word; +begin + If AktLine+Y2-Y1>=Lines then + begin + Selectview0.LineLast; exit; + end; + For z:=Y1+1 To Y2 do Listview0.LineDown; + IF (StartLine <> NIL) and (SelectPtr^.PNext <> NIL) and (SelectLine 0) then + begin + SelectPtr:=SelPtrCount; SelectLine:=SelCount; + end; + until ((SelectLine >= AktLine) and (SelectPtr^.Jump >0)) or (SelCount>AktLine+Y2-Y1) or + (SelPtrCount^.PNext = NIL); + End{IF}; +end; + + + + + + + + +Procedure SelectView0.LineTop; +var SelCount : Word; + SelPtrCount : HeapLine; +begin + ListView0.LineTop; + SelectPtr := StartLine; SelectLine := 1; + IF (StartLine <> NIL) and (SelectPtr^.Jump=0) and (SelectPtr^.PNext <> NIL) Then + begin + SelCount:=SelectLine; SelPtrCount := SelectPtr; + repeat + SelPtrCount:=SelPtrCount^.PNext; Inc(SelCount); + If (SelPtrCount^.Jump > 0) then + begin + SelectPtr:=SelPtrCount; SelectLine:=SelCount; + end; + until (SelectPtr^.Jump > 0) or (SelCount = Lines) or (SelectPtr^.PNext = NIL); + end{IF}; +end; + +Procedure SelectView0.LineLast; +begin + repeat LineDown; until Selende; +end; + + + + + + + +Procedure SelectView0.SetLinePS(L : Word); +var z: word; +begin + IF L > 0 Then Begin + ListView0.SetLinePS(L); + SelectPtr := PS; SelectLine := AktLine; + SetBalken := True; + repeat + If (SelectPtr^.PNext <> NIL) and (SelectPtr^.Jump = 0) then + begin + SelectPtr := SelectPtr^.PNext; Inc(SelectLine); + end; + until (SelectPtr^.Jump > 0) or (SelectLine = AktLine+Y2-Y1) or (SelectPtr^.PNext = NIL); + End{IF}; +end; + + +Procedure SelectView0.CtrlLines; +Const + MarkUp = 254; +Var + X, Y : Word; + I : Byte; + ev2 : Event; + + Function BalkenToMouse : Boolean; + Var + SelectLineOld, AktLineOld : Word; + SelectPtrOld, PSOld : HeapLine; + Begin + BalkenToMouse := False; + IF Ev.zeilerel+1-Y1+AktLine <= Lines Then Begin + SelectLineOld := SelectLine; SelectPtrOld := SelectPtr; + AktLineOld := AktLine; PSOld := PS; + SelectLine := AktLine; SelectPtr := PS; + Selende:=false; + While (SelectLine < Ev.zeilerel+1-Y1+AktLine) and + (AktLine = AktLineOld) and (not Selende) Do LineDown; + Selende:=false; + IF (SelectLine = Ev.zeilerel+1-Y1+AktLine) and + (SelectPtr^.X-1 < Ev.spalterel) and + (SelectPtr^.X+SelectPtr^.length+1 > Ev.spalterel) and + (SelectPtr^.Jump > 0) and (AktLine = AktLineOld) + Then + BalkenToMouse := True + Else Begin + SelectLine := SelectLineOld; SelectPtr := SelectPtrOld; + AktLine := AktLineOld; PS := PSOld; + End{IF}; + End{IF}; + End; + +Begin + DKlick:=False; + Mouse :=False; + CtrlCode:=0; + {----- Balken mit Maus direkt bewegen -----} + case ev.Buttons of + 1 : begin + IF MouseEventInBox(EV_LEFT_PRESS, X1, Y1, X2-1, Y2) or + MouseEventInBox(EV_Mou_Move, X1, Y1, X2-1, Y2) Then + Begin + IF BalkenToMouse Then + Begin + OUtBalken; + DKlick := DoppelKlick; + If DKlick then + begin + CtrlCode :=CR; + end; + End{IF}; + End{IF}; + IF MouseEventInBox(EV_LEFT_PRESS, X1, Y1-1, X2, Y1-1) or + MouseEventInBox(EV_Mou_Move, X1, Y1-1, X2, Y1-1) Then + begin + Ev.CtrlCode := CUp; Mouse:=true; + end; + IF MouseEventInBox(EV_LEFT_PRESS, X1, Y2+1, X2, Y2+1) or + MouseEventInBox(EV_Mou_Move, X1, Y2+1, X2, Y2+1) Then + begin + Ev.CtrlCode := CDown; Mouse:=true; + end; + {EndIF} + end; + 2 : begin + IF MarkActive Then + Begin + IF MouseEventInBox(EV_Right_PRESS, X1, Y1, X2-1, Y2) or + MouseEventInBox(EV_Mou_Move, X1, Y1, X2-1, Y2) Then + Begin + IF BalkenToMouse Then + begin + Mark; + end; + End{IF}; + IF MouseEventInBox(EV_RIGHT_PRESS, X1, Y1-1, X2, Y1-1) or + MouseEventInBox(EV_Mou_Move, X1, Y1-1, X2, Y1-1)Then + begin + Ev.CtrlCode := MarkUp; Mouse:=true; + end; + IF MouseEventInBox(EV_RIGHT_PRESS, X1, Y2+1, X2, Y2+1) or + MouseEventInBox(EV_Mou_Move, X1, Y2+1, X2, Y2+1) Then + begin + Ev.CtrlCode := InsertKey; Mouse:=true; + end; + End{IF}; + end; + End{Case}; + + SetLinePS(GetPos); + + If Mouse then + begin + ev2.Ereignis:=0; { Mausetaste gedrckt halten } + while ev2.Ereignis=0 do + begin + KbmPeekEvent( ev2 ); + If ev2.Ereignis<>0 then + break; + delay(80); + Case Ev.CtrlCode OF + CUp : LineUp; + CDown : LineDown; + CPgUp : LinePgUp; + CPgDn : LinePgDn; + MarKup : begin + If Markactive then + begin + Mark; LineUp; + end; + end; + Insertkey : begin + If Markactive then + begin + Mark; LineDown; + end; + end; + End{Case}; + OutLaufLeiste; + OutListe; + SetLaufindex(AktLine); + OutBalken; + end;{While} + end else + begin + Case Ev.CtrlCode OF + CUp : LineUp; + CDown : LineDown; + CPgUp : LinePgUp; + CPgDn : LinePgDn; + CHome : LineTop; + CEnd : LineLast; + MarKup : begin + If Markactive then + begin + Mark; LineUp; + end; + end; + Insertkey : begin + If Markactive then + begin + Mark; LineDown; + end; + end; + End{Case}; + end{IF}; +end; + +Procedure SelectView0.SetMarkMode(A: Boolean); +Begin + MarkActive := A; +End; + +Procedure SelectView0.Mark; +Begin + SelectPtr^.Mark := not SelectPtr^.Mark; SetBalken := True; +End; + + +Procedure SelectView0.ViewLines; +begin + OutLaufLeiste; + OutListe; + SetLaufindex(AktLine); + OutBalken; +end; + + +Function SelectView0.GetJumpNumber : Word; +begin + If (SelectPtr <> NIL) then + GetJumpNumber:= SelectPtr^.Jump else GetJumpNumber:= 0; +end; + +Function SelectView0.GetLineNumber : Word; +var P: HeapLine; + Z: word; +begin + Z:=0; P:=StartLine; + while (P^.PPred<>SelectPtr) and (P<>NIL) do + begin + If (P^.Jump > 0) then + inc(z); + P:=P^.PNext; + end; + GetLineNumber:=Z; +end; + + {If (SelectPtr <> NIL) and (SelectPtr^.Jump > 0) then + GetLineNumber := SelectLine + else + GetLineNumber := 0;} + +Function SelectView0.GetSelLine : OutString; +begin + GetSelLine := ''; + IF (SelectPtr <> NIL) and (SelectPtr^.Jump > 0) Then + GetSelLine := StringFromHeap(SelectPtr^.S) +end; + + +Procedure ListView0.ClrLine(L :Word); +Var P,P1 : HeapLine; + Z : Word; + Next : Pointer; +Begin + Z:=0; P:=StartLine; + While (P <> NIL) and (L>Z) Do Begin + inc(Z); + If (Z=L) and (P<>NIL) then + begin + If PS=P then + begin + If L>1 then + begin + PS:=P^.PPred; dec(AktLine); + end + else + PS:=P^.PNext; + end; + If L>1 then + begin + If P^.PPred<>NIL then + P^.PPred^.PNext:=P^.PNext; + If P^.PNext<>NIL then + P^.PNext^.PPred:=P^.PPred; + end else + begin + StartLine:=P^.PNext; + If P^.PNext<>NIL then + P^.PNext^.PPred:=NIL; + end; + DisposeString(P^.S); + Dispose(P); PSlast:=NIL; SetLines(pred(Lines)); + end; + P := P^.PNext; + End{While}; +End; + + + +Procedure SelectView0.DelLine; +begin + If (StartLine = NIL) then exit; + Listview0.ClrLine(GetLineNumber); + If (StartLine = NIL) then SelectPtr:=NIL; + If SelectPtr<>NIL then + begin + If SelectPtr^.PPred<>NIL then + begin + SelectPtr:=SelectPtr^.PPred; + dec(SelectLine); + end else + If SelectPtr^.PNext<>NIL then + SelectPtr:=SelectPtr^.PNext else + SelectPtr:=nil; + end; + SelectPtrOld:=NIL; SelectLineOld:=0; + SetBalken := True; +end; + + +Procedure SelectView0.ClrListe; +begin + ListView0.ClrListe; + SetBalken := True; MarkActive:=false; + SelectPtrOld := NIL; SelectLineOld := 0; + SelectPtr := NIL; SelectLine := 0; +end; + +Destructor SelectView0.Done; +begin + Listview0.Done; +end; + +{----------- Weitere Auswahlmethoden --------------------------} + +Procedure SelectView1.AppendStr(S : OutString); +begin + Selectview0.AppendHelp(concat('^c',pad(S,X2-X1-2),'^c'),1); +end; + +Function SelectView1.GetLine(L:Word) : OutString; +var S :Outstring; +begin + S:=Listview0.GetLine(L); + delete(S,1,2); delete(S,length(S)-1,2); + GetLine:=trim(S); +end; + + +Function Selectview1.GetSelLine :OutString; +var S : Outstring; +begin + S:=Selectview0.GetSelLine; + delete(S,1,2); delete(S,length(S)-1,2); + GetSelLine:=trim(S); +end; + + + + + +begin +end. + diff --git a/UNITS/TKVIEW2.PAS b/UNITS/TKVIEW2.PAS new file mode 100644 index 0000000..e31b6ac --- /dev/null +++ b/UNITS/TKVIEW2.PAS @@ -0,0 +1,578 @@ +unit Tkview2; + +Interface +uses Dos,Crt,TKsaa,Kbm,Tkstream,Tkstring,TKwin,TKvideo,Tkview; + +const + Helpba : Byte = green; + Pullfo : Byte = black; + Pullba : Byte = Lightgray; + +type BackJumpRec = Record + Page : Word; + TopLine : Word; + SelectLine: Word; + End; + + +Type + + {-------- Objekt zur Listenausgabe ---------------------} + ListView1 = Object(ListView0) + XW1, XW2, + YW1, YW2 : Byte; {Fensterkoordinaten} + Frame, Title, + Background : Byte; + Constructor Init(XMin,YMin,XMax,YMax : Byte); + Procedure ViewLines; Virtual; {Anzeige. mit Rollen} + Destructor Done; + End{Object ListView1}; + + + Helpview1 = Object(Selectview0) + JumpSeek : array [1..255] of longint; + BackJump : array [1..50] of BackJumpRec; + BackCount : byte; + Helpfile : Typedstream; + Magicheader : longint; + Helpfehler : boolean; + Topic : string; {Topic der akt. Seite} + Constructor Init (fname: pathstr; Ma: longint); + Procedure Open (Xdiff,Ydiff,ScrBa: byte); + Procedure Pageread (Jump: Word); { intern } + Procedure PageSelect (Jump: Word); + Procedure PageBack; + Procedure OutTopic; { intern } + Procedure ViewLines; Virtual; + Procedure ViewPage(Page : Word); { intern } + Destructor Done; + End{Helpview1}; + + SelectView2 = Object(Selectview1) + Constructor Init (Xdiff,Ydiff,ScrBa: byte); + Procedure ViewLines; virtual; + Destructor Done; + End{SelectView2}; + + Pulldown1 = Object(Selectview1) + Down_Bu : Button; + Up_Bu : Button; + Open : boolean; + Constructor Init(XMin,YMin,XMax,YMax,Scrfo,ScrBa : Byte); + Procedure SetPullDown; + Procedure ViewLines; virtual; + Procedure CtrlLines; virtual; + Function EventPulldown : boolean; + Destructor Done; + End{Pulldown1}; + +Implementation + + +{-------------- Objekt fr Pulldownmen --------------} +Constructor Pulldown1.Init(XMin,YMin,XMax,YMax,Scrfo,ScrBa : Byte); +var Wmin,Wmax : byte; +begin + Selectview1.Init(XMin,YMin+1,XMax,YMax,Scrba); + Balkenf := Scrba; Balkenb:=Balkenback; + Scrollf:=Scrfo; Scrollb:=Scrba; + Initbutton(Up_Bu ,XMax,YMin,'~'+#30,72,1); Up_Bu.Anz:=1; Up_Bu.Schatten:=false; + Initbutton(Down_Bu,XMax,YMin,'~'+#31,80,1);Down_Bu.Anz:=1;Down_Bu.Schatten:=false; + Open:=false; +end; + + +Procedure Pulldown1.SetPullDown; +begin + SetButton(Down_Bu); + textcolor(Scrollf); textbackground(Scrollb); + writeXY(X1,Y1-1,' '+pad(GetSelline,X2-X1-2)+' '); +end; + + +Procedure Pulldown1.ViewLines; +begin + CtrlCode:=0; + Repeat + If Open then + SetButton(Up_Bu) else + SetButton(Down_Bu); + + + If Open then + begin + textcolor(Scrollf); textbackground(Scrollb); + writeXY(X1,Y1-1,''+pad(GetSelline,X2-X1-2)+'' ); + PSLast:=Nil; + Selectview1.ViewLines + end else + begin + IndexPos:=0; + textcolor(Scrollf); textbackground(Scrollb); + writeXY(X1,Y1-1,''+pad(GetSelline,X2-X1-2)+'' ); + end; + + If Open then + ActiveButton(Up_Bu) else + ActiveButton(Down_Bu); + + If Open then + begin + case EventThisButton(Up_Bu) of + 1 : CtrlCode:=CR; + end{Case}; + end else + begin + case EventThisButton(Down_Bu) of + 1 : CtrlCode:=CR; + end{Case}; + end; + + If Open then + begin + If ((Ctrlcode=CR) or (ev.ctrlcode=TAB)) then + begin + Open:=false; CtrlCode:=Cr; Restwindow; + end; + end else + begin + If (Ctrlcode=CR) then + begin + Open:=true; Savewin(X1,Y1,X2,Y2); + end; + end; + + If Open then + CtrlLines; + + Until (Ev.Ctrlcode = ESC) or (ev.CtrlCode=TAB) or (CtrlCode=CR) or + ((ev.ereignis in[2,4,8,16]) and not MouseEventInBox(ev.ereignis, X1, Y1-1, X2, Y2) or not Open); + If Open then + begin + CtrlCode:=Cr; + Open:=false; + Restwindow; + textcolor(Scrollf); textbackground(Scrollb); + writeXY(X1,Y1-1,' '+pad(GetSelline,X2-X1-2)+' '); + end; +end; + + +Procedure Pulldown1.CtrlLines; +Const + MarkUp = 254; +Var + X, Y : Word; + I : Byte; + ev2 : Event; + + Function BalkenToMouse : Boolean; + Var + SelectLineOld, AktLineOld : Word; + SelectPtrOld, PSOld : HeapLine; + Begin + BalkenToMouse := False; + IF Ev.zeilerel+1-Y1+AktLine <= Lines Then Begin + SelectLineOld := SelectLine; SelectPtrOld := SelectPtr; + AktLineOld := AktLine; PSOld := PS; + SelectLine := AktLine; SelectPtr := PS; + Selende:=false; + While (SelectLine < Ev.zeilerel+1-Y1+AktLine) and + (AktLine = AktLineOld) and (not Selende) Do LineDown; + Selende:=false; + IF (SelectLine = Ev.zeilerel+1-Y1+AktLine) and + (SelectPtr^.X-1 < Ev.spalterel) and + (SelectPtr^.X+SelectPtr^.length+1 > Ev.spalterel) and + (SelectPtr^.Jump > 0) and (AktLine = AktLineOld) + Then + BalkenToMouse := True + Else Begin + SelectLine := SelectLineOld; SelectPtr := SelectPtrOld; + AktLine := AktLineOld; PS := PSOld; + End{IF}; + End{IF}; + End; + +Begin + DKlick:=False; + Mouse :=False; + CtrlCode:=0; + {----- Balken mit Maus direkt bewegen -----} + case ev.Buttons of + 1 : begin + IF MouseEventInBox(EV_LEFT_PRESS, X1, Y1, X2-1, Y2) or + MouseEventInBox(EV_Mou_Move, X1, Y1, X2-1, Y2) Then + Begin + IF BalkenToMouse Then + Begin + OUtBalken; + DKlick := DoppelKlick; + If DKlick then + begin + CtrlCode :=CR; + end; + End{IF}; + End{IF}; + end; + 2 : begin + IF MarkActive Then + Begin + IF MouseEventInBox(EV_Right_PRESS, X1, Y1, X2-1, Y2) or + MouseEventInBox(EV_Mou_Move, X1, Y1, X2-1, Y2) Then + Begin + IF BalkenToMouse Then + begin + Mark; + end; + End{IF}; + IF MouseEventInBox(EV_RIGHT_PRESS, X1, Y1-1, X2, Y1-1) or + MouseEventInBox(EV_Mou_Move, X1, Y1-1, X2, Y1-1)Then + begin + Ev.CtrlCode := MarkUp; Mouse:=true; + end; + IF MouseEventInBox(EV_RIGHT_PRESS, X1, Y2+1, X2, Y2+1) or + MouseEventInBox(EV_Mou_Move, X1, Y2+1, X2, Y2+1) Then + begin + Ev.CtrlCode := InsertKey; Mouse:=true; + end; + End{IF}; + end; + End{Case}; + + SetLinePS(GetPos); + + If Mouse then + begin + ev2.Ereignis:=0; { Mausetaste gedrckt halten } + while ev2.Ereignis=0 do + begin + KbmPeekEvent( ev2 ); + If ev2.Ereignis<>0 then + break; + delay(80); + Case Ev.CtrlCode OF + CUp : LineUp; + CDown : LineDown; + CPgUp : LinePgUp; + CPgDn : LinePgDn; + MarKup : begin + If Markactive then + begin + Mark; LineUp; + end; + end; + Insertkey : begin + If Markactive then + begin + Mark; LineDown; + end; + end; + End{Case}; + OutLaufLeiste; + OutListe; + SetLaufindex(AktLine); + OutBalken; + end;{While} + end else + begin + Case Ev.CtrlCode OF + CUp : LineUp; + CDown : LineDown; + CPgUp : LinePgUp; + CPgDn : LinePgDn; + CHome : LineTop; + CEnd : LineLast; + MarKup : begin + If Markactive then + begin + Mark; LineUp; + end; + end; + Insertkey : begin + If Markactive then + begin + Mark; LineDown; + end; + end; + End{Case}; + end{IF}; +end; + + +Function Pulldown1.EventPulldown : boolean; +begin + EventPulldown:=false; + If ((fenanz>0) and (aktber=fenanz)) then + case ev.Ereignis of + EV_LEFT_PRESS : + begin + If (ev.spalterelX1) and + (ev.zeilerel+2=Y1) then + begin + EventPulldown:=true; + end; + end; + end; +end; + +Destructor Pulldown1.Done; +begin + Selectview1.Done; +end; + + +{-------------- Objekt zur Listenausgabe -------------} +Constructor ListView1.Init(XMin, YMin, XMax, YMax : Byte); +Begin + XW1 := XMin; YW1 := YMin; XW2 := XMax; YW2 := YMax; + ListView0.Init(2, 2, XMax-XMin-1 , YMax-YMin-2); + OK:=openwindow(Xmax-Xmin,Ymax-Ymin,fenfo,fenba,'Liste') and OK +End; + + + +Procedure ListView1.ViewLines; +Var + List_Bu : Button; +Begin + Initbutton(List_Bu, X2 DIV 2 - 3, Y2+2,' ~OK ' ,Alt_O,1); List_Bu.anz:=1; + List_Bu.FaFen:=scrollb; + Repeat + SetButton(List_Bu); + Listview0.ViewLines; + ActiveButton(List_Bu); + ListView0.CtrlLines; + case EventThisButton(List_Bu) of + 1 : Ev.CtrlCode:=ESC; + end{Case}; + Until (Ev.Ctrlcode = ESC); +End; + + +Destructor ListView1.Done; +Begin + ListView0.Done; +End; + +{--------- Methoden fuer Objekt zur Auswahl aus einer Liste -----} + +Constructor SelectView2.Init (Xdiff,Ydiff,Scrba: byte); +begin + OK:=openwindow (Xdiff,Ydiff,scrollf,Scrba,'Hilfe') and OK; + Selectview1.Init( 3, 4, xdiff-1, ydiff-2,ScrBa); +end; + + +Procedure SelectView2.ViewLines; +var Sel_Bu : Button; +begin + Initbutton(Sel_Bu, 3, Y2+2,' ~OK ',Alt_O,1); + Initbutton(Sel_Bu,18, Y2+2,' ~Markieren ',Alt_M,2); + Initbutton(Sel_Bu,37, Y2+2,' ~Abbruch ',Alt_A,3); Sel_Bu.anz:=3; + Repeat + SetButton(Sel_Bu); + Selectview1.ViewLines; + ActiveButton(Sel_Bu); + SelectView1.CtrlLines; + case EventThisButton(Sel_Bu) of + 1 : CtrlCode:=CR; + 2 : begin end; + 3 : Ev.CtrlCode:=ESC; + end{Case}; + + If Ctrlcode=CR then + begin + end; + + Until (Ev.Ctrlcode = ESC); +end; + +Destructor SelectView2.Done; +begin + Selectview1.Done; + closewindow; +end; + + +Constructor Helpview1.Init (fname: pathstr; Ma : longint); +const AR : AcceptRec = (' OK ','',''); +var Mword : word; + Mbyte : byte; + Mstring : string; + Textcount : word; + z,gr : byte; + +begin + HelpFehler:=false; + for z:=1 to 255 do JumpSeek[z]:=0; + HelpFile.Init(fname,1 ); + HelpFile.Open; MagicHeader:=0; + Helpfile.Read(Magicheader,0,SizeOf(Ma)); + IF Ma=Magicheader then + begin + While (Helpfile.OK) and (not Helpfile.EOF) do + begin + Helpfile.Read(Mword,-1,2); { Number } + JumpSeek[Mword]:=Helpfile.pos-2; + Helpfile.Read(Mbyte ,-1,1); { Topic } + Helpfile.Read(Mstring,-1,Mbyte); + Helpfile.Read(Textcount,-1,2); { Textcount } + for z:=1 to Textcount do + begin + Helpfile.Read(Mbyte ,-1,1); { Text } + Helpfile.Read(Mstring,-1,Mbyte); + Helpfile.read(Mword ,-1,2); { Jump } + If not Helpfile.OK then begin Ma:=0; break; end; + end; + end; + End{IF}; + If (Ma<>Magicheader) then + begin + IO_Error(' Hilfedatei:','ioerror.msg', 224, Ar); Helpfehler:=true; + end; +end; + + +Procedure Helpview1.Open (Xdiff,Ydiff,ScrBa: byte); +begin + If HelpFehler then exit; + OK:=openwindow (Xdiff,Ydiff,scrollfo,scrba,'Hilfe') and OK; + Selectview0.Init( 3, 4, xdiff-1, ydiff-3,ScrBa); + textcolor(Balkenb); textbackground(Scrba); + Winframe( X1-1, Y1-1, X2, Y2+1, false); +end; + + +Procedure Helpview1.Pageread (Jump: Word); +var Number : word; + Text : string; + Textcount,Ju : word; + Mbyte : byte; + z : byte; +begin + If (Jumpseek[jump] > 0) and (Jump > 0) then + begin + ClrListe; + Helpfile.Seek(Jumpseek[jump]); + Helpfile.Read(Number,-1,2); { Number } + Helpfile.Read(Mbyte,-1,1); + Topic[0]:=char(Mbyte); + Helpfile.seek(Helpfile.pos-1); + Helpfile.Read(Topic,-1,Mbyte+1); { Topic } + Helpfile.Read(Textcount,-1,2); { Textcount } + for z:=1 to Textcount do + begin + Helpfile.Read(Mbyte ,-1,1); { Text } + Text[0]:=char(Mbyte); + Helpfile.seek(Helpfile.pos-1); + Helpfile.Read(Text,-1,Mbyte+1); + Helpfile.read(Ju ,-1,2); { Jump } + AppendHelp(Text,ju); + end; + End{IF}; + LineTop; +end; + + +Procedure Helpview1.PageSelect (Jump: Word); +var z: byte; +begin + If (Jump<>BackJump[1].Page) and (Jump>0) then + begin + If (Jumpseek[jump] > 0) then + begin + for z:=49 downto 1 do + BackJump[z+1]:=BackJump[z]; + {EndFor}; + If BackCount < 50 then inc(BackCount); + BackJump[1].Page := Jump; + BackJump[1].Topline := Listview0.GetLineNumber; + BackJump[1].SelectLine:= GetLineNumber; + end{If}; + Pageread(Jump); + end{If} +end; + + + +Procedure Helpview1.PageBack; +var z : word; +begin + If BackCount > 1 then + begin + Pageread(BackJump[2].Page); + for z:=2 to BackJump[1].TopLine do + Listview0.LineDown; + for z:=2 to BackJump[1].SelectLine do + LineDown; + for z:=1 to 49 do + BackJump[z]:=BackJump[z+1]; + dec(BackCount); + end; +end; + +Procedure Helpview1.OutTopic; +begin + WrXY(X1+2,Y1-2, pad(Topic,X2-X1),false); +end; + + +Procedure Helpview1.ViewLines; +begin + OutTopic; + SelectView0.ViewLines; +end; + + +Procedure Helpview1.ViewPage(Page : Word); +var jump : word; + Help_Bu : Button; + z : byte; +begin + If HelpFehler then exit; + Open(65,18,Helpba); + for z:=1 to 50 do BackJump[z].Page:=0; + BackCount:=0; + PageSelect(Page); + Initbutton(Help_Bu, 2, Y2+3,' ~Gehe zu ' ,Alt_G,1); + Initbutton(Help_Bu,18, Y2+3,' Gehe ~zurck ',Alt_Z,2); + Initbutton(Help_Bu,38, Y2+3,' ~Index ' ,Alt_I,3); + Initbutton(Help_Bu,52, Y2+3,' ~Abbruch ' ,Alt_A,4); Help_Bu.anz:=4; + Help_Bu.FaFen:=scrollb; + Repeat + SetButton(Help_Bu); + ViewLines; + ActiveButton(Help_Bu); + SelectView0.CtrlLines; + case EventThisButton(Help_Bu) of + 1 : CtrlCode:=CR; + 2 : begin + PageBack; + Help_Bu.Pos:=1; + end; + 3 : begin + PageSelect(1); + Help_Bu.Pos:=1; + end; + 4 : Ev.CtrlCode:=ESC; + end{Case}; + If Ctrlcode=CR then + begin + PageSelect(GetjumpNumber); + Help_Bu.Pos:=1; + end; + {EndIf} + Until (Ev.Ctrlcode = ESC); + Clrliste; + for z:=1 to High(Backjump) do Backjump[z].Page:=0; + closewindow; +end; + + +Destructor Helpview1.Done; +begin +end; + + +begin +end. \ No newline at end of file diff --git a/UNITS/TKWIN.PAS b/UNITS/TKWIN.PAS new file mode 100644 index 0000000..abecf0e --- /dev/null +++ b/UNITS/TKWIN.PAS @@ -0,0 +1,401 @@ +unit tkwin; +Interface +uses crt,kbm,tkstring,Tkvideo; + +const + Fenanz : byte = 0; + + Fenfo : byte=blue; + Fenba : byte=cyan; + + Fen2fo : byte=white; + Fen2ba : byte=red; + +Type + VEL = record { beschreibt eine Zeichen-Attribut- } + case boolean of { Kombination im Video-RAM } + true : ( Zeichen, Attribut : byte ); + false : ( Inhalt : word ); + end; + + VPTR = ^VEL; { Zeiger auf ein Zeichen/Attribut } + + + PTRREC = record { dient dem Zugriff auf die } + Ofs : word; { Bestandteile eines belie- } + Seg : word; { bigen Pointers } + end; + + + WinState = record + x1,y1,x2,y2 : Byte; + WindMin,WindMax : Word; + WhereX, WhereY : Byte; + Beranz : Byte; + Ber : Berarray; + end; + + + + WinRecPtr = ^WinRec; {Pointer-Typ fr Window} + + WinRec = record + Next : WinRecPtr; + State : WinState; + Puffer: word; + end; + + + +const + linw = ''; + lins = ''; + ole = ''; + ore = ''; + ule = ''; + ure = ''; + brl = ''; + brr = ''; + bro = ''; + bru = ''; + + dlinw = ''; + dlins = ''; + dole = ''; + dore = ''; + dule = ''; + dure = ''; + dbrl = ''; + dbrr = ''; + dbro = ''; + dbru = ''; + + blinwo =''; + blinwu =''; + blinsr ={''}''; + blinsl ={''}''; + + ShadowX : byte=1; + ShadowY : byte=1; + + VerX : byte = 0; + VerY : byte = 1; + + + var + Topwindow: WinRecPtr; + W : WinRecPtr; + Map : Berptr; + vioseg : word; + {-Schreibt einen String an eine vorgegebene X/Y-Bildschirmpos.} +PROCEDURE WriteXY(x,y:Integer; st: string); + {-Lscht den Bildschirm unter Berksichtigung der Maus} +PROCEDURE Winclrscr; + {-Zeichnet einen einfachen oder doppelten Rahmen} +PROCEDURE WinFrame(x1,y1,x2,y2: byte; Rahmen:boolean); + {-Restauriert den Hintergrund eines Fenster} +PROCEDURE Restwindow; + {-Speichert den Hintergrund eines Fenster} +FUNCTION Savewin(x1,y1,x2,y2:byte) : boolean; + {-ffnet ein Fenster} +FUNCTION Openwindow (Lange,Breite:byte;farbevor,farbehin:byte;kopf:Message): boolean; + {-Schliet ein Fenster} +PROCEDURE Closewindow; + {-Fehlermeldung bei Heaperror} +Procedure HErrorMsg; + +Implementation + + +{============== Fehlerbehandlung Heap-Error =============} +{$F+} +Function HError(Size : Word) : Integer; +Begin + HError := 1; +End; +{$F-} + + +procedure writeXY(x,y:Integer; st: string); +var aktP :boolean; +begin + gotoxy(x,y); + If (Lo(windmin)+X+length(st) > aktX+1) and + (Lo(windmin)+X <= aktX+1) and + (Hi(windmin)+Y = aktY+1) then + aktP:=true + else aktP:=false; + If aktP then MouHideMouse; write(st); + If aktP then MouShowMouse; +end; + + +procedure Winclrscr; +begin + MouHideMouse; + clrscr; + MouShowMouse; +end; + +procedure WinFrame(x1,y1,x2,y2: byte; Rahmen:boolean); +var i : byte; + wlinw,wlins, + wole,wore,wule,wure:string[1]; +begin + If Rahmen then + begin + wlinw:=dlinw; + wlins:=dlins; + wole:=dole; + wore:=dore; + wule:=dule; + wure:=dure; + end else + begin + wlinw:=linw; + wlins:=lins; + wole:=ole; + wore:=ore; + wule:=ule; + wure:=ure; + end; + writexy(x1,y2,wule); + writexy(x2,y1,wore); + writexy(x1,y1,wole); + writexy(x2,y2,wure); + for i:=1 to (y2-y1)-1 do + begin + writexy(x1,y1+i,wlins); + writexy(x2,y1+i,wlins); + end; + writexy(x1+1,y1,padch('',wlinw[1],(x2-x1)-1)); + writexy(x1+1,y2,padch('',wlinw[1],(x2-x1)-1)); +end; + + +{-------------------------------------------------------------------------} +function GetVioPtr( Spalte, Zeile : byte ) : VPTR; +begin + GetVioPtr := Ptr( VioSeg, ( Crtxmax * Zeile + Spalte ) shl 1); +end; + +{-------------------------------------------------------------------------} + +procedure GetScr( x1, y1, x2, y2 : byte; BufPtr : pointer ); +var nbytes : integer; { zu kopierende Bytes pro Zeile } + +begin + MouHideMouse; + nbytes := ( x2 - x1 + 1 ) shl 1; { Bytes pro Zeile } + while y1 <= y2 do { die einzelnen Zeilen durchlaufen } + begin + Move( GetVioPtr(x1, y1)^, BufPtr^, nbytes); + inc( PTRREC( BufPtr ).Ofs, nbytes ); + inc( y1 ); { Y1 auf nchste Zeile setzen } + end; + MouShowMouse; +end; + +{-------------------------------------------------------------------------} + +procedure PutScr( x1, y1, x2, y2 : byte; BufPtr : pointer ); +var nbytes : integer; { zu kopierende Bytes pro Zeile } + +begin + MouHideMouse; + nbytes := ( x2 - x1 + 1 ) shl 1; { Bytes pro Zeile } + while y1 <= y2 do { die einzelnen Zeilen durchlaufen } + begin + Move( BufPtr^, GetVioPtr(x1, y1)^, nbytes); + inc( PTRREC( BufPtr ).Ofs, nbytes ); + inc( y1 ); { Y1 auf nchste Zeile setzen } + end; + MouShowMouse; +end; + +{-------------------------------------------------------------------------} + +procedure WinShadow( x, y: byte); + +var Attribut : byte; { das jeweils zu manipulierende Attribut } + i : byte; + +begin + if OrigMode<>7 then { im Color-Modus? } + begin + Attribut := mem[schirmanfang:((y-1)*crtxmax+x)*2-1] ; { Attribut des Zeichens holen } + {-- die Hintergrundfarbe verndern ----------------------------} + if Attribut and 128 <> 0 then { heller Hintergrund? } + Attribut := Attribut and 128 { Ja, Bit 7 ausblenden } + else { Nein, normaler Hintergrund } + Attribut := Attribut and 15; { Hintergrund jetzt schwarz } + {-- die Vordergrundfarbe verndern ----------------------------} + if Attribut and 8 <> 0 then { heller Vordergrund? } + Attribut := Attribut and (255 - 8); { Ja, Bit 3 ausblenden } + mem[schirmanfang:((y-1)*crtxmax+x)*2-1]:=Attribut; + end + else { Nein, im Monochrom-Modus } + mem[schirmanfang:((y-1)*crtxmax+x)*2-2]:=ord( '' ); +end; + +{-------------------------------------------------------------------------} + +function savewin(x1,y1,x2,y2:byte) : boolean; +var BufLen : integer; { Lnge des Fenster-Puffers } + +begin + BufLen := ( (x2+ShadowX) - x1 + 3 ) * ( (y2+ShadowY) - y1 + 3 ) shl 1; + GetMem( W, BufLen + SizeOf( Winrec ) - 1 ); + If W=NIL then + begin + HErrorMsg; savewin:=false; exit; + end else + savewin:=true; + {EndIF} + with W^ do + begin + Next:=Topwindow; + State.x1:=x1; + State.y1:=y1; + State.x2:=x2; + State.y2:=y2; + State.WindMin:=WindMin; + State.WindMax:=WindMax; + State.WhereX :=WhereX; + State.WhereY :=WhereY; + State.Beranz :=AnzBereiche; + State.Ber :=Map^; + GetScr( x1-2, y1-2, x2+ShadowX, y2+ShadowY, @Puffer ); + end; + Anzbereiche:=1; + TopWindow:=W; +end; + + +{-------------------------------------------------------------------------} +procedure restwindow; + var + buf : word; + z : byte; +begin + If Topwindow<>nil then + begin + W:=Topwindow; + with W^ do + begin + PutScr( State.x1-2,State.y1-2,State.x2+ShadowX,State.y2+ShadowY, @Puffer ); + TopWindow := Next; + Window(lo(w^.State.Windmin)+1,hi(w^.State.Windmin)+1, + lo(w^.State.Windmax)+1,hi(w^.State.Windmax)+1 ); + gotoxy(WhereX,WhereY); + buf:=( (State.x2+ShadowX) - State.x1 + 3) * ( (State.y2+ShadowY) - State.y1 + 3 ) shl 1; + Map^:=w^.State.Ber; + MouDefBereich(w^.State.Beranz,Map); + FreeMem( W,( (State.x2+ShadowX) - State.x1 + 3) * ( (State.y2+ShadowY) - State.y1 + 3 ) + shl 1 + SizeOf(WINREC) - 1); + end; + end; + +end; + +{-------------------------------------------------------------------------} +procedure winopenshadow (x1,y1,x2,y2: byte); +var i,s : byte; + +begin + MouHideMouse; + for i:=y1+ShadowY-1 to y2+ShadowY+1 do + begin + for s:=1 to ShadowX do + Winshadow(x2+s+1,i); + end; + for i:=x1+ShadowX-1 to x2+ShadowX do + begin + for s:=1 to ShadowY do + Winshadow(i,y2+s+1); + end; + MouShowMouse; +end; + + +{-------------------------------------------------------------------------} +procedure PaintRahmen(x1,y1,x2,y2: byte;farbevor,farbehin:byte;kopf:Message); +var l :byte; + +begin + textbackground(farbehin);textcolor(farbevor); + winframe(x1-1,y1-1,x2+1,y2+1,true); + window(x1,y1-1,x2,y2); + writexy((((x2-x1+3) Div 2)-(length(kopf)+2) Div 2),1,concat(' ',kopf,' ')); + window(x1,y1,x2,y2); + winclrscr; + gotoxy(1,1); +end; + + +{-------------------------------------------------------------------------} +function openwindow (Lange,Breite:byte;farbevor,farbehin:byte;kopf: Message) :boolean; +var x1,y1,x2,y2 : byte; + +begin + x1:=(Crtxmax Div 2) - (Lange Div 2)+VerX; + x2:=x1+Lange; + y1:=(Crtymax Div 2) - (Breite Div 2) + VerY; + y2:=y1+Breite; + If not savewin (x1,y1,x2,y2) then + begin + openwindow:=false; exit; + end else + openwindow:=true; + window(1,1,CrtXmax,CrtYmax); + PaintRahmen(x1,y1,x2,y2,farbevor,farbehin,Kopf); + If (Crtxmax>(x2+ShadowX)) and (Crtymax>(y2+ShadowY)) then + winopenshadow (x1,y1,x2,y2); + window(x1,y1,x2,y2); inc(fenanz); gotoxy(1,1); + Map^[fenanz].x1:=x1-1; Map^[fenanz].y1:=y1-1;Map^[fenanz].x2:=x2-1; Map^[fenanz].y2:=y2-1; + MouDefBereich(fenanz+1,Map); + {MouSetMoveArea( x1-1, y1-1, x2-1, y2-1);} +end; + + +{-------------------------------------------------------------------------} +procedure closewindow; +begin + restwindow; ev.Ereignis:=0; dec(fenanz); +end; + + + +{============== Fehlermeldung bei Heap-Error =============} +Procedure HErrorMsg; +Var + OldWindMax, OldWindMin : Word; + OldAttr : Byte; + Buffer : Array[1..264] of Byte; + +Begin + {---------------- Statuszeile retten -----------} + OldWindMax := WindMax; OldWindMin := WindMin; + OldAttr := TextAttr; + GetScr(0,CrtYmax-1,CrtXmax-1,CrtYmax-1,@Buffer); + {---------------- Meldung ausgeben --------------} + Window(1, CrtYMax, CrtXMax, CrtYMax); + TextAttr := Red*16+Yellow; MouHideMouse; ClrScr; MouShowMouse; + WriteXY(10, 1, 'Nicht genug Speicher fr das Programm ! '); + KbClrevent; KbmEventWait( EV_KEY_ALL, ev ); KbClrevent; + {--------- Statuszeile wiederherstellen --------------------} + PutScr( 0, CrtYmax-1, CrtXmax-1, CrtYmax-1, @Buffer ); + TextAttr := OldAttr; + WindMin := OldWindMin; WindMax := OldWindMax; +End; + + + +begin + HeapError := @HError; {Behandlung von Heap-Fehlern} + CheckBreak:=false; + GetMem( Map, SizeOf( Berarray )+1); + Map^[0].x1:=0; Map^[0].y1:=0;Map^[0].x2:=CrtXmax-1; Map^[0].y2:=CrtYmax-1; + MouDefBereich(1,Map); + Vioseg:=schirmanfang; +end. \ No newline at end of file diff --git a/UNITS/TPACKEN.PAS b/UNITS/TPACKEN.PAS new file mode 100644 index 0000000..a4abfd1 --- /dev/null +++ b/UNITS/TPACKEN.PAS @@ -0,0 +1,214 @@ +UNIT TPacken; + +Interface +uses TDatei,Tkwin,Tkstring,Tkstream,Dos,Init,Tkdisk,Tksaa,Tkvideo,KBM,Tkview,Crt; + +Type + Packen = Object(Datei) + Constructor Init; + + procedure Listendatei(var z:longint;var ausw:boolean); + function Packen_Entpacken : boolean; virtual; + + procedure Packerlst(PPointer :Pointer;var feldpos:byte); + procedure Moduslst (feld: array of FilenameStr;var feldpos:byte); + function Execend(name:string;M:Message;Ar:Acceptrec) : byte; virtual; + + Destructor Done; + End{Packen}; + + + +Implementation + +Constructor Packen.Init; +begin + Datei.Init; +end; + +function Packen.Packen_Entpacken : boolean; +begin +end; + + + +procedure Packen.Listendatei(var z:longint;var ausw:boolean); + var fullver: pathstr; + Verstr : Ftemp; + +begin + z:=0; ausw:=false; Verstr.ver_dat:=false; + chver(m_tempverz); + + Pdat.Create; Filsel.Open; + while not Filsel.EOF do + begin + fullver:=Verzlesen; + If fullver[1]='\' then delete(fullver,1,1); + Verstr.Ver_dat:=false; + while not Filsel.EOF and not Verstr.ver_dat do + begin + Filsel.Read(Verstr,-1,1); + If Verstr.select and not Verstr.Ver_dat then + begin + Pdat.Writeln(concat(fullver,Verstr.name)); + inc(z);ausw:=true; + end; + If Verstr.ver_dat then + begin + Filsel.Seek(Filsel.Pos-1); + end; + end; + end; + If (z=0) and (not dat.ver_dat and (dat.fpos>1)) then + begin + fullver:=addbackslash(fullpath(dat.vpos))+dat.fil[dat.fpos].name; + If fullver[1]='\' then delete(fullver,1,1); + Pdat.Writeln(fullver);inc(z); + end; + Pdat.close; Filsel.Close; +end; + + +procedure Packen.Packerlst(PPointer :Pointer;var feldpos:byte); +var S : Selectview1; + weiter, + Ok : boolean; + Bu : Button; + PackP : PackPointer; + I,z : byte; + +begin + If not openwindow(21,16,fenfo,fenba,'Packer') then exit; + textcolor(Balkenback); + WinFrame(3,1,19,14,false); + S.Init(4,2,19,13,fenba); + S.SetMarkMode(false); + PackP:=PPointer; + while PackP<>NIL do + begin + S.AppendStr(PackP^.name); + PackP:=PackP^.next; + end; + S.LineTop; + For z:=1 to feldpos do S.LineDown; + Initbutton (Bu,2, 16,' ~OK ' ,Alt_O,1); + Initbutton (Bu,12,16,' ~Abbruch ',Alt_A,2); Bu.anz:=2; + weiter:=false; OK:=false; I:=1; + repeat + Setbutton(Bu); + S.ViewLines; + case I of + 1 : ActiveButton(Bu); + end; + case EventThisbutton(Bu) of + 1 : begin + weiter:=true; OK:=true; + end; + 2 : begin + weiter:=true; OK:=false; + end; + end; + case ev.Ereignis of + EV_KEY_PRESSED : + case ev.key of + ESC: begin + weiter:=true; Ok:=false; + end; + end{Case}; + end{Case}; + If S.CtrlCode=CR then + begin + weiter:=true; OK:=true; + end; + S.CtrlLines; + until weiter; + If OK then feldpos:=S.GetLineNumber-1; + closewindow; +end; + + + procedure Packen.Moduslst (feld: array of FilenameStr;var feldpos:byte); + var i : byte; + weiter : boolean; + Rb : Rabutton; + Bu : Button; + begin + If not openwindow(21,High(feld)+4,fenfo,fenba,'Modus') then exit; + for i:=0 to High(feld) do + InitRadioButton(Rb,6,i+2,trim(feld[i]),i+1); + Rb.Anz:=High(feld)+1; + Rb.Sel:=feldpos+1; + Rb.Pos:=Rb.Sel; + InitButton(Bu, 2,High(feld)+4,' ~OK ', ALT_O,1); + InitButton(Bu,12,High(feld)+4,' ~Abbruch ',ALT_A,2); Bu.Anz:=2; + I:=1; weiter:=false; + repeat + SetRadioButton(Rb); + SetButton (Bu); + case I of + 1: ActiveRadioButton(Rb); + 2: ActiveButton (Bu); + end; + + case EventThisButton(Bu) of + 1: begin weiter:=true; feldpos:=Rb.Sel-1; end; + 2: weiter:=true; + end; + + If EventRadioButton(Rb) then I:=1; + + case ev.key of + TAB : If I<2 then Inc(I) else I:=1; + BACKTAB: If I>2 then dec(I) else I:=2; + Esc : weiter:=true; + end; + until weiter; + closewindow; + end; + + + + + +{------------------ Entpacken ----------------------------} + + + + + + function Packen.Execend(name:string;M:Message;Ar:Acceptrec) : byte; + var Errorlevel : word; + z : byte; + + begin + Execend:=2; + If Doserror>0 then + begin + If Doserror=1 then inc(Doserror,220); + MouShowMouse; + Execend:=IO_Error(M,'IOERROR.MSG',Doserror,AR); + MouHideMouse; + Doserror:=0; + end; + Errorlevel:=Dosexitcode; + If (LO(Errorlevel))>0 then + begin + MouShowMouse; + Execend:=IO_Error(M,justname(name),Errorlevel,AR); + MouHideMouse; + end; + end; + + + + + + + +Destructor Packen.Done; +begin +end; + +begin +end. \ No newline at end of file diff --git a/UNITS/TPINST.PAS b/UNITS/TPINST.PAS new file mode 100644 index 0000000..20bb140 --- /dev/null +++ b/UNITS/TPINST.PAS @@ -0,0 +1,180 @@ +{*************************************************************************** +* TPInst : Diese Unit stellt verschiedene Prozeduren zur Erstellung von * +* Installationsprogrammen in der Art von Turbo's TINST zur Ver- * +* fgung. Wie TINST knnen die Einstellungen direkt in die EXE- * +* Datei des Programms geschrieben werden. Eine Konfigurations- * +* wird nicht bentigt! * +**------------------------------------------------------------------------** +* Autor : MICHAEL TISCHER * +* entwickelt am : 18.06.1989 * +* letztes Update am : 07.09.1989 * +***************************************************************************} + +unit TPInst; + +interface + +{------- Einbinden der bentigten Units -----------------------------------} + +uses Crt,Dos; { Turbo Pascal CRT-Unit } + + +var f_spe : boolean; + ExeTime : Longint; +{-- Prozeduren und Funktionen, die fr andere Units zugnglich sind -------} + +function TPIOpenFile ( Name : string; Offset : longint) : boolean; +procedure TPISaveChanges; +procedure TPICLoseFile; +procedure TPIGet ( Adresse : word; Laenge : word; var Puffer ); +procedure TPIPut ( Adresse : word; Laenge : word; var Puffer ); + + + +implementation + +{-- Konstanten, Typen und Variablen, die nur intern Verwendung finden -----} + +const Leer = ' '; + +type SegmentTyp = array [ 0 .. 500 ] of byte; { das Datensegment } + +var ExeFile : file; { File-Var. fr Zugriff auf EXE-Datei } + DataSegment : ^SegmentTyp; { Platz fr Datensegment } + DataSegSize : word; { Gre des Datensegments in Bytes } + DataWriteBack : word; { Anzahl der zurckzuschreibenden Bytes } + DataSegStart : longint; { Start des Datensegments im EXE-File } + + +{*************************************************************************** +* TPIOpenFile : Erfffnet die Arbeit mit den Routinen aus dieser Unit * +* und liest gleichzeitg das Datensegment aus der zu in- * +* stallierenden EXE-Datei ein. * +**------------------------------------------------------------------------** +* Eingabe : NAME = Name der EXE-Datei * +* OFFSET = Offset des Datensegments innerhalb der EXE-Datei * +* Ausgabe : TRUE, wenn Datei erfolgreich geffnet wurde; * +* FALSE, wenn die Datei nicht gefunden wurde * +* Info : Die Offsetadresse des Datensegments kann der Konstanten * +* DSEG_START entnommen werden, die innerhalb der von TPIC er- * +* stellten Konstanten-Datei aufgefhrt wird. * +***************************************************************************} + +function TPIOpenFile( Name : string; Offset : longint) : boolean; + +var OK : boolean; { Status nach ffnen der Datei } + +begin + {-- EXE-Datei ffnen ----------------------------------------------------} + + Assign( ExeFile, Name ); + {$I-} { I/O Prfung durch Turbo Pascal abschalten } + Reset( ExeFile, 1 ); { Datei ffnen , Satzlnge = 1 } + GetFTime(Exefile,ExeTime); + OK := ( IOResult = 0 ); + {$I+} { I/O Prfung durch Turbo Pascal wieder einschalten } + + {-- Datensegment aus der EXE-Datei in den Speicher lesen ----------------} + + if ( OK ) then { ffnen der Datei erfolgreich? } + begin { Ja, Datensegment lesen } + New( DataSegment ); { Platz fr Kopie des DSEG auf Heap } + Seek( ExeFile, Offset ); { Dateizeiger positionieren } + BlockRead( ExeFile, DataSegment^, 65521, DataSegSize); { und lesen } + DataWriteBack := 0; { grte bisher genderte Offsetadresse } + DataSegStart := Offset; { Startadr. des Datensegments merken } + end; + + TPIOpenFile := OK; { Ergebnis zurckgeben } + f_spe:=false; +end; + +{*************************************************************************** +* TPISaveChanges : Schreibt das Datensegment inklusive der vorgenommenen * +* nderungen zurck in die EXE-Datei * +**------------------------------------------------------------------------** +* Info : Es werden nur die Bytes zwischen dem Anfang des Datensegments * +* und der Konstanten mit der hchsten Offsetadrese zurck in die * +* Datei geschrieben, damit nicht unntig Zeit vergeudet wird. * +***************************************************************************} + +procedure TPISaveChanges; +begin + {$I-} + Seek( ExeFile, DataSegStart); { Dateizeiger auf Datensegment setzen } + if ( DataWriteBack <= DataSegSize ) then { genderten Teil } + BlockWrite( ExeFile, DataSegment^, DataWriteBack) { des Datensegments } + else { zurckschreiben } + BlockWrite( ExeFile, DataSegment^, DataSegSize); + {$I+} + If Ioresult=0 then f_spe:=false + else f_spe:=true; +end; + +{*************************************************************************** +* TPICloseFile : Schliet die EXE-Datei wieder, in der die Installationen * +* vorgenommen wurden. * +***************************************************************************} + +procedure TPICLoseFile; + +begin + if not f_spe then + begin + {$I-} + SetFTime(ExeFile,ExeTime); + close( ExeFile ); { Datei schlieen } + {$I+} + + If (ioresult>0) then + begin + f_spe:=true; + {$I-} + reset(ExeFile,1); + {$I+} + end; + if not f_spe then + dispose( DataSegment ); { Speicherplatz fr Datensegment freigeben } + end; +end; + +{*************************************************************************** +* TPIGet : Liest eine typisierte Konstante aus dem Datensegment innerhalb * +* der EXE-Datei in eine Variable * +**------------------------------------------------------------------------** +* Eingabe : ADRESSE = Adresse der typisierten Konstante (aus TCA-Datei) * +* LAENGE = Gre der Konstante in Bytes * +* PUFFER = Puffer/Variable zur Aufnahme der Konstanten * +***************************************************************************} + +procedure TPIGet( Adresse : word; Laenge : word; var Puffer ); + +begin { Inhalt in Puffer kopieren } + Move( DataSegment^[ Adresse ], Puffer, Laenge ); +end; + +{*************************************************************************** +* TPIPut : Schreibt eine typisierte Konstante in das Datensegment inner- * +* halb der EXE-Datei * +**------------------------------------------------------------------------** +* Eingabe : ADRESSE = Adresse der typisierten Konstante (aus TCA-Datei) * +* LAENGE = Gre der Konstanten in Bytes * +* PUFFER = jetziger "Lagerort" der Konstanten * +***************************************************************************} + +procedure TPIPut( Adresse : word; Laenge : word; var Puffer ); + +begin + {-- Inhalt von Puffer in Datensegment zurckschreiben -------------------} + + Move( Puffer, DataSegment^[ Adresse ], Laenge ); + + {-- Hchstgrenze fr nderungen im Datensgement aktualisieren -----------} + + if ( Adresse + Laenge > DataWriteBack ) then + DataWriteBack := Adresse + Laenge; +end; + + +begin { nix zum Initialisieren } +end. diff --git a/UNITS/TURFEN.PAS b/UNITS/TURFEN.PAS new file mode 100644 index 0000000..9e138da --- /dev/null +++ b/UNITS/TURFEN.PAS @@ -0,0 +1,187 @@ +UNIT TUrfen; + +Interface +uses TKstream,Init,TKSaa,Dos,Crt,TKvideo,TKwin,TKstring,KBM; + + + Type + + UrFenster = Object + einmal : boolean; + dat : FensterDat; + xanf, + yanf, + ydiff, + xdiff : byte; + change : boolean; + ebene : byte; + Fmod : FensterModeR; + + einschub : byte; + Filsel, + Filind : Typedstream; + LaBu : Button; + Fendg : endg; + + {Urfen.Pas} Constructor Init; + function fullpath (vpos:word) : pathstr; + procedure Pfeilwrite(pfeil:boolean;vpos:word); + + procedure Summev (var SelGro:longint;var SelAnz:word); + procedure Summed (var SelGro:longint;var GesGro:longint); + procedure Unterfenster; + procedure ClrUnterf; + procedure Clrwin; + Destructor Done; + End{Urfenster}; + + + Implementation + + Constructor Urfenster.Init; + begin + end; + + + function Urfenster.fullpath(vpos:word): pathstr; + var pfad, + hpfad: pathstr; + a : word; + p : byte; + begin + a:=0; + If (dat.ver[vpos].Vart=Verzeichnis) then + pfad :=dat.ver[vpos].name else pfad:=''; + p :=dat.ver[vpos].pos; + for a:=vpos downto 1 do + begin + If (dat.ver[a].pos < p) and (dat.ver[a].Vart=Verzeichnis) then + begin + pfad:=addbackslash(dat.ver[a].name)+pfad; + p:=dat.ver[a].pos; + end; + end; + fullpath:=pfad; + end; + + + + + procedure Urfenster.Pfeilwrite(pfeil:boolean;vpos:word); + var S : string; + P : string; + begin + window(1,yanf-2,crtxmax,crtymax); + textcolor(Pfeilfo);textbackground(Pfeilba); + S:=''; + If dat.ver[1].Vart=Packer then + S:=S+dat.ver[1].name+':'; + P:=ShrinkPath(fullpath(vpos),xdiff-12-length(S)); + S:=S+pad(ShrinkPath(fullpath(vpos),xdiff-12-length(S)),xdiff-11-length(S)); + writeXY(xanf+3,1,S); + If pfeil then + If Fmod=Links then + writeXY(xdiff-2,1,'') + else + writeXY(xdiff-2,1,''); + window(xanf,yanf,xanf+xdiff-3,yanf+ydiff+1); + dat.aktverz:=fullpath(dat.vpos); + end; + + + + procedure Urfenster.Summev (var SelGro:longint;var SelAnz:word); + var j : word; + begin + Selgro:=0; SelAnz:=0; + for j:=1 to dat.veranz do + begin + If dat.ver[j].files>0 then + begin + inc(SelGro,dat.ver[j].selgr); + inc(SelAnz,dat.ver[j].files); + end; + end; + end; + + + procedure Urfenster.Summed (var SelGro:longint;var GesGro:longint); + var j : word; + begin + SelGro:=0; GesGro:=0; + for j:=2 to dat.filanz do + begin + If dat.fil[j].select then + begin + inc(SelGro,dat.fil[j].size); + end; + inc(GesGro,dat.fil[j].size); + end; + end; + + procedure Urfenster.Unterfenster; + var GesGro:longint; + Selanz:word; + Ratio :real; + Ratiostr: string[7]; + begin + textbackground(Winba); textcolor(Winfo); + If dat.ver_dat then + begin + summev(dat.selgr,Selanz); + writeXY(13 , ydiff,leftpadch(SpNumber(Selanz),' ',6)); + writeXY(23, ydiff,leftpadch(SpNumber(dat.selgr)+' B',' ',15)); + end else + begin + summed(dat.ver[dat.vpos].selgr,GesGro); + writeXY(13 ,ydiff,leftpadch(SpNumber(dat.ver[dat.vpos].files),' ',6)); + writeXY(23 ,ydiff,leftpadch(SpNumber(dat.ver[dat.vpos].selgr)+' B',' ',15)); + end; + case Fmod of +Rechts,Links :begin + writeXY(18,ydiff+1,leftpadch(SpNumber(dat.dsize)+' B',' ',15)); + writeXY(18,ydiff+2,leftpadch(SpNumber(dat.dfree)+' B',' ',15)); + end; + Archiv :begin + If dat.arcorig > 0 then + Ratio:=dat.arckomp/dat.arcorig *100 else Ratio:=100; + str (Ratio:3:2,Ratiostr); Ratiostr:=Ratiostr+'%'; + writeXY(10,ydiff+1,leftpadch(SpNumber(dat.arcorig)+' B',' ',15)); + writeXY(10,ydiff+2,leftpadch(SpNumber(dat.arckomp)+' B',' ',15)); + writeXY(31,ydiff+1,leftpadch(Ratiostr,' ',7)); + writeXY(31,ydiff+2,leftpad(dat.arckind,7)); + end; + end{Case}; + end; + + + procedure Urfenster.ClrUnterf; + var Wmax,Wmin : word; + begin + Wmax:=WindMax; Wmin:=WindMin; textbackground(Winba); + {window(Lo(Wmin)+1,Hi(Wmin)+1+ydiff-1,Lo(Wmax)+1,Hi(Wmax)+1);} + window(xanf,ydiff+3,xanf+xdiff-3,yanf+ydiff+1); + winclrscr; + window(Lo(Wmin)+1,Hi(Wmin)+1,Lo(Wmax)+1,Hi(Wmax)+1); + end; + + + procedure Urfenster.clrwin; + begin + window(LO(windmin)+1,Hi(windmin)+1,LO(windmax)+1,HI(windmax)-3); + textbackground(Winba);winclrscr; + window(LO(windmin)+1,Hi(windmin)+1,LO(windmax)+1,HI(windmax)+5); + end; + + + + + Destructor Urfenster.Done; + begin + end; + + + + +begin +end. \ No newline at end of file