home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
lan
/
spy
/
source
/
spytsr.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-10-03
|
8KB
|
246 lines
{$A+,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V-}
{$M 4096,0,655360}
Program SpyTsr;
{ SPYTSR Network Remote Opertaions - SPY Resident portion.
This program 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)
}
Uses Tsr, Multi, MultiTsr, NetBios, SpySup, Screen, Dos;
Const
SpyVersion : String[19] = 'SPYTSR version 1.1';
Var
ScreenSave : Pointer; { Save area for screen }
ScreenSaveLen : Word; { Size of ScreenSave }
Request : RequestType; { Request from SPY }
ScreenInfo : ScreenInfoType; { SendScreenInfo response }
Adapter : Byte; { Network Adapter number }
MyNameNum : Byte; { Name number of local name }
StopSpyTsr : Boolean; { True if DieQuietly request received }
NameStatus : (NameDown, NameUp, NameConflict); { Status of name }
ListenTask : TaskType; { TaskId of Name/Listen (mainline) task }
ServerTask : TaskType; { TaskId of the Server task }
MyName : NetNameType; { Local name }
Session : Array[0..255] Of Boolean; { Active session table }
Procedure NetCheckError(Err, Lsn : Byte);
{ Check for error which would affect local name status }
Var
WakeListen : Boolean;
Begin { NetCheckError }
WakeListen := NameStatus = NameUp;
Case Err Of
$13, $15 : NameStatus := NameDown;
$19 : NameStatus := NameConflict;
Else
WakeListen := False;
Case Err Of
$08, $0A, $18 : Session[Lsn] := False;
End;
End;
If WakeListen Then Wake(ListenTask);
End; { NetCheckError }
Procedure ServerProc(p : Pointer);
{ This task receives and responds to SPY requests }
Var
i, j : Word;
BiosResetFlag : Word Absolute $0040:$0072;
ReceiveNct : TaskNctType;
Err, ReqLsn : Byte;
Begin { ServerProc }
With ReceiveNct, Request Do Begin
NetSetAdapter(Nct, Adapter, NetNoWait, NetTaskPost);
Repeat
If NameStatus = NameUp Then Begin
NetReceiveAny(Nct, MyNameNum, Request, SizeOf(Request));
Err := NetWaitError(ReceiveNct, 3000);
ReqLsn := NetLsn(Nct);
If Err = 0 Then Begin
Session[ReqLsn] := True;
If ScreenVideoMode <> BiosVideoMode Then GetBiosInfo;
Case Req Of
SendScreen : Begin
SaveScreenArea(ScreenSave^, 1, 1, ScreenCols, ScreenRows);
NetSend(Nct, ReqLsn, ScreenSave^,
ScreenSaveHeader(ScreenSave^).Size
+ SizeOf(ScreenSaveHeader));
Err := NetWaitError(ReceiveNct, 2000);
NetCheckError(Err, ReqLsn);
End;
StuffKeyboard : Begin
For i := 1 To Count Do Begin
j := KeyHead;
If j = MaxTableKeys Then j := 0 Else Inc(j);
If j <> KeyTail Then Begin
KeyQueue[KeyHead] := Key[i];
KeyHead := j;
End;
End;
End;
Boot: Begin
BiosResetFlag := $1234; { Emulate keyboard reset }
Inline($EA/$00/$00/$FF/$FF);
End;
DieQuietly : StopSpyTsr := True;
SendScreenInfo : With ScreenInfo Do Begin
ScreenType := ScreenAdapterType;
Mode := ScreenVideoMode;
Rows := ScreenRows;
Cols := ScreenCols;
ScreenSaveSize := ScreenSaveLen;
NetSend(Nct, ReqLsn, ScreenInfo, SizeOf(ScreenInfo));
Err := NetWaitError(ReceiveNct, 2000);
NetCheckError(Err, ReqLsn);
End;
End;
End Else NetCheckError(Err, ReqLsn);
End Else Wait(100);
Until StopSpyTsr;
End;
Wake(ListenTask);
Stop;
End; { ServerProc }
Procedure AwaitConnect;
{ This is the mainline task that receives control from BeginTsr. It attempts
to keep the local name up and listens for SPY calls. }
Var
ListenNct : TaskNctType;
i, Err : Byte;
Begin { AwaitConnect }
Close(Input);
Close(Output);
ListenTask := MyTaskId;
With ListenNct Do Begin
NetSetAdapter(Nct, Adapter, NetNoWait, NetTaskPost);
Repeat
Case NameStatus Of
NameDown : Begin
NetAddName(Nct, MyName);
Err := NetWaitError(ListenNct, 2000);
If (Err = 0) Or (Err = $0D) Then Begin
MyNameNum := NetNum(Nct);
NameStatus := NameUp;
End Else Begin
NetCheckError(Err, 255);
Wait(100);
End;
End;
NameUp : Begin
NetListen(Nct, '*', MyName, ListenRto, ListenSto);
Err := NetWaitError(ListenNct, 2000);
If Err = 0 Then Session[NetLsn(Nct)] := True
Else NetCheckError(Err, NetLsn(Nct));
End;
NameConflict : Begin
NetDeleteName(Nct, MyName);
Err := NetWaitError(ListenNct, 2000);
NameStatus := NameDown;
NetCheckError(Err, 255);
End;
End;
Until StopSpyTsr;
FreezeTask(ServerTask);
NetShutdown;
For i := 1 To 255 Do If Session[i] Then Begin
NetHangup(Nct, i);
Err := NetWaitError(ListenNct, 500);
Session[i] := False;
End;
NameStatus := NameDown;
NetDeleteName(Nct, MyName);
Err := NetWaitError(ListenNct, 2000);
End;
NetShutdown;
RemoveTsr;
End; { AwaitConnect }
Procedure KeyFilter(Var Key : KeyControlType);
{ KeyFilter inserts keystrokes from SPY into the local keyboard stream }
Begin { KeyFilter }
With Key Do Begin
If (Action = KeyUnavailable) Or (Action = KeySubstitute) Then Begin
If KeyHead <> KeyTail Then Begin
Action := KeyInsert;
With KeyQueue[KeyTail] Do Begin
CharCode := KeyChar;
ScanCode := KeyScan;
End;
If KeyTail = MaxTableKeys Then KeyTail := 0 Else Inc(KeyTail);
End;
End;
End;
End; { KeyFilter }
Procedure InitSpyTsr;
{ Initialize local data and interpret parameters }
Var
i, j : Integer;
s : String[2];
Begin { InitSpyTsr }
KeyHead := 0;
KeyTail := 0;
StopSpyTsr := False;
NameStatus := NameDown;
FillChar(Session, SizeOf(Session), 0);
If (ParamCount < 1) Or (ParamStr(1) = '') Then Begin
WriteLn('Run like this: SPYTSR <name>');
StopAll(1);
End Else Begin
MyName := ParamStr(1);
For i := 1 To Length(MyName) Do MyName[i] := UpCase(MyName[i]);
While Length(MyName) < 16 Do Insert(' ', MyName, Succ(Length(MyName)));
MyName[16] := #$EF;
End;
If ParamCount > 1 Then Begin
s := ParamStr(2);
Val(s, i, j);
If (i >= 0) And (i < 3) Then Adapter := i Else Begin
WriteLn('Adapter must be 0..3, "', ParamStr(2), '" specified');
StopAll(2);
End;
End Else Adapter := 0;
If Not NetAdapterPresent(Adapter) Then Begin
WriteLn('Adapter ', Adapter, ' not found');
StopAll(3);
End;
Case ScreenAdapterType Of
EGAMono, EGAColor :
ScreenSaveLen := SizeOf(ScreenSaveHeader) + 2 * 132 * 43;
VGAMono, VGAColor :
ScreenSaveLen := SizeOf(ScreenSaveHeader) + 2 * 132 * 50;
Else
ScreenSaveLen := SizeOf(ScreenSaveHeader) + 2 * 80 * 25;
End;
If CheckLoaded(SpyVersion) <> @SpyVersion Then Begin
WriteLn('SPYTSR already loaded');
StopAll(4);
End;
GetMem(ScreenSave, ScreenSaveLen);
SaveScreenArea(ScreenSave^, 1, 1, ScreenCols, ScreenRows);
SetKeyRoutine(KeyFilter);
Spawn(ServerProc, Nil, 2048, 'SERVER');
ServerTask := MRCTaskId;
End; { InitSpyTsr }
Begin { SpyTsr }
InitSpyTsr;
SetFreeHeap(40);
WriteLn(SpyVersion, ' started, program size is ',
ProgramSize, ' bytes');
BeginTsr(AwaitConnect, 0);
WriteLn('SPYTSR not installed, requires DOS 3.1 or above');
StopAll(5);
End. { SpyTsr }