home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 01 / protect.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-11-02  |  4.5 KB  |  158 lines

  1. (*---------------------------------------------------------*)
  2. (*                      PROTECT.PAS                        *)
  3. (* PROTECT erzeugt einen Schreibschutz fuer Disketten-     *)
  4. (* oder Festplattenlaufwerke fuer MS-DOS-Maschinen.        *)
  5. (* Compilieren als COM-File mit 100 Paragraphen f. Heap.   *)
  6. (*---------------------------------------------------------*)
  7. PROGRAM Protect;
  8. (*$K-,U-,C-,V-,I-,R-*)
  9.  
  10. (*$I REGS8088.INC *)
  11. (*$I MAKEINT.INC *)
  12.  
  13. CONST
  14.    bios_disk_io : BYTE = $13;
  15.    oldint       : intentry_ = (offset : 0; segment : 0);
  16.    drive        : BYTE = 0;
  17. (*---------------------------------------------------------*)
  18. PROCEDURE intdisk0;
  19. LABEL oldinterrupt, writeprotect;
  20.  
  21. (*$I beginint.inc *)
  22.   WITH pgmrecs DO BEGIN
  23.     IF (pgmah <> 3) AND (pgmah <> 5) THEN GOTO oldinterrupt;
  24.     IF pgmdl <> 0 THEN GOTO oldinterrupt;
  25.     pgmflags:= pgmflags OR 1;
  26.     GOTO writeprotect;
  27.   END;
  28.   oldinterrupt:
  29.   (*$I exitint.inc*)
  30.              oldint);
  31.   writeprotect:
  32.   (*$I endint.inc *)
  33. END; (* intdisk0 *)
  34. (*---------------------------------------------------------*)
  35. PROCEDURE intdisk1;
  36. LABEL oldinterrupt, writeprotect;
  37.  
  38. (*$I beginint.inc *)
  39.   WITH pgmrecs DO BEGIN
  40.     IF (pgmah <> 3) AND (pgmah <> 5) THEN GOTO oldinterrupt;
  41.     IF pgmdl <> 1 THEN GOTO oldinterrupt;
  42.     pgmflags:= pgmflags OR 1;
  43.     GOTO writeprotect;
  44.   END;
  45.   oldinterrupt:
  46.   (*$I exitint.inc*)
  47.              oldint);
  48.   writeprotect:
  49.   (*$I endint.inc *)
  50. END; (* intdisk1 *)
  51. (*---------------------------------------------------------*)
  52. PROCEDURE intdisk2;
  53. LABEL oldinterrupt, writeprotect;
  54.  
  55. (*$I beginint.inc *)
  56.   WITH pgmrecs DO BEGIN
  57.     IF (pgmah <> 3) AND (pgmah <> 5) THEN GOTO oldinterrupt;
  58.     IF pgmdl <> 2 THEN GOTO oldinterrupt;
  59.     pgmflags:= pgmflags OR 1;
  60.     GOTO writeprotect;
  61.   END;
  62.   oldinterrupt:
  63.   (*$I exitint.inc*)
  64.              oldint);
  65.   writeprotect:
  66.   (*$I endint.inc *)
  67. END; (* intdisk2 *)
  68. (*---------------------------------------------------------*)
  69. PROCEDURE intdisk3;
  70. LABEL oldinterrupt, writeprotect;
  71.  
  72. (*$I beginint.inc *)
  73.   WITH pgmrecs DO BEGIN
  74.     IF (pgmah <> 3) AND (pgmah <> 5) THEN GOTO oldinterrupt;
  75.     IF pgmdl <> 3 THEN GOTO oldinterrupt;
  76.     pgmflags:= pgmflags OR 1;
  77.     GOTO writeprotect;
  78.   END;
  79.   oldinterrupt:
  80.   (*$I exitint.inc*)
  81.              oldint);
  82.   writeprotect:
  83.   (*$I endint.inc *)
  84. END; (* intdisk3 *)
  85. (*---------------------------------------------------------*)
  86. PROCEDURE intdisk4;
  87. LABEL oldinterrupt, writeprotect;
  88.  
  89. (*$I beginint.inc *)
  90.   WITH pgmrecs DO BEGIN
  91.     IF (pgmah <> 3) AND (pgmah <> 5) THEN GOTO oldinterrupt;
  92.     IF pgmdl <= 3 THEN GOTO oldinterrupt;
  93.     pgmflags:= pgmflags OR 1;
  94.     GOTO writeprotect;
  95.   END;
  96.   oldinterrupt:
  97.   (*$I exitint.inc*)
  98.              oldint);
  99.   writeprotect:
  100.   (*$I endint.inc *)
  101. END; (* intdisk4 *)
  102. (*---------------------------------------------------------*)
  103. PROCEDURE intdisk5;
  104. LABEL oldinterrupt, writeprotect;
  105.  
  106. (*$I beginint.inc *)
  107.   WITH pgmrecs DO BEGIN
  108.     IF (pgmah <> 3) AND (pgmah <> 5) THEN GOTO oldinterrupt;
  109.     pgmflags:= pgmflags OR 1;
  110.     GOTO writeprotect;
  111.   END;
  112.   oldinterrupt:
  113.   (*$I exitint.inc*)
  114.              oldint);
  115.   writeprotect:
  116.   (*$I endint.inc *)
  117. END; (* intdisk5 *)
  118. (*---------------------------------------------------------*)
  119. PROCEDURE parameter;
  120. VAR id: STRING[80];  i: INTEGER;
  121. BEGIN
  122.   IF paramcount = 0 THEN BEGIN
  123.     WriteLn('Schutz fuer alle Laufwerke!');  drive := 5;
  124.   END
  125.   ELSE IF paramcount > 1 THEN BEGIN
  126.     WriteLn('Zu viel Parameter in Kommandozeile...');  Halt;
  127.   END
  128.   ELSE BEGIN
  129.     id := paramstr(1);
  130.     FOR i := 1 TO Length(id) DO id[i] := UpCase(id[i]);
  131.     IF (id >= 'A:') AND (id <= 'D:') THEN BEGIN
  132.       WriteLn ('Schutz fuer Laufwerk ',id);
  133.       drive := Ord(id[1]) - Ord('A');
  134.     END
  135.     ELSE IF id = 'HD' THEN BEGIN
  136.       WriteLn ('Schutz fuer Festplatte...');
  137.       drive := 4;
  138.     END
  139.     ELSE BEGIN
  140.       WriteLn ('Falsche Laufwerkangabe!');  Halt;
  141.     END;
  142.   END;
  143. END; (* parameter *)
  144. (*---------------------------------------------------------*)
  145. BEGIN  (* Protect *)
  146.   parameter;
  147.   WITH oldint DO intget(bios_disk_io, segment, offset);
  148.   CASE drive OF
  149.     0 : intset (bios_disk_io, cseg, ofs(intdisk0));
  150.     1 : intset (bios_disk_io, cseg, ofs(intdisk1));
  151.     2 : intset (bios_disk_io, cseg, ofs(intdisk2));
  152.     3 : intset (bios_disk_io, cseg, ofs(intdisk3));
  153.     4 : intset (bios_disk_io, cseg, ofs(intdisk4));
  154.     5 : intset (bios_disk_io, cseg, ofs(intdisk5));
  155.   END;
  156.   makeresident;
  157. END. (* Protect *)
  158.