home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
bbs_ra
/
snxt_100.arj
/
SYSNXT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-19
|
9KB
|
283 lines
Program SysopNext;
Uses
Crt, Dos;
Const
Pgmid = 'SYSNXT v1.00 19jan91 MWBJR Enterprise 1:273/701.0 (215)641-0270';
Var
Msr : Registers;
KeyInput : Char;
ATimer, AExit, APos, CTimer, CExit, CPos, NTimer, NExit, NPos, STimer, SExit, SPos : Byte;
Beep, CapsLock, NumLock, ScrollLock : Boolean;
Count, KeyReturn : Byte;
{========================================================================}
Function UpperString(InString : String) : String;
Var
Usb : Byte;
Begin
For Usb := 1 To Length(InString) Do InString[Usb] := Upcase(InString[Usb]);
UpperString := InString;
End;
{========================================================================}
Function MyVal(InString : String) : Integer;
Var
OutVal, Result : Integer;
Begin
Val(InString,OutVal,Result);
MyVal := OutVal;
End;
{========================================================================}
Function MyStr(InNum : Integer) : String;
Var
OutString : String;
Begin
Str(InNum,OutString);
MyStr := OutString;
End;
{========================================================================}
Function KeyTimeOut(TimeToCount : Byte) : Byte;
Const
BkspString = #8+#8+#8;
Var
SecondCounter : LongInt;
TempKey : Byte;
Begin
Repeat
Write(MyStr(TimeToCount)+' '+#8+Copy(BkspString,1,Length(MyStr(TimeToCount))));
If Beep Then
Begin
Sound(500);
Delay(100);
NoSound;
End;
Delay(1000);
Dec(TimeToCount);
If TimeToCount = 0 Then
Begin
KeyTimeOut := 0;
Exit;
End;
Until KeyPressed;
TempKey := Ord(ReadKey);
If TempKey = 27 Then TempKey := 0;
KeyTimeOut := TempKey;
End;
{=======================================================================}
Procedure ParseCommandLine;
Var
Pclb : Byte;
Parm : Array[1..3] Of String;
Begin
If ParamCount = 0 Then
Begin
WriteLn;
WriteLn('SYSNXT ssskeee [ssskeee] [ssskeee]');
WriteLn(' sss = seconds to wait for timeout 0-255');
WriteLn(' k = key to activate timeout (C)apsLock (N)umLock (S)crollLock');
WriteLn(' eee = errorlevel to exit if any key is pressed 0-255');
WriteLn;
WriteLn('Example: SYSNXT 30S5 = Wait 30 seconds for any key if scroll lock is on.');
WriteLn(' If key is pressed exit with errorlevel 5.');
WriteLn;
End
Else
Begin
ATimer := 0; AExit := 0; APos := 0;
CTimer := 0; CExit := 0; CPos := 0;
NTimer := 0; NExit := 0; NPos := 0;
STimer := 0; SExit := 0; SPos := 0;
Beep := False;
For Pclb := 1 To ParamCount Do
Begin
Parm[Pclb] := ParamStr(Pclb);
If (Pos('A',Parm[Pclb]) > 0) Or
(Pos('C',Parm[Pclb]) > 0) Or
(Pos('N',Parm[Pclb]) > 0) Or
(Pos('S',Parm[Pclb]) > 0) Then Beep := True;
Parm[Pclb] := UpperString(ParamStr(Pclb));
If (Pos('A',Parm[Pclb]) > 0) Or
(Pos('C',Parm[Pclb]) > 0) Or
(Pos('N',Parm[Pclb]) > 0) Or
(Pos('S',Parm[Pclb]) > 0) Then
Begin
If Pos('A',Parm[Pclb]) > 0 Then
Begin
Apos := Pclb;
If Pos('A',Parm[Pclb]) > 1 Then
Begin
ATimer := MyVal(Copy(Parm[Pclb],1,Pos('A',Parm[Pclb])-1));
End;
If Length(Parm[Pclb]) > Pos('A',Parm[Pclb]) Then
Begin
AExit := MyVal(Copy(Parm[Pclb],Pos('A',Parm[Pclb])+1,Length(Parm[Pclb])));
End;
End;
If Pos('C',Parm[Pclb]) > 0 Then
Begin
Cpos := Pclb;
If Pos('C',Parm[Pclb]) > 1 Then
Begin
CTimer := MyVal(Copy(Parm[Pclb],1,Pos('C',Parm[Pclb])-1));
End;
If Length(Parm[Pclb]) > Pos('C',Parm[Pclb]) Then
Begin
CExit := MyVal(Copy(Parm[Pclb],Pos('C',Parm[Pclb])+1,Length(Parm[Pclb])));
End;
End;
If Pos('N',Parm[Pclb]) > 0 Then
Begin
Npos := Pclb;
If Pos('N',Parm[Pclb]) > 1 Then
Begin
NTimer := MyVal(Copy(Parm[Pclb],1,Pos('N',Parm[Pclb])-1));
End;
If Length(Parm[Pclb]) > Pos('N',Parm[Pclb]) Then
Begin
NExit := MyVal(Copy(Parm[Pclb],Pos('N',Parm[Pclb])+1,Length(Parm[Pclb])));
End;
End;
If Pos('S',Parm[Pclb]) > 0 Then
Begin
Spos := Pclb;
If Pos('S',Parm[Pclb]) > 1 Then
Begin
STimer := MyVal(Copy(Parm[Pclb],1,Pos('S',Parm[Pclb])-1));
End;
If Length(Parm[Pclb]) > Pos('S',Parm[Pclb]) Then
Begin
SExit := MyVal(Copy(Parm[Pclb],Pos('S',Parm[Pclb])+1,Length(Parm[Pclb])));
End;
End;
End;
End;
End;
End;
{========================================================================}
Procedure CheckKeys;
Begin
CapsLock := False; NumLock := False; ScrollLock := False;
Msr.Ah := $12;
Intr($16,Msr);
If (Msr.Al And 16) = 16 Then ScrollLock := True;
If (Msr.Al And 32) = 32 Then NumLock := True;
If (Msr.Al And 64) = 64 Then CapsLock := True;
End;
{========================================================================}
Procedure AllExitCheck;
Begin
If ATimer = 0 Then
Begin
WriteLn('Immediate - Exit('+MyStr(AExit)+')');
WriteLn;
Halt(AExit);
End
Else
Begin
Write('Seconds before timeout - ');
KeyReturn := KeyTimeOut(ATimer);
If KeyReturn > 0 Then
Begin
If AExit = 0 Then AExit := KeyReturn;
WriteLn('Exit('+MyStr(AExit)+')');
WriteLn;
Halt(AExit);
End
Else WriteLn('0');
End;
End;
{========================================================================}
Procedure CapsExitCheck;
Begin
If CapsLock Then
Begin
If CTimer = 0 Then
Begin
WriteLn('Caps Lock : Immediate - Exit('+MyStr(CExit)+')');
WriteLn;
Halt(CExit);
End
Else
Begin
Write('Caps Lock : Seconds before timeout - ');
KeyReturn := KeyTimeOut(CTimer);
If KeyReturn > 0 Then
Begin
If CExit = 0 Then CExit := KeyReturn;
WriteLn('Exit('+MyStr(CExit)+')');
WriteLn;
Halt(CExit);
End
Else WriteLn('0');
End;
End;
End;
{========================================================================}
Procedure NumExitCheck;
Begin
If NumLock Then
Begin
If NTimer = 0 Then
Begin
WriteLn('Num Lock : Immediate - Exit('+MyStr(NExit)+')');
WriteLn;
Halt(NExit);
End
Else
Begin
Write('Num Lock : Seconds before timeout - ');
KeyReturn := KeyTimeOut(NTimer);
If KeyReturn > 0 Then
Begin
If NExit = 0 Then NExit := KeyReturn;
WriteLn('Exit('+MyStr(NExit)+')');
WriteLn;
Halt(NExit);
End
Else WriteLn('0');
End;
End;
End;
{========================================================================}
Procedure ScrollExitCheck;
Begin
If ScrollLock Then
Begin
If STimer = 0 Then
Begin
WriteLn('Scroll Lock : Immediate - Exit('+MyStr(SExit)+')');
WriteLn;
Halt(SExit);
End
Else
Begin
Write('Scroll Lock : Seconds before timeout - ');
KeyReturn := KeyTimeOut(STimer);
If KeyReturn > 0 Then
Begin
If SExit = 0 Then SExit := KeyReturn;
WriteLn('Exit('+MyStr(SExit)+')');
WriteLn;
Halt(SExit);
End
Else WriteLn('0');
End;
End;
End;
{========================================================================}
Begin
WriteLn(Pgmid);
ParseCommandLine;
CheckKeys;
For Count := 1 to ParamCount Do
Begin
If APos = Count Then AllExitCheck;
If CPos = Count Then CapsExitCheck;
If NPos = Count Then NumExitCheck;
If SPos = Count Then ScrollExitCheck;
End;
WriteLn('Exit(0)');
WriteLn;
Halt(0);
End.
{========================================================================}