home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / huckepac.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  12.3 KB  |  322 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. (*===================================================================*)
  3. (*                    HUCKEPACK.PAS Version 1.0                      *)
  4. (*                  Copyright (C) 1993 te-wi Verlag                  *)
  5. (*===================================================================*)
  6. (*                                                                   *)
  7. (*  Funktion: Ersetzen von Konfigurationsdateien, indem              *)
  8. (*            Konfigurationsdaten an das EXE-Programm                *)
  9. (*            (ParamStr(0)) angehängt werden.                        *)
  10. (*                                                                   *)
  11. (*  Vorbemerkung:                                                    *)
  12. (*   Turbo Pascal ab Version 5.5 erlaubt es, Overlays mit            *)
  13. (*      COPY/B programm+overlay prg                                  *)
  14. (*   an das EXE-File anzuhängen. Solche Programme dürfen             *)
  15. (*   HuckePack auf keinen Fall verwenden, da hier die Daten          *)
  16. (*   in das Overlay geschrieben würden!                              *)
  17. (*-------------------------------------------------------------------*)
  18. (*  INTERFACE-Variablen:                                             *)
  19. (*                                                                   *)
  20. (*  MaxVars: BYTE (Voreinstellung 20 Bytes = Verlängerung um         *)
  21. (*           23 Bytes)                                               *)
  22. (*  ExeName: STRING (Voreinstellung: ParamStr(0) = Name des          *)
  23. (*           Programmes)                                             *)
  24. (*-------------------------------------------------------------------*)
  25. (*  INTERFACE-Prozeduren:                                            *)
  26. (*                                                                   *)
  27. (*  PROCEDURE WriteVarToExeFile(VarAdr: LongInt;                     *)
  28. (*                              Variable: BYTE);                     *)
  29. (*   Schreibt die Byte-Variable 'Variable' an die Stelle             *)
  30. (*   VarAdr des Überhang-Bereiches. Ist der Variablenbereich         *)
  31. (*   noch nicht vorhanden, wird er automatisch initialisiert.        *)
  32. (*                                                                   *)
  33. (*  PROCEDURE ReadVarFromExeFile(VarAdr: LongInt;                    *)
  34. (*                               VAR Variable: BYTE);                *)
  35. (*   Liest aus dem Variablenbereich die Variable 'Variable'.         *)
  36. (*   Ist noch kein Variablenbereich initialisiert wird der neu       *)
  37. (*   gebildet und mit Nullen aufgefüllt.                             *)
  38. (*                                                                   *)
  39. (*  Aufbau des Variablenbereiches:                                   *)
  40. (*  Benutzt werden kann der Bereich von Byte 0 bis Byte              *)
  41. (*  MaxVars. Vor dem Bereich werden noch zwei Zeichen (JB)           *)
  42. (*  angehängt, die mit                                               *)
  43. (*    ReadVarFromExeFile(-2, t1);                                    *)
  44. (*    ReadVarFromExeFile(-1, t2);                                    *)
  45. (*    IF (t1 <> 74) AND (t2 <> 66) THEN { Fehler! }                  *)
  46. (*  getestet werden.                                                 *)
  47. (*                                                                   *)
  48. (*  Die Unit liest und schreibt in der EXE-Datei auch dann,          *)
  49. (*  wenn diese schreibgeschützt ist. Vor jedem Lese- und             *)
  50. (*  Schreibvorgang werden die Dateiattribute und das Datei-          *)
  51. (*  Erstellungsdatum gelesen und anschließend wieder restauriert.    *)
  52. (*  Sind Virus-Checker installiert, die die Dateien auf              *)
  53. (*  Längenänderungen prüfen oder die es verhindern, daß              *)
  54. (*  Datei-Attribute geändert werden, kann es mit Programmen          *)
  55. (*  Probleme geben, die die UNIT Huckepack verwenden. Unter          *)
  56. (*  normalen Umständen ist es für den Benutzer aber nicht            *)
  57. (*  feststellbar, daß die Programme manipuliert werden.              *)
  58. (*  Das EXE-Programm selbst merkt nicht, daß es verlängert           *)
  59. (*  wird, da die Programmlänge ausschließlich aus der im             *)
  60. (*  Header vermerken Länge geholt wird und hier keine                *)
  61. (*  Manipulationen stattfinden.                                      *)
  62. (*-------------------------------------------------------------------*)
  63. (*  INTERFACE-Funktionen:                                            *)
  64. (*                                                                   *)
  65. (*  FUNCTION GetRealFileLength: LongInt;                             *)
  66. (*   Die Funktion ermittelt die effektive Länge einer Datei.         *)
  67. (*                                                                   *)
  68. (*  FUNCTION GetFileLenFromHeader: LongInt;                          *)
  69. (*   Die Funktion ermittelt die im EXE-Header angegebene             *)
  70. (*   Programmlänge  eines EXE-Files. Wird die Funktion auf           *)
  71. (*   ein Programm oder eine Datei angewandt, die nicht im            *)
  72. (*   EXE-Format vorliegt, gibt die Funktion 0 zurück.                *)
  73. (*                                                                   *)
  74. (*   Sollen die beiden Funktionen auf ein anderes Programm           *)
  75. (*   als ParamStr(0) angewandt werden, muß die in Huckepack          *)
  76. (*   definierte Variable ExeFile im aufrufenden Programm             *)
  77. (*   entsprechend überschrieben werden, z.B:                         *)
  78. (*                                                                   *)
  79. (*   ExeName := ParamStr(1);                                         *)
  80. (*   IF GetFileLenFromHeader = 0 THEN { Fehler }                     *)
  81. (*   ELSE                                                            *)
  82. (*   BEGIN                                                           *)
  83. (*     IF GetRealFileLength <> GetFileLenFromHeader THEN ...         *)
  84. (*                                                                   *)
  85. (*  Intern werden die Funktionen verwendet, um zu prüfen, ob         *)
  86. (*  das Programm bereits einen Variablenüberhang enthält.            *)
  87. (*                                                                   *)
  88. (*===================================================================*)
  89.  
  90. UNIT Huckepack;
  91.  
  92. INTERFACE
  93.  
  94. CONST                (* Länge des Variablenbereiches, ggf. anpassen! *)
  95.   MaxVars : BYTE = 20;
  96. VAR
  97.   ExeName : STRING;
  98.  
  99. PROCEDURE WriteVarToEXEFile(VarAdr: LONGINT;  Variable: BYTE);
  100. PROCEDURE ReadVarFromEXEFile(VarAdr: LONGINT; VAR Variable: BYTE);
  101. FUNCTION  GetRealFileLength: LONGINT;
  102. FUNCTION  GetFileLenFromHeader: LONGINT;
  103.  
  104. IMPLEMENTATION
  105.  
  106. USES
  107.   Dos;
  108.  
  109. VAR
  110.   ExePath : DirStr;
  111.   ExeExt  : ExtStr;
  112.   Name    : NameStr;
  113.   IOError : INTEGER;
  114.  
  115. CONST
  116.   FTime : LONGINT = 0;
  117.   FAttr : WORD    = Archive;
  118.  
  119. (*-------------------------------------------------------------------*)
  120.  
  121. PROCEDURE Error(err: INTEGER);
  122. VAR
  123.   Msg: STRING;
  124.   Regs: Registers;
  125. BEGIN
  126.   CASE err OF
  127.     $02: Msg := 'Datei nicht gefunden';
  128.     $03: Msg := 'Pfad nicht gefunden';
  129.     $04: Msg := 'Zugriff verweigert';
  130.     $06: Msg := 'Fehlerhafter Zugriff';
  131.     $12: Msg := 'Zu viele Dateien';
  132.     $FE: Msg := 'Falsche DOS-Version';
  133.     ELSE Msg := 'unerwarteter Fehler';
  134.   END;{CASE}
  135.   WriteLn('Es ist ein Fehler aufgetreten!');
  136.   WriteLn('Fehlernummer: ', err);
  137.   WriteLn('Erläuterung : ', Msg + Chr(13) + Chr(10));
  138.   Write('Das Programm wird abgebrochen!');
  139.   IF Mem[$0040:$0049] = 7 THEN {HercMono}
  140.     Regs.CX := $0709
  141.   ELSE
  142.     Regs.CX := $0607; {CGA/EGA}
  143.   Regs.AH := $01; {Cursor setzen}
  144.   Intr($10, Regs);
  145.   Halt(BYTE(err));
  146. END;{Error}
  147.  
  148. (*-------------------------------------------------------------------*)
  149. (* Die Prozeduren PrepareFile u. RestoreSettings MÜSSEN immer und    *)
  150. (* grundsätzlich alternierend aufgerufen werden. Eine Verschachtelung*)
  151. (* führt zu falschen Resultaten !!!!!!                               *)
  152. (*-------------------------------------------------------------------*)
  153.  
  154. PROCEDURE PrepareFile(FileName: PathStr);
  155. VAR
  156.   f: FILE;
  157. BEGIN
  158.   Assign(f, FileName);
  159.   GetFAttr(f, FAttr);
  160.   IOError := DosError;
  161.   IF IOError <> 0 THEN Error(IOError);
  162.   SetFAttr(f, Archive);
  163.   IOError := DosError;
  164.   IF IOError <> 0 THEN Error(IOError);
  165.   Assign(f, FileName);
  166.   Reset(f);
  167.   IOError := IOResult;
  168.   IF IOError <> 0 THEN Error(IOError);
  169.   GetFTime(f, FTime);
  170.   Close(f);
  171. END;
  172.  
  173. (*-------------------------------------------------------------------*)
  174.  
  175. PROCEDURE RestoreSettings(FileName: PathStr);
  176. VAR
  177.   f: FILE;
  178. BEGIN
  179.   Assign(f, FileName);
  180.   Reset(f);
  181.   IOError := IOResult;
  182.   IF IOError <> 0 THEN Error(IOError);
  183.   SetFTime(f, FTime);
  184.   Close(f);
  185.   Assign(f, FileName);
  186.   SetFAttr(f, FAttr);
  187.   IOError := DosError;
  188.   IF IOError <> 0 THEN Error(IOError);
  189. END;
  190.  
  191. (*-------------------------------------------------------------------*)
  192.  
  193. FUNCTION GetFileLenFromHeader: LONGINT;
  194. VAR
  195.   ExeFile: FILE OF BYTE;
  196.   IDByte : ARRAY[1..2] OF BYTE;
  197.   g      : ARRAY[1..4] OF BYTE;
  198. BEGIN
  199.   PrepareFile(ExeName);
  200.   Assign(ExeFile, ExeName);
  201.   Reset(ExeFile);
  202.   IOError := IOResult;
  203.   IF IOError <> 0 THEN Error(IOError);
  204.   Read(ExeFile, IDByte[1]);
  205.   Read(ExeFile, IDByte[2]);
  206.   IF (Chr(IDByte[1]) = 'M') AND (Chr(IDByte[2]) = 'Z') THEN
  207.                      BEGIN                            (* EXE-Kennung *)
  208.     Read(ExeFile, g[1]);
  209.     Read(ExeFile, g[2]);
  210.     Read(ExeFile, g[3]);
  211.     Read(ExeFile, g[4]);
  212.     Close(ExeFile);
  213.     IF (g[1] = 0) AND (g[2] = 0) THEN
  214.       GetFileLenFromHeader :=
  215.           LONGINT(g[4]) * 256 + LONGINT(g[3])
  216.     ELSE
  217.       GetFileLenFromHeader :=
  218.         ((LONGINT(g[4]) * 256 +
  219.           LONGINT(g[3])) - 1) * 512 +
  220.          (LONGINT(g[2]) * 256 +
  221.           LONGINT(g[1]));
  222.   END
  223.   ELSE
  224.   GetFileLenFromHeader := 0;
  225.   RestoreSettings(ExeName);
  226. END;
  227.  
  228. (*-------------------------------------------------------------------*)
  229.  
  230. FUNCTION GetRealFileLength: LONGINT;
  231. VAR
  232.   fle : FILE;
  233. BEGIN
  234.   PrepareFile(ExeName);
  235.   Assign(fle, ExeName);
  236.   Reset(fle, 1);
  237.   IOError := IOResult;
  238.   IF IOError <> 0 THEN Error(IOError);
  239.   GetRealFileLength := FileSize(fle);
  240.   Close(fle);
  241.   RestoreSettings(ExeName);
  242. END;
  243.  
  244. (*-------------------------------------------------------------------*)
  245.  
  246. PROCEDURE WriteVarToEXEFile(VarAdr: LONGINT;
  247.                             Variable: BYTE);
  248. VAR
  249.   i, Init    : BYTE;
  250.   f          : FILE;
  251.   ExeFile    : FILE OF BYTE;
  252.   FleLength,
  253.   ExeLength  : LONGINT;
  254. BEGIN
  255.   ExeLength := GetFileLenFromHeader;
  256.   FleLength := GetRealFileLength;
  257.   PrepareFile(ExeName);
  258.   IF FleLength = ExeLength THEN
  259.   BEGIN
  260.     Init := 0;                    (* Variablenbereich initialisieren *)
  261.     Assign(ExeFile, ExeName);
  262.     Reset(ExeFile);
  263.     Seek(ExeFile, ExeLength);
  264.     Init := BYTE(Ord('J'));                  (* Kennung 1. Buchstabe *)
  265.     Write(ExeFile, Init);
  266.     Init := BYTE(Ord('B'));                  (* Kennung 2. Buchstabe *)
  267.     Write(ExeFile, Init);
  268.     Init := 0;
  269.     FOR i := 0 TO MaxVars DO
  270.       Write(ExeFile, Init);
  271.     Close(ExeFile);
  272.   END;
  273.   Assign(ExeFile, ExeName);
  274.   Reset(ExeFile);
  275.   Seek(ExeFile, ExeLength + VarAdr + 2);
  276.   Write(ExeFile, Variable);
  277.   Close(ExeFile);
  278.   RestoreSettings(ExeName);
  279. END;
  280.  
  281. (*-------------------------------------------------------------------*)
  282.  
  283. PROCEDURE ReadVarFromEXEFile(VarAdr: LONGINT;
  284.                          VAR Variable: BYTE);
  285. VAR
  286.   ExeLength,
  287.   FleLength : LONGINT;
  288.   ExeFile   : FILE OF BYTE;
  289. BEGIN
  290.   ExeLength := GetFileLenFromHeader;
  291.   FleLength := GetRealFileLength;
  292.   IF FleLength = ExeLength THEN
  293.   BEGIN
  294.     IF Lo(DosVersion) < 3 THEN Error($FE);
  295.     WriteVarToEXEFile(0, 0);
  296.     Variable := 0;
  297.   END
  298.   ELSE
  299.   BEGIN
  300.     PrepareFile(ExeName);
  301.     Assign(ExeFile, ExeName);
  302.     Reset(ExeFile);
  303.     IOError := IOResult;
  304.     IF IOError <> 0 THEN Error(IOError);
  305.     Seek(ExeFile, ExeLength + VarAdr + 2);
  306.                            (* Länge des Programms + Adresse + Header *)
  307.     Read(ExeFile, Variable);
  308.     Close(ExeFile);
  309.     RestoreSettings(ExeName);
  310.   END;
  311. END;
  312.  
  313. (*-------------------------------------------------------------------*)
  314.  
  315. BEGIN
  316.   ExeName := ParamStr(0);
  317. (* darf von anderen Units oder vom Hauptprogramm überschrieben       *)
  318. (* werden.                                                           *)
  319. END.
  320.  
  321. (*===================================================================*)
  322.