home *** CD-ROM | disk | FTP | other *** search
/ Chip: Special Survival Kit / Chip_Special_Survival_Kit_fuer_PC_Anwender.iso / 01tools / txt2exe / screen / grabcurs.pas < prev    next >
Pascal/Delphi Source File  |  1994-09-01  |  6KB  |  303 lines
  1. {$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,R-,S-,V-,X+}
  2. {$m 1024,0,0}
  3. program GrabCursres;
  4.  
  5. USES dos,opstring;
  6.  
  7. CONST
  8.   int1csave : pointer = NIL;
  9.   int2fsave : pointer = NIL;
  10.   rcs : word = 0;
  11.   resident_ende : Word = 0;
  12.  
  13.   PROCEDURE initmsg;
  14.   BEGIN
  15.     WriteLn('GrabCurs');
  16.   END;
  17.  
  18.   PROCEDURE ExecInt(adress : Pointer);
  19.   INLINE($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/
  20.          $ec/$5d/$07/$1f/$5f/$5e/$5a/$59/$cb);
  21.  
  22.   procedure Grab; Assembler;
  23.   asm
  24.     push es
  25.  
  26.     mov bx, cs
  27.     sub bx, 10h
  28.     mov cs:rcs, bx
  29.  
  30.     mov ah,01h
  31.     mov cx,000fh
  32.     int 10h
  33.  
  34. (*
  35.     mov ax,0040h
  36.     mov es,ax
  37.     mov dl,byte ptr es:50h
  38.     mov dh,byte ptr es:51h
  39.  
  40.     mov al,dh
  41.     mov bl,160
  42.     mul bl
  43.     xor dh,dh
  44.     add ax,dx
  45.     add ax,dx
  46.     mov di,ax
  47.     mov oldpos,di
  48.  
  49.     mov ax,BaseOfScreen
  50.     mov es,ax
  51.  
  52.     mov ax,es:[di]
  53.  
  54.     xor Ah,0ffh
  55.     mov es:[di],ax
  56. *)
  57.    pop es
  58.   end;
  59.  
  60.  
  61.   {$f+}
  62.   PROCEDURE Int1cP; interrupt;
  63.   {$f-}
  64.   BEGIN
  65.     INLINE($0e/$1f);
  66.     asm
  67.       cli
  68.       jmp @@go
  69.       @@kennung:db "GrbCu"
  70.       @@go:
  71.       call Grab
  72.     end;
  73.     ExecInt(int1csave);
  74.   END;
  75.  
  76.  
  77.   {$f+}
  78.   PROCEDURE Int2fP(rflags, rcs, rip, rax, rbx, rcx, rdx, rsi, rdi, rds, res, rbp : Word); interrupt;
  79.   {$f-}
  80.   BEGIN
  81.     INLINE($0e/$1f);
  82.     asm
  83.       jmp @go
  84.       @kennung:db "GrbCu"
  85.       @go:
  86.       cmp rax,06550h
  87.       jne @@out
  88.       mov rbx,06946h
  89.       mov rcx,06148h
  90.   @@out:
  91.     END;
  92. (*
  93.     IF rax = $6550 THEN
  94.       BEGIN
  95.         rbx := $6946;
  96.         rcx := $6148;
  97.         rflags := rflags AND NOT fcarry
  98.       END;
  99. *)
  100.     ExecInt(int2fsave)
  101.   END;
  102.  
  103.  
  104.   PROCEDURE Keepy(k : Byte; biswohin : Pointer);
  105.   VAR
  106.     maxseg : ^Word;
  107.     r : registers;
  108.   BEGIN
  109.     r.ah := $49;
  110.     r.es := Word(Ptr(PrefixSeg, $2c)^);
  111.     msdos(r);
  112.  
  113.     Move(Ptr(DSeg, 0)^, Ptr(CSeg, 0)^, Ofs(resident_ende));
  114.  
  115.     maxseg := Ptr(PrefixSeg, 2);
  116.     maxseg^ := Seg(biswohin^)+(Ofs(biswohin^)+15) SHR 4;
  117.  
  118.     swapvectors;
  119.     keep(k)
  120.  
  121.   END;
  122.  
  123.  
  124.   PROCEDURE Error(s : String);
  125.   BEGIN
  126.     WriteLn(s);
  127.     Halt(1);
  128.   END;
  129.  
  130.   PROCEDURE Help;
  131.   BEGIN
  132.     WriteLn('Zweck          : residente Cursor-Emulation');
  133.     WriteLn('Aufruf         : GrabCurs [/U]');
  134.     WriteLn('Deinstallation : GrabCurs /U oder erneuter Aufruf!');
  135.     error('');
  136.   END;
  137.  
  138.   FUNCTION Installed : Boolean;
  139.   VAR
  140.     r : registers;
  141.   BEGIN
  142.     r.ax := $6550;
  143.     intr($2f, r);
  144.     Installed := ((r.bx = $6946) AND (r.cx = $6148))
  145.   END;
  146.  
  147.   FUNCTION Removable : Boolean;
  148.   CONST
  149.     sok =
  150.       'Dies ist Dummy-Code der überschrieben wird, wenn ein Installations-Check durchgeführt wird';
  151.   VAR
  152.     p : Pointer;
  153.     s : String;
  154.     i1,i2,i3 : Boolean;
  155.   BEGIN
  156.     s := sok;
  157.     getintvec($1c, p);
  158.     Move(p^, s, 40);
  159.     s[0] := #40;
  160.     i2 := (pos('GrbCu', s) <> 0);
  161.  
  162.     s := sok;
  163.     getintvec($2f, p);
  164.     Move(p^, s, 40);
  165.     s[0] := #40;
  166.     i3 := (pos('GrbCu', s) <> 0);
  167.  
  168.     Removable := (i2 AND i3);
  169.   END;
  170.  
  171.   PROCEDURE UnInstall;
  172.   BEGIN
  173.     asm
  174.      mov cx,0607h
  175.      mov ah,01h
  176.      int 10h
  177.  
  178.      jmp @@doit
  179.      @@wegmeld:db "GrabCurs [PFH] deinstalliert.", 13, 10, "$"
  180.      @@doit:
  181.      mov ah, 35h
  182.      mov AL, 1ch
  183.      Int 21h                       { ES ist gesetzt auf das CSEG der Kopie im Speicher }
  184.  
  185.      mov dx, Word Ptr es: [int1csave]
  186.      mov ds, Word Ptr es: [int1csave+2]
  187.      mov ax, 251ch
  188.      Int 21h
  189.  
  190.      mov dx, Word Ptr es: [int2fsave]
  191.      mov ds, Word Ptr es: [int2fsave+2]
  192.      mov ax, 252fh
  193.      Int 21h
  194.  
  195.      mov es, Word Ptr es: [rcs]    { Code-Segment der Kopie laden }
  196.      mov cx, es                    { und in CX merken }
  197.      mov es, es: [02ch]
  198.      mov ah, 49h
  199.      Int 21h
  200.  
  201.      mov es, cx
  202.      mov ah, 49h
  203.      Int 21h
  204.  
  205.      push ds
  206.      mov dx, offset @@wegmeld
  207.      mov ax, Seg @@wegmeld
  208.      mov ds, ax
  209.      mov ah, 09h
  210.      Int 21h
  211.      pop ds
  212.  
  213.      mov ax, 4c00h
  214.      Int 21h
  215.    END
  216. END;
  217.  
  218. FUNCTION Repl(x : Integer; c : Char) : String;
  219. VAR
  220.   tmp : String[255];
  221. BEGIN
  222.   FillChar(tmp, x+1, c);
  223.   tmp[0] := Chr(x);
  224.   Repl := tmp
  225. END;
  226.  
  227. FUNCTION ReadKey : Char;
  228. BEGIN
  229.   asm
  230.     mov ax, 00
  231.     Int 16h
  232.     mov @result, AL
  233.   END;
  234. END;
  235.  
  236.  
  237. FUNCTION UserwillUninstall : Boolean;
  238. VAR
  239.   c : Char;
  240. BEGIN
  241.   Write('GrabCurs aus dem Speicher entfernen [J/N] ?');
  242.   REPEAT
  243.     c := ReadKey;
  244.     c := Upcase(c);
  245.     IF NOT(c IN ['J', 'N']) THEN
  246.       Write(#7);
  247.   UNTIL c IN ['J', 'N'];
  248.   WriteLn(c);
  249.   UserwillUninstall := (c = 'J')
  250. END;
  251.  
  252. PROCEDURE Rechne;
  253. VAR
  254.   code : Integer;
  255. BEGIN
  256.   if paramcount = 1 then
  257.     begin
  258.       if Pos('U',stupcase(paramstr(1))) > 0 then
  259.         if installed then
  260.           if removable then
  261.             uninstall
  262.           ELSE
  263.             Error('GrabCurs kann nicht aus dem Speicher entfernt werden.')
  264.         ELSE
  265.          Error('GrabCurs wurde noch nicht installiert bzw. antwortet nicht!')
  266.       else
  267.         Help;
  268.     end;
  269.   IF Installed THEN
  270.     BEGIN
  271.       WriteLn('GrabCurs wurde bereits installiert.');
  272.       IF UserwillUninstall THEN
  273.         BEGIN
  274.           IF Removable THEN
  275.             UnInstall
  276.           ELSE
  277.             Error('GrabCurs kann nicht aus dem Speicher entfernt werden.')
  278.          END
  279.       ELSE
  280.         Error('Nichts gemacht.');
  281.     END;
  282.   rcs := CSeg;
  283. END;
  284.  
  285. BEGIN
  286.   initmsg;
  287.  
  288.   Rechne;
  289.   writeln('GrabCurs benötigt ca. 480 Bytes.');
  290.   writeln('De-Installation bei erneutem Aufruf von GrabCurs');
  291.  
  292.   getintvec($1c, int1csave);
  293.   setintvec($1c, @Int1cP);
  294.  
  295.   getintvec($2f, int2fsave);
  296.   setintvec($2f, @Int2fP);
  297.  
  298.   Keepy(0, @keepy)
  299. END.
  300.  
  301.  
  302.  
  303.