Chip: Special Survival Kit/Chip_Special_Survival_Kit_fuer_PC_Anwender.iso/01tools/txt2exe/screen/grabcurs.pas

Pascal/Delphi Source File | 1994-09-01 | 5.5 KB | 303 lines

{$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,R-,S-,V-,X+}
{$m 1024,0,0}
program GrabCursres;

USES dos,opstring;

CONST
  int1csave : pointer = NIL;
  int2fsave : pointer = NIL;
  rcs : word = 0;
  resident_ende : Word = 0;

  PROCEDURE initmsg;
  BEGIN
    WriteLn('GrabCurs');
  END;

  PROCEDURE ExecInt(adress : Pointer);
  INLINE($5b/$58/$87/$5e/$0e/$87/$46/$10/$89/
         $ec/$5d/$07/$1f/$5f/$5e/$5a/$59/$cb);

  procedure Grab; Assembler;
  asm
    push es

    mov bx, cs
    sub bx, 10h
    mov cs:rcs, bx

    mov ah,01h
    mov cx,000fh
    int 10h

(*
    mov ax,0040h
    mov es,ax
    mov dl,byte ptr es:50h
    mov dh,byte ptr es:51h

    mov al,dh
    mov bl,160
    mul bl
    xor dh,dh
    add ax,dx
    add ax,dx
    mov di,ax
    mov oldpos,di

    mov ax,BaseOfScreen
    mov es,ax

    mov ax,es:[di]

    xor Ah,0ffh
    mov es:[di],ax
*)
   pop es
  end;


  {$f+}
  PROCEDURE Int1cP; interrupt;
  {$f-}
  BEGIN
    INLINE($0e/$1f);
    asm
      cli
      jmp @@go
      @@kennung:db "GrbCu"
      @@go:
      call Grab
    end;
    ExecInt(int1csave);
  END;


  {$f+}
  PROCEDURE Int2fP(rflags, rcs, rip, rax, rbx, rcx, rdx, rsi, rdi, rds, res, rbp : Word); interrupt;
  {$f-}
  BEGIN
    INLINE($0e/$1f);
    asm
      jmp @go
      @kennung:db "GrbCu"
      @go:
      cmp rax,06550h
      jne @@out
      mov rbx,06946h
      mov rcx,06148h
  @@out:
    END;
