home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / demofile.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  6.3 KB  |  169 lines

  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. (*===================================================================*)
  3. (*                            DEMOFILE.PAS                           *)
  4. (*            Copyright (C) 1993 te-wi Verlag, München               *)
  5. (*               Initialisierungsunit für Demoprogramme.             *)
  6. (*-------------------------------------------------------------------*)
  7. (* Funktion:                                                         *)
  8. (* Die Unit funktioniert vollautomatisch:                            *)
  9. (* Beim ersten Programmaufruf wird an das Programm ein 3 Bytes       *)
  10. (* langer Schwanz angehängt, dessen 2. Byte als Zähler initialisiert *)
  11. (* wird. Das Programm kann nun weitere 9 Mal aufgerufen werden. Beim *)
  12. (* 11. Aufruf zerstört sich das Programm selbst, so daß kein weiterer*)
  13. (* rer Aufruf mehr möglich ist. Eine Meldung wird gegeben. Einziger  *)
  14. (* Schutz des Anwenders ist ein gegenlaufendes Patchprogramm. Ein    *)
  15. (* Schreibschutz wird vom internen Zähler überwunden. Alle weiteren  *)
  16. (* Schutzmaßnahmen führen zum Programmabbruch.                       *)
  17. (*-------------------------------------------------------------------*)
  18. (* In Quellcode einbinden mit:                                       *)
  19. (* USES DemoFile;                                                    *)
  20. (*-------------------------------------------------------------------*)
  21. (* Die UNIT ist NICHT overlayfähig!                                  *)
  22. (*-------------------------------------------------------------------*)
  23. (* Die Programme können mit EXEPACK o. dgl. behandelt werden, da die *)
  24. (* Dateilänge zur Laufzeit ermittelt wird. Allerdings muß ExePack    *)
  25. (* vor dem ersten Aufruf des Programms angewandt werden.             *)
  26. (*===================================================================*)
  27.  
  28. UNIT DemoFile;
  29.  
  30. INTERFACE
  31.  
  32. (*-------------------------------------------------------------------*)
  33. (* Keine Übergabefunktionen, alles geschieht automatisch bei der     *)
  34. (* Initialisierung des Programms.                                    *)
  35. (*-------------------------------------------------------------------*)
  36.  
  37. IMPLEMENTATION
  38.  
  39. USES DosUtil, Crt, Dos;
  40.  
  41. CONST
  42.   Calls = 10;                            { 10 Programmaufrufe maximal }
  43.  
  44. VAR
  45.   f     : FILE;
  46.   FTime : LONGINT;
  47.   FAttr : WORD;
  48.   dummy,
  49.   Name  : STRING;
  50.  
  51. PROCEDURE DemoVersion;
  52. VAR
  53.   i, WRByte,
  54.   CallCounter : BYTE;
  55.   ExeFile     : FILE OF BYTE;
  56.   ExeLength,
  57.   FleLength   : LONGINT;
  58.  
  59.   FUNCTION GetRealFileLength: LONGINT;
  60.   BEGIN
  61.     Assign(f, ParamStr(0));
  62.     Reset(f, 1);
  63.     IF IOResult <> 0 THEN Halt;
  64.     GetRealFileLength := FileSize(f);
  65.     Close(f);
  66.   END;
  67.  
  68.   PROCEDURE Message;
  69.   BEGIN
  70.     FSplit(ParamStr(0), dummy, Name, dummy);
  71.     WriteLn(^M^J + Name + '-Demoversion:');
  72.     WriteLn('Der interne Programmzähler ist abgelaufen,');
  73.     WriteLn('besorgen Sie sich eine neue Kopie oder');
  74.     WriteLn('lassen Sie sich registrieren!');
  75.     (*---------------------------------------------------------------*)
  76.     (* hier können weitere Meldungen des Autors wie Verweise auf die *)
  77.     (* Vollversion oder z.B. die Ausgabe eines Bestellformulars ein- *)
  78.     (* gefügt werden.                                                *)
  79.     (*---------------------------------------------------------------*)
  80.   END;
  81.  
  82. BEGIN
  83.   ExeLength := ExeFileLength(ParamStr(0));
  84.   FleLength := GetRealFileLength;
  85.   IF ExeLength = FleLength THEN
  86.   BEGIN
  87.     Assign(ExeFile, ParamStr(0));
  88.     Reset(ExeFile);
  89.     IF IOResult <> 0 THEN Halt;
  90.     Seek(ExeFile, ExeLength);
  91.     WRByte := 1;
  92.     Write(ExeFile, WRByte);
  93.     WRByte := 2;
  94.     Write(ExeFile, WRByte);
  95.     WRByte := 3;
  96.     Write(ExeFile, WRByte);
  97.     Close(ExeFile);
  98.   END
  99.   ELSE
  100.   BEGIN
  101.     Assign(ExeFile, ParamStr(0));
  102.     Reset(ExeFile);
  103.     IF IOResult <> 0 THEN Halt;
  104.     Seek(ExeFile, ExeLength + 1);
  105.     Read(ExeFile, CallCounter);
  106.     IF CallCounter > Calls THEN
  107.     BEGIN
  108.       ClrScr;
  109.       WRByte := 0;
  110.       Seek(ExeFile, 0);
  111.       FOR i := 0 TO 127 DO                   (* Programmkopf löschen *)
  112.         Write(ExeFile, WRByte);
  113.       Seek(ExeFile, 0);
  114.                               (* »EXIT zum DOS« in Header schreiben: *)
  115.       WRByte := $B4; (* MOV AH, *) Write(ExeFile, WRByte);
  116.       WRByte := $4C; (* 4Ch     *) Write(ExeFile, WRByte);
  117.       WRByte := $CD; (* INT     *) Write(ExeFile, WRByte);
  118.       WRByte := $21; (* 21h     *) Write(ExeFile, WRByte);
  119.       Message;
  120.       Close(ExeFile);
  121.       Assign(ExeFile, ParamStr(0));
  122.       ReWrite(ExeFile);             (* Programm von Platte löschen:  *)
  123.       Close(ExeFile);               (* Dateilänge aus FAT gestrichen *)
  124.       (* Wiederherstellung beispielsweise mit den Norton Utilities   *)
  125.       (* nur manuell möglich (hilft aber nichts)                     *)
  126.       Assign(ExeFile, ParamStr(0));
  127.       Erase(ExeFile);              (* leeren Programmeintrag löschen *)
  128.       Halt;
  129.     END
  130.     ELSE
  131.     BEGIN
  132.       Seek(ExeFile, ExeLength + 1);
  133.       Inc(CallCounter);
  134.       Write(ExeFile, CallCounter);
  135.       Close(ExeFile);
  136.     END;
  137.   END;
  138. END;
  139.  
  140. BEGIN
  141.   IF Lo(DosVersion) < 3 THEN         (* ParamStr(0) erst ab DOS 3.xx *)
  142.   BEGIN
  143.     WriteLn('Falsche DOS-Version');
  144.     Halt;
  145.   END;
  146.   Assign(f, ParamStr(0));             (* Programmnamen zuordnen      *)
  147.   GetFAttr(f, FAttr);                 (* Original-Dateiattr. holen   *)
  148.   SetFAttr(f, Archive);               (* nur Archiv-Attribut setzen  *)
  149.   IF DosError <> 0 THEN
  150.   BEGIN
  151.     FSplit(ParamStr(0), dummy, Name, dummy);
  152.     WriteLn('Diskette ist schreibgeschützt!'^M^J'Schreibschutz ' +
  153.             'entfernen und'^M^J + Name + ' erneut aufrufen ...');
  154.     Halt(1);
  155.   END;
  156.   Reset(f);
  157.   GetFTime(f, FTime);
  158.   Close(f);
  159.   DemoVersion;                         (* Zählerprozedur             *)
  160.   Assign(f, ParamStr(0));              (* Datei neu zuordnen ...     *)
  161.   Reset(f);                            (* und nochmals öffnen        *)
  162.   SetFTime(f, FTime);                  (* Original-Datum setzen      *)
  163.   Close(f);                            (* Datei schließen            *)
  164.   Assign(f, ParamStr(0));              (* erneut zuordnen            *)
  165.   SetFAttr(f, FAttr);                  (* Originalattribut setzen    *)
  166. END.
  167.  
  168. (*===================================================================*)
  169.