Category : Pascal Source Code
Archive   : SPYSRC13.ZIP
Filename : SPYSUP.PAS

 
Output of file : SPYSUP.PAS contained in archive : SPYSRC13.ZIP
{$A+,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V+}
Unit SpySup;
{ SPYSUP Network Remote Opertaions. Support unit.
This unit is:
Copyright (c) 1989 by Edwin T. Floyd
All rights reserved

Noncommercial use encouraged; direct commercial inquires and problem reports
to the author:

Edwin T. Floyd [76067,747]
#9 Adams Park Court
Columbus, GA 31909
404-322-0076 (home)
404-576-3305 (work)
}
Interface
Uses NetBios, Multi, Screen;

Const
MaxReqKeys = 16; { Maximum number of keystrokes in a single request }
MaxTableKeys = 32; { Maximum number of unprocessed keystrokes in table }
ListenRto = 30; { SPYTSR NetListen receive timeout in half-seconds }
CallRto = 30; { SPY NetCall receive timeout in half-seconds }
ListenSto = 30; { SPYTSR NetListen send timeout in half-seconds }
CallSto = 30; { SPY NetCall send timeout in half-seconds }
RetryWait = 50; { NetWaitError waits this many sec/100 for RetryLater }

Type
TaskNctType =
{ Nct with task id for NetTaskPost }
Record
Nct : NetControlType;
Task : TaskType;
End;
KeyType =
{ Keystroke as stored in keytable and request }
Record
KeyChar : Char;
KeyScan : Byte;
End;
RequestType =
{ Format of a NETTSR request }
Record
Req : (SendScreen, StuffKeyboard, Boot, DieQuietly, SendScreenInfo);
Count : 0..MaxReqKeys;
Key : Array[1..MaxReqKeys] Of KeyType;
End;
ScreenInfoType =
{ Format of NETTSR SendScreenInfo response }
Record
ScreenType : AdapterType;
Mode : Byte;
Rows : Byte;
Cols : Byte;
ScreenSaveSize : Word;
End;

Var
{ Unprocessed keystroke table }
KeyHead : 0..MaxTableKeys;
KeyTail : 0..MaxTableKeys;
KeyQueue : Array[0..MaxTableKeys] Of KeyType;

Procedure NetTaskPost(Var Nct : NetControlType);
{ Specify this as PostRoutine in NetSetAdapter for TaskNctType Nct }

Function NetWaitError(Var TaskNct : TaskNctType; Timeout : LongInt) : Byte;
{ Waits for I/O completion and returns error code or 0 if successful }

Implementation

Procedure DisableInterrupts;
{ Disable 80x86/8 interrupts }
Inline($FA);

Procedure EnableInterrupts;
{ Enable 80x86/8 interrupts }
Inline($FB);

Procedure NetTaskPost(Var Nct : NetControlType);
Var
TaskNct : TaskNctType Absolute Nct;
Begin
Wake(TaskNct.Task);
End;

Function NetWaitError(Var TaskNct : TaskNctType; Timeout : LongInt) : Byte;
Var
Now : LongInt;
Done : Boolean;
RetCode : Byte;
Procedure ComputeTimeout;
Begin
Now := TimeNow - Now;
If Now > Timeout Then Timeout := 0 Else Timeout := Timeout - Now;
Now := TimeNow;
End;
Begin
Now := TimeNow;
With TaskNct Do Begin
Task := MyTaskId;
Repeat
DisableInterrupts;
Done := True;
Case NetReturnAction(Nct) Of
NoAction : RetCode := NetReturn(Nct);
AwaitIo : Begin
Wait(Timeout);
RetCode := NetReturn(Nct);
EnableInterrupts;
If RetCode = $FF Then NetCancel(Nct)
Else Case NetReturnAction(Nct) Of
Retry : Begin
Wait(2);
ComputeTimeout;
If Timeout > 0 Then Begin
NetRetry(Nct);
Done := False;
End;
End;
RetryLater : Begin
Wait(RetryWait);
ComputeTimeout;
If Timeout > 0 Then Begin
NetRetry(Nct);
Done := False;
End;
End;
End;
End;
Retry : Begin
Wait(2);
ComputeTimeout;
If Timeout = 0 Then RetCode := $FF Else Begin
NetRetry(Nct);
Done := False;
End;
End;
RetryLater : Begin
Wait(RetryWait);
ComputeTimeout;
If Timeout = 0 Then RetCode := $FF Else Begin
NetRetry(Nct);
Done := False;
End;
End;
Else RetCode := NetReturn(Nct);
End;
EnableInterrupts;
Until Done;
NetWaitError := RetCode;
End;
End;

Procedure NetCancelIdle(Ticks : Word);
Begin
Wait(6);
End;

Begin
KeyHead := 0;
KeyTail := 0;
NetIdle := NetCancelIdle;
End.


  3 Responses to “Category : Pascal Source Code
Archive   : SPYSRC13.ZIP
Filename : SPYSUP.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/