home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / spy / source / spytsr.pas < prev    next >
Pascal/Delphi Source File  |  1989-10-03  |  8KB  |  246 lines
  1. {$A+,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 4096,0,655360}
  3. Program SpyTsr;
  4. { SPYTSR Network Remote Opertaions - SPY Resident portion.
  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
  10.   reports 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 Tsr, Multi, MultiTsr, NetBios, SpySup, Screen, Dos;
  19.  
  20. Const
  21.   SpyVersion : String[19] = 'SPYTSR version 1.1';
  22.  
  23. Var
  24.   ScreenSave : Pointer;         { Save area for screen }
  25.   ScreenSaveLen : Word;         { Size of ScreenSave }
  26.   Request : RequestType;        { Request from SPY }
  27.   ScreenInfo : ScreenInfoType;  { SendScreenInfo response }
  28.   Adapter : Byte;               { Network Adapter number }
  29.   MyNameNum : Byte;             { Name number of local name }
  30.   StopSpyTsr : Boolean;         { True if DieQuietly request received }
  31.   NameStatus : (NameDown, NameUp, NameConflict); { Status of name }
  32.   ListenTask : TaskType;        { TaskId of Name/Listen (mainline) task }
  33.   ServerTask : TaskType;        { TaskId of the Server task }
  34.   MyName : NetNameType;         { Local name }
  35.   Session : Array[0..255] Of Boolean; { Active session table }
  36.  
  37. Procedure NetCheckError(Err, Lsn : Byte);
  38. { Check for error which would affect local name status }
  39. Var
  40.   WakeListen : Boolean;
  41. Begin { NetCheckError }
  42.   WakeListen := NameStatus = NameUp;
  43.   Case Err Of
  44.     $13, $15 : NameStatus := NameDown;
  45.     $19 : NameStatus := NameConflict;
  46.   Else
  47.     WakeListen := False;
  48.     Case Err Of
  49.       $08, $0A, $18 : Session[Lsn] := False;
  50.     End;
  51.   End;
  52.   If WakeListen Then Wake(ListenTask);
  53. End;  { NetCheckError }
  54.  
  55. Procedure ServerProc(p : Pointer);
  56. { This task receives and responds to SPY requests }
  57. Var
  58.   i, j : Word;
  59.   BiosResetFlag : Word Absolute $0040:$0072;
  60.   ReceiveNct : TaskNctType;
  61.   Err, ReqLsn : Byte;
  62. Begin { ServerProc }
  63.   With ReceiveNct, Request Do Begin
  64.     NetSetAdapter(Nct, Adapter, NetNoWait, NetTaskPost);
  65.     Repeat
  66.       If NameStatus = NameUp Then Begin
  67.         NetReceiveAny(Nct, MyNameNum, Request, SizeOf(Request));
  68.         Err := NetWaitError(ReceiveNct, 3000);
  69.         ReqLsn := NetLsn(Nct);
  70.         If Err = 0 Then Begin
  71.           Session[ReqLsn] := True;
  72.           If ScreenVideoMode <> BiosVideoMode Then GetBiosInfo;
  73.           Case Req Of
  74.             SendScreen : Begin
  75.               SaveScreenArea(ScreenSave^, 1, 1, ScreenCols, ScreenRows);
  76.               NetSend(Nct, ReqLsn, ScreenSave^,
  77.                 ScreenSaveHeader(ScreenSave^).Size
  78.                 + SizeOf(ScreenSaveHeader));
  79.               Err := NetWaitError(ReceiveNct, 2000);
  80.               NetCheckError(Err, ReqLsn);
  81.             End;
  82.             StuffKeyboard : Begin
  83.               For i := 1 To Count Do Begin
  84.                 j := KeyHead;
  85.                 If j = MaxTableKeys Then j := 0 Else Inc(j);
  86.                 If j <> KeyTail Then Begin
  87.                   KeyQueue[KeyHead] := Key[i];
  88.                   KeyHead := j;
  89.                 End;
  90.               End;
  91.             End;
  92.             Boot: Begin
  93.               BiosResetFlag := $1234; { Emulate keyboard reset }
  94.               Inline($EA/$00/$00/$FF/$FF);
  95.             End;
  96.             DieQuietly : StopSpyTsr := True;
  97.             SendScreenInfo : With ScreenInfo Do Begin
  98.               ScreenType := ScreenAdapterType;
  99.               Mode := ScreenVideoMode;
  100.               Rows := ScreenRows;
  101.               Cols := ScreenCols;
  102.               ScreenSaveSize := ScreenSaveLen;
  103.               NetSend(Nct, ReqLsn, ScreenInfo, SizeOf(ScreenInfo));
  104.               Err := NetWaitError(ReceiveNct, 2000);
  105.               NetCheckError(Err, ReqLsn);
  106.             End;
  107.           End;
  108.         End Else NetCheckError(Err, ReqLsn);
  109.       End Else Wait(100);
  110.     Until StopSpyTsr;
  111.   End;
  112.   Wake(ListenTask);
  113.   Stop;
  114. End;  { ServerProc }
  115.  
  116. Procedure AwaitConnect;
  117. { This is the mainline task that receives control from BeginTsr.  It attempts
  118.   to keep the local name up and listens for SPY calls. }
  119. Var
  120.   ListenNct : TaskNctType;
  121.   i, Err : Byte;
  122. Begin { AwaitConnect }
  123.   Close(Input);
  124.   Close(Output);
  125.   ListenTask := MyTaskId;
  126.   With ListenNct Do Begin
  127.     NetSetAdapter(Nct, Adapter, NetNoWait, NetTaskPost);
  128.     Repeat
  129.       Case NameStatus Of
  130.         NameDown : Begin
  131.           NetAddName(Nct, MyName);
  132.           Err := NetWaitError(ListenNct, 2000);
  133.           If (Err = 0) Or (Err = $0D) Then Begin
  134.             MyNameNum := NetNum(Nct);
  135.             NameStatus := NameUp;
  136.           End Else Begin
  137.             NetCheckError(Err, 255);
  138.             Wait(100);
  139.           End;
  140.         End;
  141.         NameUp : Begin
  142.           NetListen(Nct, '*', MyName, ListenRto, ListenSto);
  143.           Err := NetWaitError(ListenNct, 2000);
  144.           If Err = 0 Then Session[NetLsn(Nct)] := True
  145.           Else NetCheckError(Err, NetLsn(Nct));
  146.         End;
  147.         NameConflict : Begin
  148.           NetDeleteName(Nct, MyName);
  149.           Err := NetWaitError(ListenNct, 2000);
  150.           NameStatus := NameDown;
  151.           NetCheckError(Err, 255);
  152.         End;
  153.       End;
  154.     Until StopSpyTsr;
  155.     FreezeTask(ServerTask);
  156.     NetShutdown;
  157.     For i := 1 To 255 Do If Session[i] Then Begin
  158.       NetHangup(Nct, i);
  159.       Err := NetWaitError(ListenNct, 500);
  160.       Session[i] := False;
  161.     End;
  162.     NameStatus := NameDown;
  163.     NetDeleteName(Nct, MyName);
  164.     Err := NetWaitError(ListenNct, 2000);
  165.   End;
  166.   NetShutdown;
  167.   RemoveTsr;
  168. End;  { AwaitConnect }
  169.  
  170. Procedure KeyFilter(Var Key : KeyControlType);
  171. { KeyFilter inserts keystrokes from SPY into the local keyboard stream }
  172. Begin { KeyFilter }
  173.   With Key Do Begin
  174.     If (Action = KeyUnavailable) Or (Action = KeySubstitute) Then Begin
  175.       If KeyHead <> KeyTail Then Begin
  176.         Action := KeyInsert;
  177.         With KeyQueue[KeyTail] Do Begin
  178.           CharCode := KeyChar;
  179.           ScanCode := KeyScan;
  180.         End;
  181.         If KeyTail = MaxTableKeys Then KeyTail := 0 Else Inc(KeyTail);
  182.       End;
  183.     End;
  184.   End;
  185. End;  { KeyFilter }
  186.  
  187. Procedure InitSpyTsr;
  188. { Initialize local data and interpret parameters }
  189. Var
  190.   i, j : Integer;
  191.   s : String[2];
  192. Begin { InitSpyTsr }
  193.   KeyHead := 0;
  194.   KeyTail := 0;
  195.   StopSpyTsr := False;
  196.   NameStatus := NameDown;
  197.   FillChar(Session, SizeOf(Session), 0);
  198.   If (ParamCount < 1) Or (ParamStr(1) = '') Then Begin
  199.     WriteLn('Run like this: SPYTSR <name>');
  200.     StopAll(1);
  201.   End Else Begin
  202.     MyName := ParamStr(1);
  203.     For i := 1 To Length(MyName) Do MyName[i] := UpCase(MyName[i]);
  204.     While Length(MyName) < 16 Do Insert(' ', MyName, Succ(Length(MyName)));
  205.     MyName[16] := #$EF;
  206.   End;
  207.   If ParamCount > 1 Then Begin
  208.     s := ParamStr(2);
  209.     Val(s, i, j);
  210.     If (i >= 0) And (i < 3) Then Adapter := i Else Begin
  211.       WriteLn('Adapter must be 0..3, "', ParamStr(2), '" specified');
  212.       StopAll(2);
  213.     End;
  214.   End Else Adapter := 0;
  215.   If Not NetAdapterPresent(Adapter) Then Begin
  216.     WriteLn('Adapter ', Adapter, ' not found');
  217.     StopAll(3);
  218.   End;
  219.   Case ScreenAdapterType Of
  220.     EGAMono, EGAColor :
  221.       ScreenSaveLen := SizeOf(ScreenSaveHeader) + 2 * 132 * 43;
  222.     VGAMono, VGAColor :
  223.       ScreenSaveLen := SizeOf(ScreenSaveHeader) + 2 * 132 * 50;
  224.     Else
  225.       ScreenSaveLen := SizeOf(ScreenSaveHeader) + 2 * 80 * 25;
  226.   End;
  227.   If CheckLoaded(SpyVersion) <> @SpyVersion Then Begin
  228.     WriteLn('SPYTSR already loaded');
  229.     StopAll(4);
  230.   End;
  231.   GetMem(ScreenSave, ScreenSaveLen);
  232.   SaveScreenArea(ScreenSave^, 1, 1, ScreenCols, ScreenRows);
  233.   SetKeyRoutine(KeyFilter);
  234.   Spawn(ServerProc, Nil, 2048, 'SERVER');
  235.   ServerTask := MRCTaskId;
  236. End;  { InitSpyTsr }
  237.  
  238. Begin { SpyTsr }
  239.   InitSpyTsr;
  240.   SetFreeHeap(40);
  241.   WriteLn(SpyVersion, ' started, program size is ',
  242.     ProgramSize, ' bytes');
  243.   BeginTsr(AwaitConnect, 0);
  244.   WriteLn('SPYTSR not installed, requires DOS 3.1 or above');
  245.   StopAll(5);
  246. End.  { SpyTsr }