home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / spy / source / spy.pas < prev    next >
Pascal/Delphi Source File  |  1989-10-04  |  11KB  |  340 lines
  1. {$A+,B-,D-,E-,F+,I+,L-,N-,O-,R-,S-,V+}
  2. {$M 16384,0,655360}
  3. Program Spy;
  4. { SPY Monitor program - Network Remote Opertaions.  Communicates with SPYTSR.
  5.   This program is:
  6.   Copyright (c) 1989 by Edwin T. Floyd
  7.   All rights reserved
  8.  
  9.   Noncommercial use encouraged; direct commercial inquires and problem reports
  10.   to the author:
  11.  
  12.   Edwin T. Floyd [76067,747]
  13.   #9 Adams Park Court
  14.   Columbus, GA 31909
  15.   404-322-0076 (home)
  16.   404-576-3305 (work)
  17. }
  18. Uses Multi, NetBios, SpySup, Screen, Dos;
  19.  
  20. Const
  21.   StopChar = #0;  { Alt  }
  22.   StopScan = 129; { Zero }
  23.  
  24. Var
  25.   InitialScreen : Pointer;
  26.   ScreenSave : Pointer;
  27.   InitialSaveLen : Word;
  28.   ScreenSaveLen : Word;
  29.   RapidUpdateCount : Word;
  30.   ScreenReq : RequestType;
  31.   ScreenInfo : ScreenInfoType;
  32.   Regs : Registers;
  33.   Adapter : Byte;
  34.   SpyLsn : Byte;
  35.   StopSpy : Boolean;
  36.   Break : Boolean;
  37.   SessionUp : Boolean;
  38.   ScreenTask : TaskType;
  39.   ScreenWaiting : Boolean;
  40.   KeyTask : TaskType;
  41.   KeyWaiting : Boolean;
  42.   MyName : NetNameType;
  43.   CallName : NetNameType;
  44.  
  45. Procedure ScreenUpdateProc(p : Pointer);
  46. Var
  47.   ScreenNct : TaskNctType;
  48.   Err : Byte;
  49. Begin
  50.   WriteLn('Screen update task started');
  51.   ScreenTask := MyTaskId;
  52.   With ScreenNct Do Begin
  53.     NetSetAdapter(Nct, Adapter, NetNoWait, NetTaskPost);
  54.     Repeat
  55.       ScreenWaiting := False;
  56.       If Not Break Then With ScreenReq Do Begin
  57.         Req := SendScreen;
  58.         Count := 0;
  59.         NetSend(Nct, SpyLsn, ScreenReq, SizeOf(ScreenReq) - SizeOf(Key));
  60.         Err := NetWaitError(ScreenNct, 2000);
  61.         If Err = 0 Then Begin
  62.           NetReceive(Nct, SpyLsn, ScreenSave^, ScreenSaveLen);
  63.           Err := NetWaitError(ScreenNct, 2000);
  64.           If (Err = 0) Or (Err = 6) Then With ScreenSaveHeader(ScreenSave^)
  65.           Do Begin
  66.             If (Size + SizeOf(ScreenSaveHeader) <= ScreenSaveLen) Then Begin
  67.               If Not Break Then RestoreScreenArea(ScreenSave^);
  68.             End Else Begin
  69.               FreeMem(ScreenSave, ScreenSaveLen);
  70.               ScreenSaveLen := Size + SizeOf(ScreenSaveHeader);
  71.               GetMem(ScreenSave, ScreenSaveLen);
  72.             End;
  73.             If Err = 6 Then Begin { Flush }
  74.               NetReceive(Nct, SpyLsn, ScreenSave^, ScreenSaveLen);
  75.               Err := NetWaitError(ScreenNct, 200);
  76.             End;
  77.           End;
  78.         End;
  79.         If (Err <> 0) And (NetReturnAction(Nct) = SessionDead) Then
  80.           SessionUp := False;
  81.       End;
  82.       If Not SessionUp Then Begin
  83.         SetCursorPosition($0101);
  84.         WriteLn('Calling ', Copy(CallName, 1, 15));
  85.         NetCall(Nct, CallName, MyName, CallRto, CallSto);
  86.         Err := NetWaitError(ScreenNct, 2000);
  87.         If Err <> 0 Then Begin
  88.           WriteLn('Unable to connect to ', Copy(CallName, 1, 15));
  89.           NetShutdown;
  90.           StopAll(5);
  91.         End;
  92.         SpyLsn := NetLsn(Nct);
  93.         SessionUp := True;
  94.       End;
  95.       Wait(50);
  96.       ScreenWaiting := True;
  97.       If RapidUpdateCount = 0 Then Wait(150) Else Dec(RapidUpdateCount);
  98.     Until StopSpy;
  99.   End;
  100.   Wake(KeyTask);
  101.   Stop;
  102. End;
  103.  
  104. Procedure NetWaitKey;
  105. Var
  106.   i : Word;
  107.   KeyReq : RequestType;
  108.   KeyNct : TaskNctType;
  109.   Err : Byte;
  110. Begin
  111.   KeyTask := MyTaskId;
  112.   With KeyNct Do Begin
  113.     NetSetAdapter(Nct, Adapter, NetNoWait, NetTaskPost);
  114.     KeyReq.Count := 0;
  115.     Repeat
  116.       KeyWaiting := False;
  117.       If KeyHead <> KeyTail Then With KeyReq Do Begin
  118.         While (Count < MaxReqKeys) And (KeyHead <> KeyTail) Do Begin
  119.           With KeyQueue[KeyTail] Do Begin
  120.             If Break Then Begin
  121.               Case UpCase(KeyChar) Of
  122.                 'E' : Begin
  123.                   WriteLn('Spy will end now');
  124.                   StopSpy := True;
  125.                 End;
  126.                 'B' : Begin
  127.                   Req := Boot;
  128.                   NetSend(Nct, SpyLsn, KeyReq, SizeOf(KeyReq) - SizeOf(Key));
  129.                   Err := NetWaitError(KeyNct, 2000);
  130.                   If Err = 0 Then Begin
  131.                     WriteLn('Remote system ordered to reboot');
  132.                     WriteLn('Spy will end now');
  133.                     Wait(100);
  134.                     StopSpy := True;
  135.                   End Else Begin
  136.                     WriteLn('Unable to send Boot cmd ', Err);
  137.                     If NetReturnAction(Nct) = SessionDead Then
  138.                       SessionUp := False;
  139.                   End;
  140.                 End;
  141.                 'S' : Begin
  142.                   Req := DieQuietly;
  143.                   NetSend(Nct, SpyLsn, KeyReq, SizeOf(KeyReq) - SizeOf(Key));
  144.                   Err := NetWaitError(KeyNct, 2000);
  145.                   If Err = 0 Then Begin
  146.                     WriteLn('Remote SPYTSR ordered to die quietly');
  147.                     WriteLn('Spy will end now');
  148.                     Wait(100);
  149.                     StopSpy := True;
  150.                   End Else Begin
  151.                     WriteLn('Unable to stop remote SPYTSR ', Err);
  152.                     If NetReturnAction(Nct) = SessionDead Then
  153.                       SessionUp := False;
  154.                   End;
  155.                 End;
  156.                 ^[ : Begin
  157.                   WriteLn('Returning to remote screen');
  158.                   Break := False;
  159.                   If ScreenWaiting Then Wake(ScreenTask);
  160.                 End;
  161.                 StopChar : If KeyScan = StopScan Then Begin
  162.                   WriteLn('Alt-0 sent to remote system');
  163.                   Break := False;
  164.                   Inc(Count);
  165.                   Key[Count] := KeyQueue[KeyTail];
  166.                   If ScreenWaiting Then Wake(ScreenTask);
  167.                 End;
  168.               End;
  169.             End Else Begin
  170.               Case KeyChar Of
  171.                 #0 : If KeyScan = StopScan Then Break := True;
  172.                 Else If KeyChar = StopChar Then Break := True;
  173.               End;
  174.               If Break Then Begin
  175.                 FillWord(ScreenSave^, ScreenCols, 0);
  176.                 For i := 1 To ScreenRows Do
  177.                   PutWords(ScreenSave^, Succ(i Shl 8), ScreenCols);
  178.                 SetCursorPosition($0101);
  179.                 WriteLn('You are connected to remote system: ',
  180.                   Copy(CallName, 1, 15));
  181.                 WriteLn('Break menu:');
  182.                 WriteLn;
  183.                 WriteLn('  (E)xit SPY on local system');
  184.                 WriteLn('  (B)oot remote system');
  185.                 WriteLn('  (S)top SPYTSR on remote system');
  186.                 WriteLn('  (Alt-0) Send Alt-0 to remote system');
  187.                 WriteLn;
  188.                 WriteLn('Press a key to choose an action or <Esc> to return...');
  189.               End Else Begin
  190.                 Inc(Count);
  191.                 Key[Count] := KeyQueue[KeyTail];
  192.               End;
  193.             End;
  194.             If KeyTail = MaxTableKeys Then KeyTail := 0 Else Inc(KeyTail);
  195.           End;
  196.         End;
  197.         If (Count > 0) And SessionUp Then Begin
  198.           Req := StuffKeyboard;
  199.           NetSend(Nct, SpyLsn, KeyReq, SizeOf(KeyReq) - SizeOf(Key)
  200.             + Count * SizeOf(KeyType));
  201.           Err := NetWaitError(KeyNct, 2000);
  202.           If Err = 0 Then Count := 0 Else Begin
  203.             If NetReturnAction(Nct) = SessionDead Then SessionUp := False
  204.             Else WriteLn('Unable to send keystrokes: ', Err);
  205.           End;
  206.           RapidUpdateCount := 10;
  207.           If ScreenWaiting Then Wake(ScreenTask);
  208.         End;
  209.       End;
  210.       Wait(20);
  211.       KeyWaiting := True;
  212.       If KeyHead = KeyTail Then Wait(150);
  213.     Until StopSpy;
  214.     FreezeTask(ScreenTask);
  215.     NetShutdown;
  216.     If SessionUp Then Begin
  217.       NetHangup(Nct, SpyLsn);
  218.       Err := NetWaitError(KeyNct, 500);
  219.     End;
  220.   End;
  221.   NetShutdown;
  222.   RestoreScreenArea(InitialScreen^);
  223.   WriteLn('Spy Terminated');
  224.   StopAll(0);
  225. End;
  226.  
  227. Procedure SpyIdle(Timeout : LongInt);
  228. Var
  229.   i : 0..MaxTableKeys;
  230. Begin
  231.   With Regs Do Begin
  232.     Ah := $01;
  233.     Intr($16, Regs);
  234.     If (Flags And FZero) = 0 Then Begin
  235.       i := KeyHead;
  236.       If i = MaxTableKeys Then i := 0 Else Inc(i);
  237.       If i <> KeyTail Then With KeyQueue[KeyHead] Do Begin
  238.         Ah := $00;
  239.         Intr($16, Regs);
  240.         KeyChar := Chr(Al);
  241.         KeyScan := Ah;
  242.         KeyHead := i;
  243.         If KeyWaiting Then Wake(KeyTask);
  244.       End;
  245.     End;
  246.   End;
  247. End;
  248.  
  249. Procedure InitSpy;
  250. Var
  251.   i, j : Integer;
  252.   NameNct : TaskNctType;
  253.   Status : NetAdapterStatusType;
  254.   Err : Byte;
  255.   s : String[2];
  256. Begin
  257.   RapidUpdateCount := 0;
  258.   StopSpy := False;
  259.   Break := False;
  260.   SessionUp := False;
  261.   If (ParamCount < 1) Or (ParamStr(1) = '') Then Begin
  262.     WriteLn('Run like this: SPY <name>');
  263.     StopAll(1);
  264.   End Else Begin
  265.     CallName := ParamStr(1);
  266.     For i := 1 To Length(CallName) Do CallName[i] := UpCase(CallName[i]);
  267.     While Length(CallName) < 16 Do
  268.       Insert(' ', CallName, Succ(Length(CallName)));
  269.     CallName[16] := #$EF;
  270.   End;
  271.   If ParamCount > 1 Then Begin
  272.     s := ParamStr(2);
  273.     Val(s, i, j);
  274.     If (i >= 0) And (i < 3) Then Adapter := i Else Begin
  275.       WriteLn('Adapter must be 0..3, "', ParamStr(2), '" specified');
  276.       StopAll(2);
  277.     End;
  278.   End Else Adapter := 0;
  279.   If Not NetAdapterPresent(Adapter) Then Begin
  280.     WriteLn('Adapter ', Adapter, ' not found');
  281.     StopAll(3);
  282.   End;
  283.   With NameNct Do Begin
  284.     NetSetAdapter(Nct, Adapter, NetNoWait, NetTaskPost);
  285.     WriteLn('Getting Unit Name for adapter ', Adapter);
  286.     NetAdapterStatus(Nct, Status, '*');
  287.     Err := NetWaitError(NameNct, 2000);
  288.     If Err <> 0 Then Begin
  289.       WriteLn('Unable to acquire local adapter Unit Name, error ', Err);
  290.       StopAll(4);
  291.     End Else Begin
  292.       MyName[0] := #16;
  293.       FillChar(MyName[1], 10, 0);
  294.       Move(Status.UnitId, MyName[11], 6);
  295.     End;
  296.     WriteLn('Calling ', Copy(CallName, 1, 15));
  297.     NetCall(Nct, CallName, MyName, CallRto, CallSto);
  298.     Err := NetWaitError(NameNct, 2000);
  299.     If Err <> 0 Then Begin
  300.       WriteLn('Unable to connect to ', Copy(CallName, 1, 15),
  301.         ', error ', Err);
  302.       StopAll(5);
  303.     End;
  304.     SpyLsn := NetLsn(Nct);
  305.     SessionUp := True;
  306.     WriteLn('Requesting screen information');
  307.     With ScreenReq Do Begin
  308.       Req := SendScreenInfo;
  309.       Count := 0;
  310.       NetSend(Nct, SpyLsn, ScreenReq, SizeOf(ScreenReq) - SizeOf(Key));
  311.       Err := NetWaitError(NameNct, 2000);
  312.       If Err = 0 Then Begin
  313.         NetReceive(Nct, SpyLsn, ScreenInfo, SizeOf(ScreenInfo));
  314.         Err := NetWaitError(NameNct, 2000);
  315.         If Err = 0 Then Begin
  316.           ScreenSaveLen := ScreenInfo.ScreenSaveSize;
  317.           WriteLn('ScreenSave area is ', ScreenSaveLen, ' bytes');
  318.           GetMem(ScreenSave, ScreenSaveLen);
  319.         End;
  320.       End;
  321.       If Err <> 0 Then Begin
  322.         WriteLn('Unable to acquire screen information from ',
  323.           Copy(CallName, 1, 15), ', error ', Err);
  324.         StopAll(6);
  325.       End;
  326.     End;
  327.   End;
  328.   WriteLn('Connection established');
  329.   InitialSaveLen := ScreenAreaSize(1, 1, ScreenCols, ScreenRows);
  330.   GetMem(InitialScreen, InitialSaveLen);
  331.   SaveScreenArea(InitialScreen^, 1, 1, ScreenCols, ScreenRows);
  332.   IdleRoutine := SpyIdle;
  333.   Spawn(ScreenUpdateProc, Nil, 8192, 'SCREEN');
  334. End;
  335.  
  336. Begin
  337.   WriteLn('SPY Version 1.1 Starting - Press Alt-0 for menu');
  338.   InitSpy;
  339.   NetWaitKey;
  340. End.