home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 01 / sendkeys / sendkeys.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-10-26  |  10.8 KB  |  223 lines
  1. (* ------------------------------------------------------------------------- *)
  2. (*                              SENDKEYS.PAS  (v1.0)                         *)
  3. (*  Simulation von Tastatureingaben an aus Batch-Dateien geladene Programme  *)
  4. (*  System: MS-DOS      Sprache: Turbo Pascal                                *)
  5. (*        (c)  1987  Karsten Gieselmann  &  PASCAL International             *)
  6. (* ------------------------------------------------------------------------- *)
  7. {$C-,I-,K-,R-,U-,V-}                (* alle Compiler-Schalter desaktivieren! *)
  8. PROGRAM SendKeys;
  9. {$I REGS8088.INC}        (* einbinden der Interrupt-Routinen aus PASCAL 6/87 *)
  10. {$I CRITICAL.INC}
  11. {$I MAKEINT.INC}
  12.  
  13. CONST Version   : STRING[14] = 'SENDKEYS  v1.0';
  14.       MaxKeyLen =   100;          (* Maximalzahl zu uebergebender Scan-Codes *)
  15.       DosSeg    = $0040;          (* Datensegment des Betriebssystems        *)
  16.       FirstChar = $001A;          (* Offset des ersten abzuholenden Zeichens *)
  17.       BufPtr    = $001C;          (*   -     -  letzten      -         -     *)
  18.       MinPtr    = $001E;          (* untere Begrenzung des Tastaturpuffers   *)
  19.       MaxPtr    = $003C;          (* obere       -      -         -          *)
  20.       KeyBoardOldInterrupt : IntEntry_ = (Offset:0; Segment:0);
  21.  
  22. TYPE  CmdStr    = STRING [127];    (* maximale Laenge der DOS-Parameterzeile *)
  23.       Line      = STRING [255];
  24.       Range     = 0..MaxKeyLen;
  25.  
  26. VAR   CmdLine     : CmdStr ABSOLUTE CSeg:$0080; (* die DOS-Parameterzeile... *)
  27.       CmdLen      : BYTE ABSOLUTE CmdLine;      (* ...und deren Laenge       *)
  28.       KeyPtr      : Range;                      (* naechster Scan-Code       *)
  29.       KeyStroke   : ARRAY [Range] OF INTEGER;   (* vorgegebene Scan-Codes    *)
  30.       KeyLen      : INTEGER ABSOLUTE KeyStroke; (* Anzahl vorhandener Codes  *)
  31.       SENDKEYS_Seg: INTEGER;                    (* Segment der residenten R. *)
  32. (* ------------------------------------------------------------------------- *)
  33. (*                  Zeichen im DOS-Tastaturpuffer ablegen                    *)
  34. PROCEDURE PutScanCodeInKeyboardBuffer (Code : INTEGER);
  35. BEGIN
  36.   MemW[DosSeg:MemW[DosSeg:BufPtr]] := Code;             (* Scan-Code ablegen *)
  37.   MemW[DosSeg:BufPtr] := MemW[DosSeg:BufPtr] + 2;    (* Zeiger weiterrechnen *)
  38.   IF MemW[DosSeg:BufPtr] > MaxPtr THEN MemW[DosSeg:BufPtr] := MinPtr
  39. END;
  40. (* ------------------------------------------------------------------------- *)
  41. (*          diese Routine wird vor den Tastatur-Interrupt gehaengt           *)
  42. PROCEDURE KeyboardInterrupt;
  43. {$I BEGININT.INC}
  44.   IF KeyPtr <= KeyLen THEN                       (* liegen noch Zeichen vor? *)
  45.     IF MemW[DosSeg:BufPtr] = MemW[DosSeg:FirstChar] THEN     (* Puffer leer? *)
  46.       BEGIN
  47.         PutScanCodeInKeyboardBuffer (KeyStroke[KeyPtr]);
  48.         KeyPtr := Succ (KeyPtr)                       (* naechster Scan-Code *)
  49.       END;
  50.   {$I EXITINT.INC}                            (* weiter mit normalen Int-16h *)
  51.        KeyBoardOldInterrupt);
  52. {$I ENDINT.INC}
  53. (* ------------------------------------------------------------------------- *)
  54. (*            prueft nach, ob SENDKEYS bereits installiert ist               *)
  55. FUNCTION ProgramAlreadyExists (VAR Segment : INTEGER) : BOOLEAN;
  56. CONST Addr   : INTEGER = $0000;                  (* Adresse des Suchstrings  *)
  57.       Seg    : INTEGER = $0000;                  (* Segment von SENDKEYS     *)
  58.       MinSeg : INTEGER = $0000;                  (* minimales Suchsegment    *)
  59.       MaxSeg : INTEGER = $0000;                  (* maximales Suchsegment    *)
  60.       Len    : INTEGER = $0000;                  (* Laenge des Suchstrings   *)
  61.       found  : BOOLEAN =  TRUE;                  (* wurde SENDKEYS gefunden? *)
  62. BEGIN
  63.   Addr   := Ofs (Version);                         (* Offset des Suchstrings *)
  64.   Len    := Length (Version);                      (* Laenge des Suchstrings *)
  65.   MinSeg := $0A00;  MaxSeg := Pred (CSeg);
  66.   INLINE (
  67.          $1E/           (*         PUSH   DS        ;Datensegment sichern    *)
  68.          $0E/           (*         PUSH   CS                                 *)
  69.          $1F/           (*         POP    DS        ;Datensegment ist Code   *)
  70.          $A1/MinSeg/    (*         MOV    AX,MinSeg ;minimales Such-Segment  *)
  71.          $8B/$1E/Addr/  (*         MOV    BX,Addr   ;Offset des Vers-Strings *)
  72.          $8B/$16/Addr/  (*         MOV    DX,Addr   ;Offset des Suchstrings  *)
  73.          $89/$D6/       (* Loop:   MOV    SI,DX     ;Register zum...         *)
  74.          $89/$DF/       (*         MOV    DI,BX     ;...Blockvergleich laden *)
  75.          $8B/$0E/Len/   (*         MOV    CX,Len    ;Laenge des Suchstrings  *)
  76.          $40/           (*         INC    AX        ;Such-Segment erhoehen...*)
  77.          $8E/$C0/       (*         MOV    ES,AX     ;und nach ES laden       *)
  78.          $F3/$A6/       (*         REPZ   CMPSB     ;vergleichen             *)
  79.          $74/$0A/       (*         JZ     found     ;Uebereinstimmung?       *)
  80.          $3B/$06/MaxSeg/(*         CMP    AX,MaxSeg ;maximales Such-Segment? *)
  81.          $75/$EB/       (*         JNE    Loop      ;nein: dann weiter       *)
  82.          $B0/$00/       (*         MOV    AL,00     ;sonst nicht gefunden... *)
  83.          $EB/$05/       (*         JMP    ready     ;...und Suche beenden    *)
  84.          $A3/Seg/       (* found:  MOV    Seg,AX    ;gefunden: Segm. sichern *)
  85.          $B0/$01/       (*         MOV    AL,01     ;und "gefunden" melden   *)
  86.          $A2/found/     (* ready:  MOV    found,AL  ;"gefunden"-Status laden *)
  87.          $1F);          (*         POP    DS        ;Datensegment herstellen *)
  88.   ProgramAlreadyExists := found;
  89.   Segment := Seg;
  90. END;
  91. (* ------------------------------------------------------------------------- *)
  92. (*          Zerlegung der DOS-Parameterzeile in einzelne Argumente           *)
  93. PROCEDURE ParseCommandLine (Segment : INTEGER);
  94. VAR ParamFile : TEXT;
  95.     ParamLine : Line;
  96.  
  97.   PROCEDURE SetKeyStroke (ScanCode :INTEGER);
  98.      (* besetzt die naechste freie Komponente von "KeyStroke" mit "ScanCode";
  99.         es wird  ferner darauf geachtet,  dass die Anzahl der Codes die durch
  100.         "MaxKeyLen" gegebene Obergrenze nicht ueberschreitet, wenn  erforder-
  101.         lich, wird bei "MaxKeyLen" abeschnitten!                             *)
  102.   VAR Index : Range;
  103.   BEGIN
  104.     Index := MemW[Segment:Ofs(KeyStroke[0])];
  105.     IF Index < MaxKeyLen THEN
  106.       BEGIN
  107.         Index := Succ (Index);
  108.         MemW[Segment:Ofs(KeyStroke[Index])] := ScanCode;
  109.         MemW[Segment:Ofs(KeyStroke[0])] := Index;
  110.       END
  111.   END;
  112.  
  113.   PROCEDURE Error (ErrorMsg : Line);
  114.                             (* Meldung eines eventuell aufgetretenen Fehlers *)
  115.   BEGIN
  116.     WriteLn ('Fehler:  ',ErrorMsg);   Halt;
  117.   END;
  118.  
  119.   PROCEDURE Parse (ParamLine : Line);
  120.                   (* filtert aus "ParamLine" die einzelnen Scan-Codes heraus *)
  121.   CONST EoS = #$00;                                 (* Konstante EndOfString *)
  122.   VAR   C : CHAR;
  123.         s : Line;
  124.         p : INTEGER;
  125.  
  126.     FUNCTION NextChar :CHAR;
  127.       (* liefert naechstes Zeichen von ParamLine und loescht es gleichzeitig *)
  128.     BEGIN
  129.       IF Length(ParamLine) > 0 THEN                      (* noch Zeichen da? *)
  130.         BEGIN
  131.           NextChar := ParamLine[1];                  (* ja: Zeichen holen... *)
  132.           Delete (ParamLine,1,1)            (* ...und aus ParamLine loeschen *)
  133.         END
  134.       ELSE
  135.         NextChar := EoS                                   (* nein: dann Ende *)
  136.     END;
  137.  
  138.     FUNCTION ScannedNumber :INTEGER;
  139.         (* wertet die bei "Paramline" vorn anstehende (Hexa-)Dezimalzahl aus *)
  140.     VAR C        : CHAR;
  141.         s        : Line;
  142.         i,Result : INTEGER;
  143.     BEGIN
  144.       s := '';   C := NextChar;
  145.       IF C='#' THEN    (* explizite Scan-Code-Angabe: muss hexadezimal sein! *)
  146.         C := '$';
  147.       IF C='$' THEN                                       (* Hexadezimalzahl *)
  148.         BEGIN
  149.           s := '$';   C := NextChar;
  150.           WHILE C IN ['0'..'9','A'..'F','a'..'f'] DO BEGIN
  151.             s := s + C;   C := NextChar;
  152.           END;
  153.         END
  154.       ELSE                                                    (* Dezimalzahl *)
  155.         BEGIN
  156.           WHILE C IN ['0'..'9'] DO BEGIN
  157.             s := s + C;   C := NextChar;
  158.           END;
  159.         END;
  160.       ParamLine := C + ParamLine;                  (* letztes Zeichen retten *)
  161.       Val (s,i,Result);
  162.       IF Result <> 0 THEN  Error ('unerlaubtes Zeichen in einer Zahl!');
  163.       ScannedNumber := i
  164.     END;
  165.  
  166.   BEGIN (* Parse *)
  167.     REPEAT
  168.       C := NextChar;
  169.       CASE C OF
  170.            '"': BEGIN
  171.                   p := Pos ('"',ParamLine);        (* wo ist Ende der Kette? *)
  172.                   IF p=0 THEN  Error ('String-Ende nicht gefunden!');
  173.                   s := Copy (ParamLine,1,Pred(p));    (* Kette herausfiltern *)
  174.                   Delete (ParamLine,1,p);
  175.                   FOR p:=1 TO Length(s) DO
  176.                     SetKeyStroke (Ord(s[p]));          (* Scan-Codes ablegen *)
  177.                 END;
  178.       '$','#',
  179.       '0'..'9': BEGIN
  180.                   ParamLine := C + ParamLine;      (* letztes Zeichen retten *)
  181.                   SetKeyStroke (ScannedNumber);
  182.                 END;
  183.            ';': C := EoS;                         (* der Rest ist Kommentar! *)
  184.        ' ',EoS: ;                                          (* nichts machen! *)
  185.        ELSE                                     (* irgendetwas stimmt nicht! *)
  186.          Error ('unerlaubtes Zeichen in Zeile!');
  187.       END;
  188.     UNTIL C = EoS;
  189.   END;
  190.  
  191. BEGIN (* ParseCommandLine *)
  192.   MemW [Segment:Ofs(KeyPtr)] := 1;  KeyLen := 0;  (* Zeiger wieder an Anfang *)
  193.   IF (ParamStr(1) = '-f') OR (ParamStr(1) = '-F') THEN    (* Parameter-Datei *)
  194.     BEGIN
  195.       Assign (ParamFile, ParamStr(2));  ReSet (ParamFile);
  196.       IF IOResult <> 0 THEN  Error ('Parameter-Datei existiert nicht!');
  197.       WHILE NOT Eof(ParamFile) AND (KeyLen < MaxKeyLen) DO BEGIN
  198.         ReadLn (ParamFile, ParamLine);   Parse (ParamLine);
  199.       END;
  200.       Close (ParamFile)
  201.     END
  202.   ELSE                                    (* Parameter aus DOS-Kommandozeile *)
  203.     BEGIN
  204.       ParamLine := CmdLine;   Parse (ParamLine)
  205.     END
  206. END;
  207. (* ------------------------------------------------------------------------- *)
  208. BEGIN
  209.   IF ProgramAlreadyExists (SENDKEYS_Seg) THEN      (* SENDKEYS schon geladen *)
  210.     ParseCommandLine (SENDKEYS_Seg + (DSeg - CSeg))
  211.   ELSE                                              (* sonst resident machen *)
  212.     BEGIN
  213.       WriteLn;
  214.       WriteLn('SendKeys v1.0  resident...');
  215.       WriteLn('   (C) 1987  Karsten Gieselmann & PASCAL Int.');
  216.       WriteLn;
  217.       ParseCommandLine (DSeg);
  218.       WITH KeyBoardOldInterrupt DO IntGet (IntKeyboard, Segment, Offset);
  219.       IntSet (IntKeyboard, CSeg, Ofs (KeyboardInterrupt));
  220.       MakeResident;
  221.     END
  222. END.
  223.