home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / tiftool / mcblist1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-11  |  17.1 KB  |  732 lines

  1.  
  2. PROCEDURE RESETWINPAR(NR:BYTE);
  3. BEGIN
  4.   WP[NR].X := 1;
  5.   WP[NR].Y := 1;
  6.   WP[NR].L := 0;
  7.   WP[NR].W := 0;
  8.   WP[NR].F := FALSE;
  9. END;
  10.  
  11.  
  12. PROCEDURE REMOVEWINDOW(NR:BYTE);
  13. VAR   I  : BYTE;
  14. BEGIN
  15.   FOR I := LENGTH(WS) DOWNTO 1 DO IF ORD(WS[I]) = NR THEN DELETE(WS,I,1);
  16. END;
  17.  
  18.  
  19. PROCEDURE CLOSEWINDOW(NR:BYTE);
  20. VAR   WDP  : WINDOWPTR;
  21. BEGIN
  22.   REMOVEWINDOW(NR);
  23.   IF LENGTH(WS) > 0 THEN WN := ORD(WS[LENGTH(WS)]);
  24.   IF (NR = 2) OR (NR = WNM) THEN WNM := 0;
  25.   IF WP[NR].F THEN BEGIN { NUR FÜR AKTIVIERTE WINDOWS AUSFÜHREN ! }
  26.     DISPOSEVSCREEN(SC[NR]);
  27.     IF ACTIVATEWINDOW(WI[NR]) THEN WDP := ERASETOPWINDOW;
  28.     RESETWINPAR(NR);
  29.   END;
  30. END;
  31.  
  32.  
  33. PROCEDURE CLOSEWINDOWS;
  34. VAR   I    : BYTE;
  35. BEGIN
  36.   FOR I := 1 TO MAXWIND DO CLOSEWINDOW(I);
  37. END;
  38.  
  39.  
  40. PROCEDURE AUSDIEMAUS;
  41. BEGIN
  42.   CLOSEWINDOWS;
  43.   IF KT1 <> '' THEN BEGIN
  44.     FASTTEXT(KT1,1,1);
  45.     WRITEATTRIBUTE(KA1,1,1);
  46.     FASTTEXT(KT2,2,1);
  47.     WRITEATTRIBUTE(KA2,2,1);
  48.   END;
  49.   TEXTATTR := TA;
  50.   IF MAUSAKT THEN BEGIN
  51.     DISABLEEVENTHANDLING;
  52.     HIDEMOUSE;
  53.     RESTOREMOUSESTATE(MSP,FALSE);
  54.     FREEMEM(MSP,MSPSIZE);
  55.   END;
  56.   IF CY > 1 THEN BEGIN
  57.     GOTOXY(CX,CY-1);
  58.     CLREOL;
  59.     GOTOXY(CX,CY-2);
  60.   END ELSE GOTOXY(CX,CY);
  61.   NORMALCURSOR;
  62.   HALT;
  63. END;
  64.  
  65.  
  66. PROCEDURE ALERT(TEXT:STRING);
  67. VAR   CH1  : CHAR;
  68. BEGIN
  69.   IF NOT MAKEWINDOW(AWIN,10,11,70,16,TRUE,TRUE,FALSE,$4E,$4F,$CE,' Fehler ') THEN BEGIN
  70.     WRITELN('FEHLER MAKEWINDOW');
  71.     HALT;
  72.   END;
  73.   IF NOT ACTIVATEWINDOW(AWIN) THEN BEGIN
  74.     WRITELN('FEHLER ACTIVATEWINDOW');
  75.     HALT;
  76.   END;
  77.   HIDDENCURSOR;
  78.   GOTOXY( ((LO(WINDMAX)-LO(WINDMIN))-LENGTH(TEXT)) SHR 1 ,2);
  79.   WRITE(TEXT);
  80.   GOTOXY( ((LO(WINDMAX)-LO(WINDMIN))-13) SHR 1 ,4);
  81.   WRITE('Taste drücken');
  82.   WHILE KEYPRESSED DO CH1 := READKEY;
  83.   CH1 := READKEY;
  84.   WHILE KEYPRESSED DO CH1 := READKEY;
  85.   AUSDIEMAUS;
  86. END;
  87.  
  88.  
  89. PROCEDURE VWRITE;
  90. VAR   S  : STRING;
  91. BEGIN
  92.   READSTR(S);
  93.   IF LENGTH(S) > WP[WN].W0 THEN S[0] := CHAR(WP[WN].W0);
  94.   IF QUIET THEN EXIT;
  95.   FASTWRITE(S,ZEI,SPA,TEXTATTR);
  96.   INC(SPA,LENGTH(S));
  97.   IF SPA > SPM THEN SPM := SPA;
  98. END;
  99.  
  100.  
  101. PROCEDURE VWRITELN;
  102. BEGIN
  103.   IF NOWIN THEN WRITELN;
  104.   VWRITE;
  105.   INC(ZEI);
  106.   SPA := 1;
  107. END;
  108.  
  109.  
  110. PROCEDURE VWRITELNS(TEXT:STRING);
  111. BEGIN
  112.   WRITE(TPSTR,TEXT);
  113.   VWRITELN;
  114. END;
  115.  
  116.  
  117. PROCEDURE MESSAGE(TEXT:STRING);
  118. VAR   P    : WINDOWPTR;
  119.       CH1  : CHAR;
  120. BEGIN
  121.   IF QUIET THEN BEGIN
  122.     WRITELN(TEXT);
  123.     EXIT;
  124.   END;
  125.   IF NOT ACTIVATEWINDOW(BWIN) THEN ALERT('FEHLER ACTIVATEWINDOW');
  126.   HIDDENCURSOR;
  127.   CLRSCR;
  128.   GOTOXY( ((LO(WINDMAX)-LO(WINDMIN))-LENGTH(TEXT)) SHR 1 ,2);
  129.   WRITE(TEXT);
  130.   WHILE KEYPRESSED DO CH1 := READKEY;
  131.   CH1 := READKEY;
  132.   WHILE KEYPRESSED DO CH1 := READKEY;
  133.   P := ERASETOPWINDOW;
  134. END;
  135.  
  136.  
  137. FUNCTION MHEX1(B:BYTE):STRING;
  138. BEGIN
  139.   B := B AND $F;
  140.   IF B > 9 THEN MHEX1 := CHR(B+$37) ELSE MHEX1 := CHR(B+$30);
  141. END;
  142.  
  143.  
  144. FUNCTION MHEX2N(B:BYTE):STRING;
  145. BEGIN
  146.   IF B SHR 4 = 0 THEN MHEX2N := MHEX1(B)
  147.                  ELSE MHEX2N := MHEX1(B SHR 4) + MHEX1(B);
  148. END;
  149.  
  150.  
  151. FUNCTION ENTFERNE(ADRESSE:WORD):BOOLEAN;
  152. VAR   R  : REGISTERS;
  153. BEGIN
  154.   ENTFERNE := FALSE;
  155.   WITH R DO BEGIN
  156.     AH := $49;
  157.     ES := ADRESSE;
  158.     MSDOS(R);
  159.     IF (FLAGS AND FCARRY) = 0 THEN ENTFERNE := TRUE;
  160.   END; { WITH }
  161. END;
  162.  
  163.  
  164. PROCEDURE PSPDISP;
  165. VAR   CH    : CHAR;
  166.       PSPP  : ^PSPTYP;
  167.       CMDL  : STRING;
  168.  
  169. PROCEDURE CHECKCMDL;
  170. VAR   I  : INTEGER;
  171. BEGIN
  172.   IF (LENGTH(CMDL) > 127) THEN BEGIN
  173.     CMDL := #237;
  174.     EXIT;
  175.   END;
  176.   FOR I := 1 TO LENGTH(CMDL) DO BEGIN
  177.     IF (CMDL[I] < ' ') AND (CMDL[I] > #0) THEN BEGIN
  178.       CMDL := #237;
  179.       EXIT;
  180.     END;
  181.   END;
  182. END; { CHECKCMDL }
  183.  
  184. BEGIN { PSPDISP }
  185.   IF MCB^.LEN < 16 THEN EXIT;                { ZU KLEIN FÜR PSP ! }
  186.   PSPP := NIL;
  187.   SOF(PSPP).S := MCB^.PSP;
  188.   IF (SOF(PSPP).S = $9FFF) OR
  189.      (SOF(PSPP).S = $A000) OR
  190.      (SOF(PSPP).S = $B000) OR
  191.      (SOF(PSPP).S = $B800) THEN BEGIN
  192.     WRITE(TPSTR,' VIDEO- RAM');
  193.     IF (SOF(MCB).S+MCB^.LEN >= $C000) THEN WRITE(TPSTR,' & EPROM');
  194.     MCBA[MCBAP].ATTR := 5;
  195.     EXIT;
  196.   END;
  197.   WITH PSPP^ DO BEGIN
  198.     IF INTR20 <> $20CD THEN EXIT;
  199.     CMDL := CMDLIN;
  200.     CHECKCMDL;
  201.  
  202.   END; { WITH }
  203.  
  204.   IF MCB^.PSP = 0 THEN EXIT;  { MCB IST FREIGEGEBEN }
  205.   IF SUCC(SOF(MCB).S) <> MCB^.PSP THEN EXIT; { NUR DEN MCB DES PSP SELBST ! }
  206.  
  207.   WRITE(TPSTR,'≥',CMDL,'≤');
  208.   MCBA[MCBAP].ATTR := 2;
  209. END; { PSPDISP }
  210.  
  211.  
  212. FUNCTION HOLENAME(P:POINTER):STRING;
  213. VAR   ENV    : ^CHARRAY ABSOLUTE P;
  214.       PNAME  : STRING;
  215.       I      : WORD;
  216. BEGIN
  217.   HOLENAME := '';
  218.   I := 1;
  219.   IF NOT(ENV^[I] IN [' '..'z']) THEN EXIT;
  220.   REPEAT
  221.     WHILE ENV^[I] <> #0 DO INC(I);
  222.     INC(I);
  223.   UNTIL (ENV^[I] = #0);
  224.   INC(I);
  225.   IF ENV^[I] <> #1 THEN EXIT;
  226.   INC(I);
  227.   IF ENV^[I] <> #0 THEN EXIT;
  228.   INC(I);
  229.   PNAME := '';
  230.   WHILE ENV^[I] <> #0 DO BEGIN
  231.     PNAME := PNAME + ENV^[I];
  232.     INC(I);
  233.   END;
  234.   HOLENAME := PNAME;
  235. END;
  236.  
  237.  
  238. FUNCTION SUCHNAME:BOOLEAN;
  239. VAR   PNAME  : STRING;
  240.       P,N    : BYTE;
  241.       I      : WORD;
  242.       ENV    : ^CHARRAY;
  243.       G      : BOOLEAN;
  244. BEGIN
  245.   SUCHNAME := FALSE;
  246.   ENV := MP;
  247.   N   := 0;
  248.   G   := FALSE;
  249.   I   := 1;
  250.   IF NOT(ENV^[I] IN [' '..'z']) THEN EXIT;
  251.   REPEAT
  252.     WHILE ENV^[I] <> #0 DO BEGIN
  253.       IF ENV^[I] = '=' THEN G := TRUE;
  254.       INC(I);
  255.     END;
  256.     INC(N);
  257.     IF (N = 1) AND NOT G THEN EXIT;
  258.     INC(I);
  259.   UNTIL (ENV^[I] = #0);
  260.   MCBA[MCBAP].ATTR := 1;
  261.   INC(I);
  262.   IF ENV^[I] <> #1 THEN EXIT;
  263.   INC(I);
  264.   IF ENV^[I] <> #0 THEN EXIT;
  265.   INC(I);
  266.   WRITE(TPSTR,' ');
  267.   PNAME := '';
  268.   WHILE ENV^[I] <> #0 DO BEGIN
  269.     PNAME := PNAME + ENV^[I];
  270.     INC(I);
  271.   END;
  272.   WRITE(TPSTR,PNAME);
  273.   SUCHNAME := TRUE;
  274.   P := POS('MCBLIST.EXE',PNAME);
  275.   IF (P > 0) AND ((P+10) = LENGTH(PNAME)) THEN BEGIN
  276.     OLDMEM := HP;
  277.   END;
  278. END; { SUCHNAME }
  279.  
  280.  
  281. FUNCTION BATDISP(MSEG:WORD;UPDATE:BOOLEAN):BOOLEAN;
  282. VAR   I  : INTEGER;
  283. BEGIN
  284.   BATDISP := FALSE;
  285.   IF UPDATE THEN IF SUCHNAME THEN EXIT;
  286.   FOR I := $18 TO $1E DO IF MEM[MSEG:I] <> $FF THEN EXIT;
  287.   I := $1F;
  288.   IF NOT (MEM[MSEG:I] IN [$21..$7A]) THEN EXIT;
  289.   WRITE(TPSTR,'≡');
  290.   WHILE MEM[MSEG:I] <> 0 DO BEGIN
  291.     WRITE(TPSTR,CHR(MEM[MSEG:I]));
  292.     INC(I);
  293.   END;
  294.   WRITE(TPSTR,'≡');
  295.   IF UPDATE THEN MCBA[MCBAP].ATTR := 3;
  296.   BATDISP := TRUE;
  297. END; { BATDISP }
  298.  
  299.  
  300. PROCEDURE CLRVSCREEN(NR,ATTR:BYTE);
  301. BEGIN
  302.   CLEARVSCREEN(SC[NR],ATTR,' ');
  303.   ZEI := 1; SPA := 1; SPM := 0;
  304.   ACTIVATEVSCREEN(SC[NR]);
  305.   TEXTATTR := ATTR;
  306.   CLRSCR;
  307. END;
  308.  
  309.  
  310. FUNCTION SETWINDOW(NR,ATTR,LEN,WID:BYTE;VS:BOOLEAN):BOOLEAN;
  311. BEGIN
  312.   SETWINDOW := TRUE;
  313.   WN := NR;
  314.   REMOVEWINDOW(WN);
  315.   WS := WS + CHR(WN);
  316.   IF NOT ACTIVATEWINDOW(WI[NR]) THEN ALERT('FEHLER ACTIVATEWINDOW');
  317. IF SETTOPTILEDWINDOW(WI[NR]) THEN {};
  318.   HIDDENCURSOR;
  319.   IF WP[NR].F THEN EXIT;
  320.   WP[NR].W0 := WID;
  321.   SETWINDOW := FALSE;
  322.   IF VS THEN BEGIN
  323.     IF NOT MAKEVSCREEN(SC[NR],LEN,WID) THEN ALERT('FEHLER MAKEVSCREEN');
  324.     CLRVSCREEN(NR,ATTR);
  325.   END;
  326. END;
  327.  
  328.  
  329. PROCEDURE CLOSEVSCREEN(NR:BYTE);
  330. BEGIN
  331.   TEXTATTR := TA;
  332.   DEACTIVATEVSCREEN;
  333.   WP[NR].L := ZEI; WP[NR].W := SPM;
  334.   MOVEVSCREENTOWINDOW(SC[NR],1,1);
  335.   WP[NR].F := TRUE;
  336. END;
  337.  
  338.  
  339. FUNCTION READTEXTFILE(NAME:STRING):BOOLEAN;
  340. VAR   F        : TEXT;
  341.       S        : STRING;
  342.       CH1      : CHAR;
  343.       NBL,NBB  : WORD;
  344.       L        : LONGINT;
  345. BEGIN
  346.   READTEXTFILE := FALSE;
  347.   IF NOT EXISTFILE(NAME) THEN EXIT;
  348.   ASSIGN(F,NAME);
  349.   RESET(F);
  350.   IF POS('.EXE',NAME) > 0 THEN BEGIN
  351.     READ(F,CH1);
  352.     READ(F,CH2); { 2 BYTE EXE- HEADER }
  353.     READ(F,CH1);
  354.     READ(F,CH2);
  355.     NBL := ORD(CH1) + 256 * ORD(CH2);
  356.     READ(F,CH1);
  357.     READ(F,CH2);
  358.     NBB := ORD(CH1) + 256 * ORD(CH2);
  359.     L := NBB; L := L * 512; L := L - (512 - NBL);
  360.     IF NOT TEXTSEEK(F,L) THEN EXIT;
  361.   END;
  362.   WHILE NOT EOF(F) DO BEGIN
  363.     READLN(F,S);
  364.     VWRITELNS(S);
  365.   END;
  366.   CLOSE(F);
  367. {$I+}
  368.   READTEXTFILE := TRUE;
  369. END; { READTEXTFILE }
  370.  
  371.  
  372. PROCEDURE HELP;
  373. BEGIN
  374.   WNM := WN;
  375.   IF SETWINDOW(2,$70,250,80,TRUE) THEN EXIT;
  376.   IF NOT READTEXTFILE('MCBLIST.EXE') THEN ;
  377.   IF ZEI < 2 THEN BEGIN
  378.     IF NOT READTEXTFILE('MCBLIST.HLP') THEN BEGIN
  379.       VWRITELN;
  380.       VWRITELNS('    Datei '+ZIELDIR+'MCBLIST.HLP nicht gefunden');
  381.     END;
  382.   END;
  383.   CLOSEVSCREEN(2);
  384. END; { HELP }
  385.  
  386.  
  387. PROCEDURE CONFIGDIS;
  388. BEGIN
  389.   IF SETWINDOW(6,$70,100,80,TRUE) THEN EXIT;
  390.   VWRITELNS('  ┌─────────────────────────────────────┐');
  391.   VWRITELNS('  │            C:\CONFIG.SYS            │');
  392.   VWRITELNS('  └─────────────────────────────────────┘');
  393.   IF NOT READTEXTFILE('C:\CONFIG.SYS') THEN BEGIN
  394.     VWRITELN;
  395.     VWRITELNS('    C:\CONFIG.SYS nicht gefunden');
  396.     VWRITELN;
  397.   END;
  398.   VWRITELNS('  ┌─────────────────────────────────────┐');
  399.   VWRITELNS('  │           C:\AUTOEXEC.BAT           │');
  400.   VWRITELNS('  └─────────────────────────────────────┘');
  401.   IF NOT READTEXTFILE('C:\AUTOEXEC.BAT') THEN BEGIN
  402.     VWRITELN;
  403.     VWRITELNS('    C:\AUTOEXEC.BAT nicht gefunden');
  404.   END;
  405.   CLOSEVSCREEN(6);
  406. END; { CONFIGDIS }
  407.  
  408.  
  409. PROCEDURE SAVEINTS;
  410. VAR   I     : INTEGER;
  411.       AMEM  : LONGINT;
  412.       P     : POINTER;
  413. BEGIN
  414.   ASSIGN(F,INTFNAME);
  415. {$I-}
  416.   REWRITE(F);
  417.   WRITE(F,FILEID);  { KONSTANTE AUS DEM PROGRAMMKOPF }
  418.   WRITE(F,OLDMEM);  { FREIER MCB VOR VIDEO- ADAPTER }
  419.   WRITE(F,OLDMEMJ); { FREIER MCB HINTER VIDEO- ADAPTER }
  420.   P := PTR(MEMW[$40:$13],0);
  421.   WRITE(F,P);
  422.   FOR I := 0 TO LASTVEC DO WRITE(F,IP[I]);
  423.   FILERR := NOT (IORESULT = 0);
  424. {$I+}
  425.   WRITELN;
  426.   IF NOT FILERR THEN BEGIN
  427.     CLOSE(F);
  428.     MESSAGE('##### INTERRUPT- VEKTOREN GESPEICHERT #####');
  429.   END ELSE BEGIN
  430.     MESSAGE('***** Fehler bei schreiben File '+INTFNAME+' *****');
  431.   END;
  432. END; { SAVEINTS }
  433.  
  434.  
  435. PROCEDURE READFILE(MELDEN:BOOLEAN);
  436. VAR   P  : POINTER;
  437. BEGIN
  438.   OLDMEMF := NIL;
  439.   OLDMEMG := NIL;
  440.   MEMSIZE := MEMW[$40:$13];
  441.   ASSIGN(F,INTFNAME);
  442. {$I-}
  443.   RESET(F);
  444.   FILERR := NOT (IORESULT = 0);
  445.   IF FILERR THEN BEGIN
  446.     IF MELDEN THEN MESSAGE('*** File MCBLIST.SAV nicht gefunden ***');
  447.     EXIT;
  448.   END;
  449.   READ(F,P);
  450.   IF P <> FILEID THEN BEGIN
  451.     FILERR := TRUE;
  452.     CLOSE(F);
  453.     MESSAGE(' falsches SAVE- File- Format ');
  454.   END ELSE BEGIN
  455.     READ(F,OLDMEMF);
  456.     READ(F,OLDMEMG);
  457.     READ(F,P);
  458.     MEMSIZE := SOF(P).S;
  459.     FOR I := 0 TO LASTVEC DO READ(F,BUF[I]);
  460.     FILERR := NOT (IORESULT = 0);
  461.   END;
  462. {$I+}
  463.   IF FILERR THEN BEGIN
  464.     OLDMEMF := NIL;
  465.     OLDMEMG := NIL;
  466.     MEMSIZE := MEMW[$40:$13];
  467.     MESSAGE('*** Lesefehler MCBLIST.SAV ***');
  468.   END ELSE CLOSE(F);
  469. END; { READFILE }
  470.  
  471.  
  472. PROCEDURE RESTOREINTS(MAUSWEG,GEWALT:BOOLEAN);
  473. VAR   I  : WORD;
  474.       P  : POINTER;
  475.       R  : REGISTERS;
  476.  
  477. FUNCTION GEHTS(VONWO:POINTER;BISWO:WORD):BOOLEAN;
  478. VAR   HP  : ^MCBTYP;
  479. BEGIN { GEHTS }
  480.   GEHTS := TRUE;
  481.   IF VONWO = NIL THEN EXIT;
  482.   HP := VONWO;
  483.   REPEAT
  484.     IF SUCC(SOF(HP).S) = CHEF THEN BEGIN
  485.       GEHTS := FALSE;
  486.       EXIT;
  487.     END;
  488.     IF (HP^.ID <> 'Z') THEN SOF(HP).S := SOF(HP).S + SUCC(HP^.LEN);
  489.   UNTIL (HP^.ID = 'Z') OR (SUCC(SOF(HP).S) >= BISWO);
  490. END; { GEHTS }
  491.  
  492. PROCEDURE FREIGABE(VONWO:POINTER;BISWO:WORD);
  493. VAR   FRECNT      : INTEGER;
  494.       ERROR,ENDE  : BOOLEAN;
  495.       HP          : ^MCBTYP;
  496.       R           : REGISTERS;
  497. BEGIN { FREIGABE }
  498.   IF NOT QUIET THEN CLRSCR;
  499.   ERROR := FALSE;
  500.   ENDE  := FALSE;
  501.   FRECNT := 0;
  502.   HP := VONWO;
  503.   WITH R DO BEGIN
  504.     REPEAT
  505.       AX := $4900;
  506.       ES := SUCC(SOF(HP).S);
  507.       IF HP^.PSP <> 0 THEN BEGIN
  508.         WRITELN('Memory- Block ',HEXW(ES),':0000 freigeben');
  509.         MSDOS(R);
  510.         IF (FLAGS AND FCARRY) <> 0 THEN BEGIN
  511.           WRITELN('Memory- Block ',HEXW(ES),':0000  Fehler ',HEXW(AX));
  512.           ERROR := TRUE;
  513.         END ELSE BEGIN
  514.           INC(FRECNT);
  515.           FILLCHAR(HP^.N,SIZEOF(HP^.N),#0);
  516.         END;
  517.       END;
  518.       IF HP^.ID = 'Z' THEN ENDE := TRUE;
  519.       IF (HP^.ID <> 'Z') THEN SOF(HP).S := SOF(HP).S + SUCC(HP^.LEN);
  520.     UNTIL ERROR OR ENDE OR (SUCC(SOF(HP).S) >= BISWO);
  521.     IF ERROR THEN BEGIN
  522.       MESSAGE('***** Fehler beim Freigeben des Speichers *****');
  523.     END;
  524.   END; { WITH }
  525. END; { FREIGABE }
  526.  
  527. BEGIN { RESTOREINTS }
  528.   READFILE(TRUE);
  529.   IF NOT FILERR THEN BEGIN
  530. { NUR FREIGEBEN, WENN DER EIGENE MUTTERPROZESS NICHT BETROFFEN IST }
  531.     IF NOT GEWALT THEN BEGIN
  532.       IF NOT GEHTS(OLDMEMF,$9FFE) OR
  533.          NOT GEHTS(OLDMEMG,$FFFF) THEN BEGIN
  534.         MESSAGE('  Der eigene Mutterprozess darf nicht freigegeben werden');
  535.         EXIT;
  536.       END;
  537.     END; { IF NOT GEWALT }
  538.  
  539. { DIE INTERRUPT VEKTOREN RESTAURIEREN }
  540.     INLINE($FA); { CLI }
  541.     FOR I := 0 TO LASTVEC DO IP[I] := BUF[I];
  542.     INLINE($FB); { STI }
  543.     MESSAGE('##### Interrupt- Vektoren restauriert #####');
  544.  
  545. { GGF. DEN MAUSEVENT ABSCHALTEN }
  546.     IF MAUSWEG THEN BEGIN
  547.       GETINTVEC($33,P);
  548.       IF P <> NIL THEN BEGIN
  549.         R.AX := $0C;
  550.         R.CX := 0;
  551.         R.ES := 0;
  552.         R.DX := 0;
  553.         INTR($33,R);
  554.         MESSAGE('Der Maus- Event- Interrupt ist deaktiviert');
  555.       END ELSE BEGIN
  556.         MESSAGE('***  kein Maustreiber installiert  ***');
  557.       END;
  558.     END;
  559. { FREIGEBEN VOR VIDEO- ADAPTER }
  560.     IF OLDMEMF <> NIL THEN FREIGABE(OLDMEMF,$9FFE);
  561. { FREIGEBEN HINTER VIDEO- ADAPTER }
  562.     IF OLDMEMG <> NIL THEN FREIGABE(OLDMEMG,$FFFF);
  563.   END;
  564. END; { RESTOREINTS }
  565.  
  566.  
  567. PROCEDURE INTMAP;
  568. VAR   I         : INTEGER;
  569.       COL,TC    : BYTE;
  570.       IRET,ILL  : BOOLEAN;
  571.       TA        : BYTE;
  572.       ILLP      : POINTER;
  573. BEGIN
  574.   IF SETWINDOW(3,$07,54,72,TRUE) THEN EXIT;
  575.  
  576.   ILLP := NIL;
  577.   IF NOT FILERR THEN BEGIN
  578.     IF (BUF[$54] = BUF[$55]) AND
  579.        (BUF[$54] = BUF[$56]) AND
  580.        (BUF[$54] = BUF[$57]) AND
  581.        (BUF[$54] = BUF[$58]) THEN ILLP := BUF[$54];
  582.   END;
  583.  
  584.   TA := TEXTATTR;
  585.   WRITE(TPSTR,'  SHUTDOWN- POINTER = ',HEXPTR(SDP));
  586.   WRITE(TPSTR,'            MODE- POINTER = ',HEXPTR(MODVEC));
  587.   VWRITELN;
  588.  
  589.   COL := 14;
  590.   TEXTCOLOR(COL);
  591.   I := 0;
  592.   REPEAT
  593.     IF LCD THEN TEXTATTR := $07;
  594.     IF NOT FILERR THEN BEGIN
  595.       IF BUF[I] = IP[I] THEN TEXTBACKGROUND(0) ELSE BEGIN
  596.         IF LCD THEN TEXTATTR := $70 ELSE TEXTBACKGROUND(1); { $47 }
  597.       END;
  598.     END;
  599.  
  600.     IRET := FALSE;
  601.     ILL  := FALSE;
  602.     IF IP[I] = NIL THEN TEXTATTR := TAFREI ELSE BEGIN
  603.       IRET := MEM[SOF(IP[I]).S:SOF(IP[I]).O] = $CF;
  604.       ILL  := (ILLP <> NIL) AND (IP[I] = ILLP);
  605.       IF NOT IRET AND (I > 0) AND (IP[I] <> IP[I-1]) THEN BEGIN
  606.         IF NOT LCD THEN BEGIN
  607.           DEC(COL);
  608.           IF COL < 9 THEN COL := 14;
  609.           IF LO(LASTMODE) = 7 THEN COL := 14;
  610.           TEXTCOLOR(COL);
  611.         END;
  612.       END;
  613.     END;
  614.  
  615.     IF NOT LCD THEN BEGIN
  616.       IF IRET THEN TEXTCOLOR(6) ELSE
  617.         IF ILL THEN TEXTCOLOR(4) ELSE
  618.           IF SOF(IP[I]).S = $F000 THEN TEXTCOLOR(7);
  619.     END ELSE BEGIN
  620.       IF SOF(IP[I]).S = $F000 THEN TEXTATTR := $04;
  621.     END;
  622.     WRITE(TPSTR,I:3,',',HEXB(I),'H=',HEXW(SOF(IP[I]).S),':');
  623.     VWRITE;
  624.     IF NOT LCD THEN BEGIN
  625.       IF IRET THEN TEXTCOLOR(6) ELSE
  626.         IF ILL THEN TEXTCOLOR(4) ELSE
  627.           IF IP[I] <> NIL THEN TEXTCOLOR(COL);
  628.     END;
  629.     WRITE(TPSTR,HEXW(SOF(IP[I]).O));
  630.     VWRITE;
  631.  
  632.     TEXTBACKGROUND(0);
  633.     IF IRET THEN WRITE(TPSTR,'!') ELSE
  634.       IF ILL THEN WRITE(TPSTR,'*') ELSE
  635.         WRITE(TPSTR,' ');
  636.     IF (I AND 3) = 3 THEN VWRITELN ELSE VWRITE;
  637.     INC(I);
  638.   UNTIL (I > LASTVEC);
  639.  
  640.   CLOSEVSCREEN(3);
  641. END; { INTMAP }
  642.  
  643.  
  644. PROCEDURE VECTANZ;
  645. VAR   I,VON1,BIS1  : WORD;
  646.       LV,L1        : INTEGER;
  647.       A            : BOOLEAN;
  648.       IVS          : POINTER;
  649. BEGIN { VECTANZ }
  650.   A := FALSE;
  651.   LV := -2;
  652.   IF VON = BIS THEN EXIT;
  653.   IF VON > BIS THEN BEGIN
  654.     VON1 := BIS;
  655.     BIS1 := VON;
  656.   END ELSE BEGIN
  657.     VON1 := VON;
  658.     BIS1 := BIS;
  659.   END;
  660.  
  661.   TEXTATTR := TAVEKT;
  662.  
  663.   IF (VON1 <> $F000) THEN BEGIN
  664.     IF (SOF(SDP).S >= VON1) AND
  665.        (SOF(SDP).S < BIS1) AND
  666.        (SDP <> NIL) THEN BEGIN
  667.       WRITE(TPSTR,' SDP');
  668.     END;
  669.     IF (SOF(MODVEC).S >= VON1) AND
  670.        (SOF(MODVEC).S < BIS1) AND
  671.        (MODVEC <> NIL) THEN BEGIN
  672.       WRITE(TPSTR,' MODE');
  673.     END;
  674.     VWRITE;
  675.   END;
  676.  
  677.   FOR I := 0 TO LASTVEC DO BEGIN
  678.     IVS := IP[I];
  679.     IF ( (VON1 <> $F000) AND
  680.          (SOF(IVS).S <> $F000) ) OR
  681.        ( (VON1 = $F000) AND
  682.          (SOF(IVS).S = $F000) ) THEN BEGIN
  683.  
  684.       IF (SOF(IVS).S >= VON1) AND
  685.          (SOF(IVS).S < BIS1) AND
  686.          (IVS <> NIL) THEN BEGIN
  687.         IF I = SUCC(LV) THEN BEGIN
  688.           IF NOT A THEN WRITE(TPSTR,'-');
  689.           A := TRUE;
  690.         END ELSE BEGIN
  691.           WRITE(TPSTR,' ');
  692.           IF NOT FILERR THEN BEGIN
  693.             IF BUF[I] = IP[I] THEN TEXTATTR := TAVEKT
  694.                               ELSE TEXTATTR := TAVNEU;
  695.           END;
  696.           WRITE(TPSTR,MHEX2N(I));
  697.           A := FALSE;
  698.         END;
  699.         LV := I;
  700.       END;
  701.     END;
  702.     IF LV = PRED(I) THEN BEGIN
  703.       IF A THEN WRITE(TPSTR,MHEX2N(LV));
  704.     END;
  705.     VWRITE;
  706.   END; { NEXT I }
  707.  
  708.   TEXTBACKGROUND(0);
  709.   IF NOT FILERR THEN BEGIN
  710.     TEXTATTR := TAVALT;
  711.     FOR I := 0 TO LASTVEC DO BEGIN
  712.       IVS := BUF[I];
  713.       IF ( (VON1 <> $F000) AND
  714.            (SOF(IVS).S <> $F000) ) OR
  715.          ( (VON1 = $F000) AND
  716.            (SOF(IVS).S = $F000) ) THEN BEGIN
  717.         IF BUF[I] <> IP[I] THEN BEGIN
  718.           IF (SOF(IVS).S >= VON1) AND
  719.              (SOF(IVS).S < BIS1) AND
  720.              (IVS <> NIL) THEN BEGIN
  721.             WRITE(TPSTR,' ',MHEX2N(I));
  722.           END;
  723.         END;
  724.       END;
  725.       VWRITE;
  726.     END; { NEXT I }
  727.   END;
  728.  
  729.   TEXTATTR := TA;
  730. END; { VECTANZ }
  731.  
  732.