home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lan / spy / source / spysup.pas < prev    next >
Pascal/Delphi Source File  |  1989-10-03  |  4KB  |  166 lines
  1. {$A+,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V+}
  2. Unit SpySup;
  3. { SPYSUP Network Remote Opertaions.  Support unit.
  4.   This unit is:
  5.   Copyright (c) 1989 by Edwin T. Floyd
  6.   All rights reserved
  7.  
  8.   Noncommercial use encouraged; direct commercial inquires and problem reports
  9.   to the author:
  10.  
  11.   Edwin T. Floyd [76067,747]
  12.   #9 Adams Park Court
  13.   Columbus, GA 31909
  14.   404-322-0076 (home)
  15.   404-576-3305 (work)
  16. }
  17. Interface
  18. Uses NetBios, Multi, Screen;
  19.  
  20. Const
  21.   MaxReqKeys = 16;   { Maximum number of keystrokes in a single request }
  22.   MaxTableKeys = 32; { Maximum number of unprocessed keystrokes in table }
  23.   ListenRto = 30;    { SPYTSR NetListen receive timeout in half-seconds }
  24.   CallRto = 30;      { SPY NetCall receive timeout in half-seconds }
  25.   ListenSto = 30;    { SPYTSR NetListen send timeout in half-seconds }
  26.   CallSto = 30;      { SPY NetCall send timeout in half-seconds }
  27.   RetryWait = 50;    { NetWaitError waits this many sec/100 for RetryLater }
  28.  
  29. Type
  30.   TaskNctType =
  31.   { Nct with task id for NetTaskPost }
  32.   Record
  33.     Nct : NetControlType;
  34.     Task : TaskType;
  35.   End;
  36.   KeyType =
  37.   { Keystroke as stored in keytable and request }
  38.   Record
  39.     KeyChar : Char;
  40.     KeyScan : Byte;
  41.   End;
  42.   RequestType =
  43.   { Format of a NETTSR request }
  44.   Record
  45.     Req : (SendScreen, StuffKeyboard, Boot, DieQuietly, SendScreenInfo);
  46.     Count : 0..MaxReqKeys;
  47.     Key : Array[1..MaxReqKeys] Of KeyType;
  48.   End;
  49.   ScreenInfoType =
  50.   { Format of NETTSR SendScreenInfo response }
  51.   Record
  52.     ScreenType : AdapterType;
  53.     Mode : Byte;
  54.     Rows : Byte;
  55.     Cols : Byte;
  56.     ScreenSaveSize : Word;
  57.   End;
  58.  
  59. Var
  60.   { Unprocessed keystroke table }
  61.   KeyHead : 0..MaxTableKeys;
  62.   KeyTail : 0..MaxTableKeys;
  63.   KeyQueue : Array[0..MaxTableKeys] Of KeyType;
  64.  
  65. Procedure NetTaskPost(Var Nct : NetControlType);
  66. { Specify this as PostRoutine in NetSetAdapter for TaskNctType Nct }
  67.  
  68. Function NetWaitError(Var TaskNct : TaskNctType; Timeout : LongInt) : Byte;
  69. { Waits for I/O completion and returns error code or 0 if successful }
  70.  
  71. Implementation
  72.  
  73. Procedure DisableInterrupts;
  74.   { Disable 80x86/8 interrupts }
  75. Inline($FA);
  76.  
  77. Procedure EnableInterrupts;
  78. { Enable 80x86/8 interrupts }
  79. Inline($FB);
  80.  
  81. Procedure NetTaskPost(Var Nct : NetControlType);
  82. Var
  83.   TaskNct : TaskNctType Absolute Nct;
  84. Begin
  85.   Wake(TaskNct.Task);
  86. End;
  87.  
  88. Function NetWaitError(Var TaskNct : TaskNctType; Timeout : LongInt) : Byte;
  89. Var
  90.   Now : LongInt;
  91.   Done : Boolean;
  92.   RetCode : Byte;
  93.   Procedure ComputeTimeout;
  94.   Begin
  95.     Now := TimeNow - Now;
  96.     If Now > Timeout Then Timeout := 0 Else Timeout := Timeout - Now;
  97.     Now := TimeNow;
  98.   End;
  99. Begin
  100.   Now := TimeNow;
  101.   With TaskNct Do Begin
  102.     Task := MyTaskId;
  103.     Repeat
  104.       DisableInterrupts;
  105.       Done := True;
  106.       Case NetReturnAction(Nct) Of
  107.         NoAction : RetCode := NetReturn(Nct);
  108.         AwaitIo : Begin
  109.           Wait(Timeout);
  110.           RetCode := NetReturn(Nct);
  111.           EnableInterrupts;
  112.           If RetCode = $FF Then NetCancel(Nct)
  113.           Else Case NetReturnAction(Nct) Of
  114.             Retry : Begin
  115.               Wait(2);
  116.               ComputeTimeout;
  117.               If Timeout > 0 Then Begin
  118.                 NetRetry(Nct);
  119.                 Done := False;
  120.               End;
  121.             End;
  122.             RetryLater : Begin
  123.               Wait(RetryWait);
  124.               ComputeTimeout;
  125.               If Timeout > 0 Then Begin
  126.                 NetRetry(Nct);
  127.                 Done := False;
  128.               End;
  129.             End;
  130.           End;
  131.         End;
  132.         Retry : Begin
  133.           Wait(2);
  134.           ComputeTimeout;
  135.           If Timeout = 0 Then RetCode := $FF Else Begin
  136.             NetRetry(Nct);
  137.             Done := False;
  138.           End;
  139.         End;
  140.         RetryLater : Begin
  141.           Wait(RetryWait);
  142.           ComputeTimeout;
  143.           If Timeout = 0 Then RetCode := $FF Else Begin
  144.             NetRetry(Nct);
  145.             Done := False;
  146.           End;
  147.         End;
  148.         Else RetCode := NetReturn(Nct);
  149.       End;
  150.       EnableInterrupts;
  151.     Until Done;
  152.     NetWaitError := RetCode;
  153.   End;
  154. End;
  155.  
  156. Procedure NetCancelIdle(Ticks : Word);
  157. Begin
  158.   Wait(6);
  159. End;
  160.  
  161. Begin
  162.   KeyHead := 0;
  163.   KeyTail := 0;
  164.   NetIdle := NetCancelIdle;
  165. End.
  166.