| HOME | NEWS | AWARDS | ABOUT ME | TEXTE | REFERATE | PROJEKTE |
| MUSIK | CHAT | SPECIAL | LINKS |

3. Kapitel: Das Listing

PROGRAM DOS_tool;
 
{INITIALISIERUNG der Variablen, Units, Foward-Prozeduren und Compilerdirektiven}
{$r-,s-}
{$M 8000,0,0}
 
USES DOS,crt,maus;
 
VAR intvec8,intvec9,intvec28:pointer;
   idstring:^byte;
   active,mouseon:boolean;
   turbosp,turboss,oldss,oldsp :word;
   i:integer;
   a,b,taste:byte;
 
FUNCTION vecs_changed: boolean;forward;
 
{PROZEDUREN UND FUNKTIONEN}
 
PROCEDURE totalexec(s:string);
 
VAR t_a,z,l:byte;
 
BEGIN
 l:=length(s);
 t_a:=mem[$0040:$0080];
 mem[$0040:$001a]:=t_a;
 mem[$0040:$001c]:=t_a;
 z:=0;
 WHILE z0 THEN BEGIN
   mem[$0040:t_a+(2*z)]:=13;
   mem[$0040:$001c]:=t_a+(2*z)+2;
 END;
END;
 
PROCEDURE setcursor(x, y: Byte);
 
VAR r: registers;
 
BEGIN
 r.ah := 2;
 r.dh := y;
 r.dl  := x;
 r.bh := 0;
 intr($10,r);
END;
 
PROCEDURE getcursor(VAR x, y:byte);
 
VAR r: registers;
 
BEGIN
 r.ah := 3;
 r.bh := 0;
 Intr($10,R);
 y:=r.dh;
 x:=r.dl;
END;
 
FUNCTION getstringatmouse:string;
 
VAR ad:integer;
   s    :string;
   b1,b2:boolean;
 
BEGIN
 ad:=mousey div 8*160+mousex div 8*2;
 s:='';
 WHILE mem[$b800:ad]<>32 DO BEGIN
   s:=s+chr(mem[$b800:ad]);
   inc(ad,2);
 END;
 ad:=mousey div 8*160+mousex div 8*2-2;
 WHILE (ad mod 160<157) and>=0) and (mem[$b800:ad]<>32) DO BEGIN
   s:=chr(mem[$b800:ad])+s;
   dec(ad,2);
 END;
 ad:=1;
 b1:=false;
 b2:=false;
 WHILE ad<=length(s) DO
   IF s[ad] in ['[','<'] then begin if s>'] THEN BEGIN
     IF (s[ad]=']') and b1 THEN delete(s,ad,1);
     IF (s[ad]='>') and b2 THEN delete(s,ad,1);
     IF ((s[ad]=']') and not b1) or ((s[ad]='>') and not b2) THEN BEGIN
       delete(s,1,ad);
       ad:=1;
     END;
     b1:=false;
     b2:=false;
   END ELSE
     inc(ad);
 getstringatmouse:=s;
END;
  
PROCEDURE reset_vecs;
  
BEGIN
 setintvec($08,intvec8);
 setintvec($09,intvec9);
 setintvec($28,intvec28);
END;
 
PROCEDURE re_alloc_mem;
 
VAR r: registers;
 
BEGIN
 with r DO BEGIN
   ax:=$4900;
   es:=word(ptr(prefixseg,$2c)^);
   intr($21,r);
   ax:=$4900;
   es:=prefixseg;
   intr($21,r);
 END;
END;
 
PROCEDURE action;
 
VAR command:string[15];
 
BEGIN
 if mouseon then mousehide;
 mouseon:=true;
 command:=getstringatmouse;
 IF (button=2) and (command<>'') THEN command:='cd '+command;
 IF command='UNLOAD' THEN BEGIN
   IF vecs_changed THEN BEGIN
     writeln('Ein Entfernen des Programms ist unmöglich, da einer oder mehrere');
     writeln('Vektoren nicht mehr direkt auf das Programm zeigen !');
     writeln('Andere TSRs entfernen und erneut probieren !');
   END ELSE BEGIN
     reset_vecs;
     re_alloc_mem;
   END;
 END ELSE IF command<>'' THEN totalexec(command);
 mousestatus;
 getmousestatus;
 i:=0;
 delay(150);
 mouseon:=false;
END;
 
PROCEDURE screenwork;
 
BEGIN
 IF mouseon THEN mousehide;
 getcursor(a,b);
 setcursor(65,0);
 write('-----------');
 setcursor(65,1);
 write('| DIR     |');
 setcursor(65,2);
 write('| DIR/w  |');
 setcursor(65,3);
 write('| DIR/p   |');
 setcursor(65,4);
 write('| DIR/p/w |');
 setcursor(65,5);
 write('| CD..    |');
 setcursor(65,6);
 write('| UNLOAD  |');
 setcursor(65,7);
 write('-----------');
 setcursor(a,b);
 mouseshow;
 mousestatus;
 mouseon:=true;
END;
 
PROCEDURE int8;interrupt;
 
BEGIN
 INLINE($9c/$ff/$1e/intvec8);
 IF (not active) THEN BEGIN
   getmousestatus;
   IF i mod 15=0 THEN screenwork;
   inc(i);
   IF button<>0 THEN BEGIN
     ASM
       cli
       mov oldss,ss
       mov oldsp,sp
       mov ss,turboss
       mov sp,turbosp
       sti
     END;
     active:=true;
     action;
     ASM
       cli
       mov ss,oldss
       mov sp,oldsp
     END;
   END;
 END;
END;
 
PROCEDURE int9;interrupt;
 
BEGIN
 ASM
   in al,60h
   mov taste,al
 END;
 IF taste=$1C THEN BEGIN
   IF mouseon THEN mousehide;
   mouseon:=false;
   active:=true;
 END;
 INLINE($9c/$ff/$1e/intvec9);
END;
 
PROCEDURE int28;interrupt;
 
BEGIN
 IF active and not mouseon THEN BEGIN
   getcursor(a,b);
   i:=b*160+a*2-2;
   WHILE (i mod 160<157) and>=0) and (active=true) DO
     IF mem[$b800:i]=62
       THEN active:=false
     ELSE dec(i,2);
 END;
 INLINE($9c/$ff/$1e/intvec28);
END;
 
FUNCTION vecs_changed: boolean;
 
CONST ints: array[1..3] of byte=($08,$09,$28);
 
VAR akt_seg: word;
   int_no: byte;
newints_feld: array[1..3] of word;
  
BEGIN
 vecs_changed:=false;
 newints_feld[1]:=seg(int8);
 newints_feld[2]:=seg(int9);
 newints_feld[3]:=seg(int28);
 for i:=1 to 3 DO BEGIN
   int_no:=ints[i];
   ASM
     mov al,int_no
     mov ah,35h
     int 21h
     mov akt_seg,es
   END;
   IF akt_seg<>newints_feld[i] THEN vecs_changed:=true;
 END;
END;
 
PROCEDURE instid(n:string);
 
BEGIN
 getmem(idstring,length(n)+1);
 WHILE ofs(idstring^) mod 16<>0 DO getmem(idstring,1);
 move(n[0], idstring^, length(n)+1);
END;
 
FUNCTION findit(n:string):boolean;
 
VAR sptr:^string;
 
BEGIN
 sptr:=ptr(0,0);
 WHILE (sptr^<>n) and (seg(sptr^)
Zurück 
 

| HOME | NEWS | AWARDS | ABOUT ME | TEXTE | REFERATE | PROJEKTE |
| MUSIK | CHAT | SPECIAL | LINKS |