(*
    IF rax = $6550 THEN
      BEGIN
        rbx := $6946;
        rcx := $6148;
        rflags := rflags AND NOT fcarry
      END;
*)
    ExecInt(int2fsave)
  END;


  PROCEDURE Keepy(k : Byte; biswohin : Pointer);
  VAR
    maxseg : ^Word;
    r : registers;
  BEGIN
    r.ah := $49;
    r.es := Word(Ptr(PrefixSeg, $2c)^);
    msdos(r);

    Move(Ptr(DSeg, 0)^, Ptr(CSeg, 0)^, Ofs(resident_ende));

    maxseg := Ptr(PrefixSeg, 2);
    maxseg^ := Seg(biswohin^)+(Ofs(biswohin^)+15) SHR 4;

    swapvectors;
    keep(k)

  END;


  PROCEDURE Error(s : String);
  BEGIN
    WriteLn(s);
    Halt(1);
  END;

  PROCEDURE Help;
  BEGIN
    WriteLn('Zweck          : residente Cursor-Emulation');
    WriteLn('Aufruf         : GrabCurs [/U]');
    WriteLn('Deinstallation : GrabCurs /U oder erneuter Aufruf!');
    error('');
  END;

  FUNCTION Installed : Boolean;
  VAR
    r : registers;
  BEGIN
    r.ax := $6550;
    intr($2f, r);
    Installed := ((r.bx = $6946) AND (r.cx = $6148))
  END;

  FUNCTION Removable : Boolean;
  CONST
    sok =
      'Dies ist Dummy-Code der überschrieben wird, wenn ein Installations-Check durchgeführt wird';
  VAR
    p : Pointer;
    s : String;
    i1,i2,i3 : Boolean;
  BEGIN
    s := sok;
    getintvec($1c, p);
    Move(p^, s, 40);
    s[0] := #40;
    i2 := (pos('GrbCu', s) <> 0);

    s := sok;
    getintvec($2f, p);
    Move(p^, s, 40);
    s[0] := #40;
    i3 := (pos('GrbCu', s) <> 0);

    Removable := (i2 AND i3);
  END;

  PROCEDURE UnInstall;
  BEGIN
    asm
     mov cx,0607h
     mov ah,01h
     int 10h

     jmp @@doit
     @@wegmeld:db "GrabCurs [PFH] deinstalliert.", 13, 10, "$"
     @@doit:
     mov ah, 35h
     mov AL, 1ch
     Int 21h                       { ES ist gesetzt auf das CSEG der Kopie im Speicher }

     mov dx, Word Ptr es: [int1csave]
     mov ds, Word Ptr es: [int1csave+2]
     mov ax, 251ch
     Int 21h

     mov dx, Word Ptr es: [int2fsave]
     mov ds, Word Ptr es: [int2fsave+2]
     mov ax, 252fh
     Int 21h

     mov es, Word Ptr es: [rcs]    { Code-Segment der Kopie laden }
     mov cx, es                    { und in CX merken }
     mov es, es: [02ch]
     mov ah, 49h
     Int 21h

     mov es, cx
     mov ah, 49h
     Int 21h

     push ds
     mov dx, offset @@wegmeld
     mov ax, Seg @@wegmeld
     mov ds, ax
     mov ah, 09h
     Int 21h
     pop ds

     mov ax, 4c00h
     Int 21h
   END
END;

FUNCTION Repl(x : Integer; c : Char) : String;
VAR
  tmp : String[255];
BEGIN
  FillChar(tmp, x+1, c);
  tmp[0] := Chr(x);
  Repl := tmp
END;

FUNCTION ReadKey : Char;
BEGIN
  asm
    mov ax, 00
    Int 16h
    mov @result, AL
  END;
END;


FUNCTION UserwillUninstall : Boolean;
VAR
  c : Char;
BEGIN
  Write('GrabCurs aus dem Speicher entfernen [J/N] ?');
  REPEAT
    c := ReadKey;
    c := Upcase(c);
    IF NOT(c IN ['J', 'N']) THEN
      Write(#7);
  UNTIL c IN ['J', 'N'];
  WriteLn(c);
  UserwillUninstall := (c = 'J')
END;

PROCEDURE Rechne;
VAR
  code : Integer;
BEGIN
  if paramcount = 1 then
    begin
      if Pos('U',stupcase(paramstr(1))) > 0 then
        if installed then
          if removable then
            uninstall
          ELSE
            Error('GrabCurs kann nicht aus dem Speicher entfernt werden.')
        ELSE
         Error('GrabCurs wurde noch nicht installiert bzw. antwortet nicht!')
      else
        Help;
    end;
  IF Installed THEN
    BEGIN
      WriteLn('GrabCurs wurde bereits installiert.');
      IF UserwillUninstall THEN
        BEGIN
          IF Removable THEN
            UnInstall
          ELSE
            Error('GrabCurs kann nicht aus dem Speicher entfernt werden.')
         END
      ELSE
        Error('Nichts gemacht.');
    END;
  rcs := CSeg;
END;

BEGIN
  initmsg;

  Rechne;
  writeln('GrabCurs benötigt ca. 480 Bytes.');
  writeln('De-Installation bei erneutem Aufruf von GrabCurs');

  getintvec($1c, int1csave);
  setintvec($1c, @Int1cP);

  getintvec($2f, int2fsave);
  setintvec($2f, @Int2fP);

  Keepy(0, @keepy)
END.