1195 lines
31 KiB
Plaintext
1195 lines
31 KiB
Plaintext
{$IFDEF WIN32}
|
|
{$I DEFINES.INC}
|
|
{$ENDIF}
|
|
|
|
{$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-}
|
|
|
|
UNIT Logon;
|
|
|
|
INTERFACE
|
|
|
|
FUNCTION GetUser: Boolean;
|
|
|
|
IMPLEMENTATION
|
|
|
|
USES
|
|
Crt,
|
|
Common,
|
|
Archive1,
|
|
CUser,
|
|
Doors,
|
|
Email,
|
|
Events,
|
|
Mail0,
|
|
Mail1,
|
|
Maint,
|
|
Menus,
|
|
Menus2,
|
|
NewUsers,
|
|
ShortMsg,
|
|
SysOp2G,
|
|
TimeFunc,
|
|
MiscUser;
|
|
|
|
VAR
|
|
GotName: Boolean;
|
|
OldUser: UserRecordType;
|
|
|
|
FUNCTION Hex(i: LongInt; j: Byte): STRING;
|
|
CONST
|
|
hc : ARRAY [0..15] OF Char = '0123456789ABCDEF';
|
|
VAR
|
|
One,
|
|
Two,
|
|
Three,
|
|
Four: Byte;
|
|
BEGIN
|
|
One := (i AND $000000FF);
|
|
Two := (i AND $0000FF00) SHR 8;
|
|
Three := (i AND $00FF0000) SHR 16;
|
|
Four := (i AND $FF000000) SHR 24;
|
|
Hex[0] := chr(j); { Length of STRING = 4 or 8}
|
|
IF (j = 4) THEN
|
|
BEGIN
|
|
Hex[1] := hc[Two SHR 4];
|
|
Hex[2] := hc[Two AND $F];
|
|
Hex[3] := hc[One SHR 4];
|
|
Hex[4] := hc[One AND $F];
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
Hex[8] := hc[One AND $F];
|
|
Hex[7] := hc[One SHR 4];
|
|
Hex[6] := hc[Two AND $F];
|
|
Hex[5] := hc[Two SHR 4];
|
|
Hex[4] := hc[Three AND $F];
|
|
Hex[3] := hc[Three SHR 4];
|
|
Hex[2] := hc[Four AND $F];
|
|
Hex[1] := hc[Four SHR 4];
|
|
END;
|
|
END;
|
|
|
|
PROCEDURE IEMSI;
|
|
VAR
|
|
Tries: Byte;
|
|
T1,T2: LongInt;
|
|
Emsi_Irq: STRING[20];
|
|
Done,Success: Boolean;
|
|
S,Isi: STRING;
|
|
C: Char;
|
|
I: Integer;
|
|
Buffer: ARRAY [1..2048] OF Char;
|
|
Buffptr: Integer;
|
|
User: UserRecordType;
|
|
NextItemPointer: Integer;
|
|
|
|
FUNCTION NextItem: STRING;
|
|
VAR
|
|
S: AStr;
|
|
BEGIN
|
|
S := '';
|
|
WHILE (NextItemPointer < 2048) AND (Buffer[NextItemPointer] <> #0) AND (Buffer [NextItemPointer] <> '{') DO
|
|
Inc(NextItemPointer);
|
|
IF (Buffer[NextItemPointer] = '{') THEN
|
|
Inc(NextItemPointer);
|
|
WHILE (NextItemPointer < 2048) AND (Buffer[NextItemPointer] <> #0) AND (Buffer [NextItemPointer] <> '}') DO
|
|
BEGIN
|
|
S := S + Buffer[NextItemPointer];
|
|
Inc(NextItemPointer);
|
|
END;
|
|
IF (Buffer[NextItemPointer] = '}') THEN
|
|
Inc(NextItemPointer);
|
|
NextItem := S;
|
|
END;
|
|
|
|
BEGIN
|
|
FillChar(IEMSIRec,SizeOf(IEMSIRec),0);
|
|
IF (ComPortSpeed = 0) OR (NOT General.UseIEMSI) THEN
|
|
Exit;
|
|
(* Should this be Prompt ???
|
|
Write('Attempting IEMSI negotiation ... ');
|
|
*)
|
|
Write(RGNoteStr(21,TRUE));
|
|
FillChar(Buffer,SizeOf(Buffer),0);
|
|
T1 := Timer;
|
|
T2 := Timer;
|
|
Tries := 0;
|
|
Done := FALSE;
|
|
Success := FALSE;
|
|
Emsi_Irq := '**EMSI_IRQ8E08'^M^L;
|
|
Com_Flush_Recv;
|
|
SerialOut(Emsi_Irq);
|
|
S := '';
|
|
REPEAT
|
|
HangUp := NOT Com_Carrier;
|
|
IF (ABS(T1 - Timer) > 2) THEN
|
|
BEGIN
|
|
T1 := Timer;
|
|
Inc(Tries);
|
|
IF (Tries >= 2) THEN
|
|
Done := TRUE
|
|
ELSE
|
|
BEGIN
|
|
Com_Flush_Recv;
|
|
SerialOut(Emsi_Irq);
|
|
END;
|
|
END;
|
|
IF (ABS(T2 - Timer) >= 8) THEN
|
|
Done := TRUE;
|
|
C := Cinkey;
|
|
IF (C > #0) THEN
|
|
BEGIN
|
|
IF (Length(S) >= 160) THEN
|
|
Delete(S, 1, 120);
|
|
S := S + C;
|
|
IF (Pos('**EMSI_ICI', S) > 0) THEN
|
|
BEGIN
|
|
Delete(S,1,Pos('EMSI_ICI',S) - 1);
|
|
Move(S[1],Buffer[1],Length(S));
|
|
Buffptr := Length(S);
|
|
T1 := Timer;
|
|
REPEAT
|
|
C := Cinkey;
|
|
IF NOT (C IN [#0, #13]) THEN
|
|
BEGIN
|
|
Inc(Buffptr);
|
|
Buffer[Buffptr] := C;
|
|
END;
|
|
UNTIL (HangUp) OR (ABS(Timer - T1) > 4) OR (C = ^M) OR (Buffptr = 2048);
|
|
S [0] := #8;
|
|
Move(Buffer[Buffptr - 7],S[1],8);
|
|
Dec(Buffptr,8);
|
|
IF (S = Hex(UpdateCRC32($Ffffffff,Buffer[1],Buffptr),8)) THEN
|
|
BEGIN
|
|
LoadURec(User,1);
|
|
Isi := '{Renegade,'+General.Version+'}{'+General.BBSName+'}{'+User.CityState+
|
|
'}{'+General.SysOpName+'}{'+Hex(GetPackDateTime,8)+
|
|
'}{Live free or die!}{}{Everything!}';
|
|
Isi := 'EMSI_ISI'+ Hex(Length(Isi),4) + Isi;
|
|
Isi := Isi + Hex(UpdateCRC32($Ffffffff,Isi[1],Length(Isi)),8);
|
|
Isi := '**' + Isi + ^M;
|
|
Com_Flush_Recv;
|
|
SerialOut(Isi);
|
|
Tries := 0;
|
|
T1 := Timer;
|
|
S := '';
|
|
REPEAT
|
|
IF (ABS(Timer - T1) >= 3) THEN
|
|
BEGIN
|
|
T1 := Timer;
|
|
Inc(Tries);
|
|
Com_Flush_Recv;
|
|
SerialOut(Isi);
|
|
END;
|
|
C := Cinkey;
|
|
IF (C > #0) THEN
|
|
BEGIN
|
|
IF (Length(S) >= 160) THEN
|
|
Delete(S,1,120);
|
|
S := S + C;
|
|
IF (Pos('**EMSI_ACK', S) > 0) THEN
|
|
BEGIN
|
|
Com_Flush_Recv;
|
|
Com_Purge_Send;
|
|
Done := TRUE;
|
|
Success := TRUE;
|
|
END
|
|
ELSE IF (Pos('**EMSI_NAKEEC3',S) > 0) THEN
|
|
BEGIN
|
|
Com_Flush_Recv;
|
|
SerialOut(Isi);
|
|
Inc(Tries);
|
|
END;
|
|
END;
|
|
UNTIL (Tries >= 3) OR (Done);
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
SerialOut('**EMSI_NAKEEC3');
|
|
T1 := Timer;
|
|
END;
|
|
END;
|
|
END;
|
|
UNTIL (Done) OR (HangUp);
|
|
IF (Success) THEN
|
|
BEGIN
|
|
(* Should this be print ???
|
|
WriteLn('success.');
|
|
*)
|
|
Writeln(RGNOteStr(22,TRUE));
|
|
SL1('IEMSI negotiation Suceeded.');
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
(* Should this be print ???
|
|
WriteLn('failure.');
|
|
*)
|
|
WriteLn(RGNoteStr(23,TRUE));
|
|
SL1('IEMSI negotiation failed.');
|
|
END;
|
|
NextItemPointer := 1;
|
|
WITH IEMSIRec DO
|
|
BEGIN
|
|
UserName := NextItem;
|
|
Handle := NextItem;
|
|
CityState := NextItem;
|
|
Ph := NextItem;
|
|
S := NextItem;
|
|
Pw := AllCaps(NextItem);
|
|
I := StrToInt('$'+NextItem);
|
|
IF (I > 0) THEN
|
|
Bdate := Pd2Date(I);
|
|
END;
|
|
Com_Flush_Recv;
|
|
END;
|
|
|
|
PROCEDURE Check_Ansi;
|
|
VAR
|
|
L: LongInt;
|
|
C: Char;
|
|
Ox,x,y: Byte;
|
|
S: AStr;
|
|
|
|
PROCEDURE ANSIResponse(VAR x,y: Byte);
|
|
VAR
|
|
Xs,
|
|
Ys: STRING[4];
|
|
BEGIN
|
|
L := (Timer + 2);
|
|
C := #0;
|
|
Xs := '';
|
|
Ys := '';
|
|
x := 0;
|
|
y := 0;
|
|
WHILE (L > Timer) AND (C <> ^[) AND (NOT HangUp) DO
|
|
IF (NOT Empty) THEN
|
|
C := Com_Recv; { must be low level to avoid ansi-eater }
|
|
IF (C = ^[) THEN
|
|
BEGIN
|
|
L := (Timer + 1);
|
|
WHILE (L > Timer) AND (C <> ';') AND (NOT HangUp) DO
|
|
IF (NOT Empty) THEN
|
|
BEGIN
|
|
C := Com_Recv;
|
|
IF (C IN ['0'..'9']) AND (Length(Ys) < 4) THEN
|
|
Ys := Ys + C;
|
|
END;
|
|
L := (Timer + 1);
|
|
WHILE (L > Timer) AND (C <> 'R') AND (NOT HangUp) DO
|
|
IF (NOT Empty) THEN
|
|
BEGIN
|
|
C := Com_Recv;
|
|
IF (C IN ['0'..'9']) AND (Length(Xs) < 4) THEN
|
|
Xs := Xs + C;
|
|
END;
|
|
x := StrToInt(Xs);
|
|
y := StrToInt(Ys);
|
|
END;
|
|
END;
|
|
|
|
BEGIN
|
|
TextAttr := 10;
|
|
(* Should this be Prompt ???
|
|
Write('Attempting to detect emulation ... ');
|
|
*)
|
|
Write(RGNoteStr(24,TRUE));
|
|
Exclude(ThisUser.Flags,Avatar);
|
|
Exclude(ThisUser.Flags,Ansi);
|
|
Exclude(ThisUser.Flags,Vt100);
|
|
Exclude(ThisUser.SFlags,Rip);
|
|
IF (ComPortSpeed = 0) THEN
|
|
BEGIN
|
|
Include(ThisUser.Flags,Ansi);
|
|
Exit;
|
|
END;
|
|
Com_Flush_Recv;
|
|
SerialOut(^M^M^['[!'#8#8#8);
|
|
L := (Timer + 2);
|
|
C := #0;
|
|
S := '';
|
|
WHILE (L > Timer) AND (C <> 'R') AND (NOT HangUp) DO IF (NOT Empty) THEN
|
|
C := Com_Recv;
|
|
IF (C = 'R') THEN
|
|
BEGIN
|
|
L := (Ticks + 3);
|
|
WHILE (NOT Empty) AND (Ticks < L) DO;
|
|
C := Com_Recv;
|
|
IF (C = 'I') THEN
|
|
BEGIN
|
|
L := (Ticks + 3);
|
|
WHILE (NOT Empty) AND (Ticks < L) DO;
|
|
C := Com_Recv;
|
|
IF (C = 'P') THEN
|
|
BEGIN
|
|
Include(ThisUser.SFlags,Rip);
|
|
S := RGNoteStr(25,TRUE); {'RIP'}
|
|
END;
|
|
END;
|
|
Com_Flush_Recv;
|
|
END;
|
|
SerialOut(^M^M^['[6n'#8#8#8#8);
|
|
ANSIResponse(x,y);
|
|
IF (x + y > 0) THEN
|
|
BEGIN
|
|
Include(ThisUser.Flags,Ansi);
|
|
ANSIDetected := TRUE;
|
|
IF (S <> '') THEN
|
|
S := S + RGNoteStr(26,TRUE) {'/Ansi'}
|
|
ELSE
|
|
S := RGNoteStr(27,TRUE); {'Ansi'}
|
|
SerialOut(^V^F);
|
|
SerialOut(^['[6n'#8#8);
|
|
Ox := x;
|
|
ANSIResponse(x,y);
|
|
IF (x = Ox + 1) THEN
|
|
BEGIN
|
|
Include(ThisUser.Flags,Avatar);
|
|
IF (S <> '') THEN
|
|
S := S + RGNoteStr(28,TRUE) {'/Avatar'}
|
|
ELSE
|
|
S := RGNoteStr(29,TRUE); {'Avatar'}
|
|
END
|
|
ELSE
|
|
SerialOut(#8#8);
|
|
END;
|
|
IF (S <> '') THEN
|
|
Print('|10'+S+RGNoteStr(30,TRUE)) {' detected.'}
|
|
ELSE
|
|
BEGIN
|
|
TextAttr := 7;
|
|
{ Should this be Print ??? }
|
|
WriteLn;
|
|
END;
|
|
END;
|
|
|
|
PROCEDURE GetPWS(VAR Ok: Boolean; VAR Tries: Integer); (* Tries should be Byte *)
|
|
VAR
|
|
MHeader: MHeaderRec;
|
|
S: AStr;
|
|
PhonePW: STR4;
|
|
Birthday: Str10;
|
|
UserPW,
|
|
SysOpPW: Str20;
|
|
ForgotPW: Str40;
|
|
BEGIN
|
|
Ok := TRUE;
|
|
IF (NOT (FastLogon AND (NOT General.LocalSec))) THEN
|
|
BEGIN
|
|
IF (IEMSIRec.Pw = '') THEN
|
|
BEGIN
|
|
(*
|
|
Prompt(FString.Yourpassword);
|
|
*)
|
|
RGMainStr(3,FALSE);
|
|
GetPassword(UserPw,20);
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
UserPW := IEMSIRec.Pw;
|
|
IEMSIRec.Pw := '';
|
|
END;
|
|
IF (General.Phonepw) THEN
|
|
IF (IEMSIRec.Ph = '') THEN
|
|
BEGIN
|
|
(*
|
|
Prompt(FString.YourPhoneNumber);
|
|
*)
|
|
RGMainStr(4,FALSE);
|
|
GetPassword(PhonePW,4);
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
PhonePW := Copy(IEMSIRec.Ph,Length(IEMSIRec.Ph) - 3,4);
|
|
IEMSIRec.Ph := '';
|
|
END
|
|
ELSE
|
|
PhonePW := Copy(ThisUser.Ph,Length(ThisUser.Ph) - 3,4);
|
|
END;
|
|
IF (NOT (FastLogon AND (NOT General.LocalSec))) AND ((ThisUser.Pw <> Crc32(UserPW)) OR
|
|
(Copy(ThisUser.Ph,Length(ThisUser.Ph) - 3,4) <> PhonePW)) THEN
|
|
BEGIN
|
|
ok := FALSE;
|
|
(*
|
|
Prompt(FString.ILogon);
|
|
*)
|
|
RGNoteStr(9,FALSE);
|
|
IF (NOT HangUp) AND (UserNum <> 0) THEN
|
|
BEGIN
|
|
S := '* Illegal logon attempt! Tried: '+Caps(ThisUser.Name)+' #'+IntToStr(UserNum)+' PW='+UserPw;
|
|
IF (General.Phonepw) THEN
|
|
S := S + ', PH#='+PhonePW;
|
|
SendShortMessage(1,S);
|
|
SL1(S);
|
|
END;
|
|
Inc(ThisUser.Illegal);
|
|
IF (UserNum <> - 1) THEN
|
|
SaveURec(ThisUser,UserNum);
|
|
Inc(Tries);
|
|
IF (Tries >= General.MaxLogonTries) THEN
|
|
BEGIN
|
|
IF (General.NewUserToggles[20] = 0) OR (RGMainStr(6, TRUE) = '')
|
|
{(General.ForgotPWQuestion = '')} OR (ThisUser.ForgotPWAnswer = '') THEN
|
|
HangUp := TRUE
|
|
ELSE
|
|
BEGIN
|
|
(*
|
|
Print('|03Please answer the following question to logon to the BBS.');
|
|
Print('|03'+General.ForgotPWQuestion);
|
|
Prt(': ');
|
|
*)
|
|
RGMainStr(6,FALSE);
|
|
MPL(40);
|
|
Input(ForgotPW,40);
|
|
IF (ForgotPW <> ThisUser.ForgotPWAnswer) THEN
|
|
BEGIN
|
|
S := '* Invalid forgot password response: '+ForgotPW;
|
|
SL1(S);
|
|
SendShortMessage(1,S);
|
|
HangUp := TRUE
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
S := '* Entered correct forgot password response.';
|
|
SL1(S);
|
|
SendShortMessage(1,S);
|
|
CStuff(9,1,ThisUser);
|
|
ok := TRUE;
|
|
Tries := 0;
|
|
END;
|
|
END;
|
|
END;
|
|
END;
|
|
IF (Ok) THEN
|
|
lStatus_Screen(General.Curwindow,'',FALSE,S);
|
|
IF ((AACS(General.Spw)) AND (Ok) AND (InCom) AND (NOT HangUp)) THEN
|
|
BEGIN
|
|
(*
|
|
Prompt(FString.SysOpPrompt);
|
|
*)
|
|
RGMainStr(5,FALSE);
|
|
GetPassword(SysOpPW,20);
|
|
IF (SysOpPW <> General.SysOpPW) THEN
|
|
BEGIN
|
|
(*
|
|
Prompt(FString.ILogon);
|
|
*)
|
|
RGNoteStr(9,FALSE);
|
|
SL1('* Illegal System password: '+SysOpPw);
|
|
Inc(Tries);
|
|
IF (Tries >= General.MaxLogonTries) THEN
|
|
HangUp := TRUE;
|
|
Ok := FALSE;
|
|
END;
|
|
END;
|
|
IF (Ok) AND NOT (AACS(Liner.LogonACS)) THEN
|
|
BEGIN
|
|
PrintF('NONODE');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You don''t have the required ACS to logon to this node!');
|
|
*)
|
|
RGNoteStr(10,FALSE);
|
|
SysOpLog(ThisUser.Name+': Attempt to logon node '+IntToStr(ThisNode)+' without access.');
|
|
HangUp := TRUE;
|
|
END;
|
|
IF ((Ok) AND (General.ShuttleLog) AND (LockedOut IN ThisUser.SFlags)) THEN
|
|
BEGIN
|
|
PrintF(ThisUser.LockedFile);
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You have been locked out of the BBS by the SysOp.');
|
|
*)
|
|
RGNoteStr(11,FALSE);
|
|
SysOpLog(ThisUser.Name+': Attempt to access system when locked out^7 <--');
|
|
HangUp := TRUE;
|
|
END;
|
|
IF (UserNum > 0) AND (Onnode(UserNum) > 0) AND NOT (Cosysop) THEN
|
|
BEGIN
|
|
PrintF('MULTILOG');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You are already logged in on another node!');
|
|
*)
|
|
RGNoteStr(12,FALSE);
|
|
HangUp := TRUE;
|
|
END;
|
|
IF (NOT FastLogon) AND (Ok) AND (NOT HangUp) AND (General.Birthdatecheck > 0) AND
|
|
(ThisUser.LoggedOn MOD General.Birthdatecheck = 0) THEN
|
|
BEGIN
|
|
(*
|
|
Prt('Please verify your date of birth (mm/dd/yyyy): ');
|
|
*)
|
|
RGMainStr(7,FALSE);
|
|
Inputformatted('',Birthday,'##/##/####',FALSE);
|
|
IF (Date2Pd(Birthday) <> ThisUser.Birthdate) THEN
|
|
BEGIN
|
|
Dec(ThisUser.LoggedOn);
|
|
PrintF('WRNGBDAY');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You entered an incorrect birthdate.');
|
|
*)
|
|
RGNoteStr(13,FALSE);
|
|
SL1('*'+ThisUser.Name+' Failed birthday verification. Tried = '+Birthday+' Actual = '+Pd2Date(ThisUser.Birthdate));
|
|
SendShortMessage(1,ThisUser.Name+' failed birthday verification on '+DateStr);
|
|
InResponseTo := '\'#1'Failed birthdate check';
|
|
MHeader.Status := [];
|
|
SeMail(1,MHeader);
|
|
HangUp := TRUE;
|
|
END;
|
|
END;
|
|
UserOn := Ok;
|
|
END;
|
|
|
|
PROCEDURE TryIEMSILogon;
|
|
VAR
|
|
I, Zz: Integer;
|
|
Ok: Boolean;
|
|
BEGIN
|
|
IF (IEMSIRec.UserName <> '') THEN
|
|
BEGIN
|
|
I := SearchUser(IEMSIRec.UserName,TRUE);
|
|
IF (I = 0) AND (IEMSIRec.Handle <> '') THEN
|
|
I := SearchUser(IEMSIRec.Handle,TRUE);
|
|
IF (I > 0) THEN
|
|
BEGIN
|
|
Zz := UserNum;
|
|
UserNum := 0;
|
|
OldUser := ThisUser;
|
|
LoadURec(ThisUser,I);
|
|
UserNum := Zz;
|
|
GetPWS(Ok,Zz);
|
|
GotName := Ok;
|
|
IF (NOT GotName) THEN
|
|
BEGIN
|
|
ThisUser := OldUser;
|
|
Update_Screen;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
UserNum := I;
|
|
IF (Pd2Date(ThisUser.LastOn) <> DateStr) THEN
|
|
WITH ThisUser DO
|
|
BEGIN
|
|
OnToday := 0;
|
|
TLToday := General.TimeAllow[SL];
|
|
TimeBankAdd := 0;
|
|
DLToday := 0;
|
|
DLKToday := 0;
|
|
TimeBankWith := 0;
|
|
END;
|
|
UserOn := TRUE;
|
|
Update_Screen;
|
|
SysOpLog('Logged in IEMSI as '+Caps(ThisUser.Name));
|
|
END;
|
|
END
|
|
ELSE
|
|
(*
|
|
Print(FString.NameNotFound);
|
|
*)
|
|
RGNoteStr(8,FALSE);
|
|
|
|
END;
|
|
END;
|
|
|
|
PROCEDURE Doshuttle;
|
|
VAR
|
|
Cmd,NewMenuCmd: AStr;
|
|
SaveMenu,
|
|
CmdToExec: Byte;
|
|
Tries,
|
|
RecNum,
|
|
RecNum1,
|
|
I: Integer;
|
|
Done,Loggedon,Ok,CmdNotHid,CmdExists: Boolean;
|
|
BEGIN
|
|
PrintF('PRESHUTL');
|
|
GotName := FALSE;
|
|
Loggedon := FALSE;
|
|
TryIEMSILogon;
|
|
SaveMenu := CurMenu;
|
|
CurMenu := General.ShuttleLogonMenu;
|
|
LoadMenu;
|
|
AutoExecCmd('FIRSTCMD');
|
|
Tries := 0;
|
|
Curhelplevel := 2;
|
|
REPEAT
|
|
TSHuttleLogon := 0;
|
|
MainMenuHandle(Cmd);
|
|
NewMenuCmd:= '';
|
|
CmdToExec := 0;
|
|
Done := FALSE;
|
|
REPEAT
|
|
FCmd(Cmd,CmdToExec,CmdExists,CmdNotHid);
|
|
IF (CmdToExec <> 0) THEN
|
|
IF (MemCmd^[CmdToExec].Cmdkeys <> 'OP') AND (MemCmd^[CmdToExec].Cmdkeys <> 'O2') AND
|
|
(MemCmd^[CmdToExec].Cmdkeys[1] <> 'H') AND (MemCmd^[CmdToExec].Cmdkeys[1] <> '-') AND
|
|
(NOT GotName) THEN
|
|
BEGIN
|
|
(*
|
|
Prompt(FString.Shuttleprompt);
|
|
*)
|
|
RGMainStr(9,FALSE);
|
|
FindUser(UserNum);
|
|
IF (UserNum >= 1) THEN
|
|
BEGIN
|
|
I := UserNum;
|
|
UserNum := 0;
|
|
OldUser := ThisUser;
|
|
LoadURec(ThisUser,I);
|
|
UserNum := I;
|
|
GetPWS(Ok,Tries);
|
|
GotName := Ok;
|
|
IF (NOT GotName) THEN
|
|
BEGIN
|
|
ThisUser := OldUser;
|
|
Update_Screen;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
IF (Pd2Date(ThisUser.LastOn) <> DateStr) THEN
|
|
WITH ThisUser DO
|
|
BEGIN
|
|
OnToday := 0;
|
|
TLToday := General.TimeAllow[SL];
|
|
TimeBankAdd := 0;
|
|
DLToday := 0;
|
|
DLKToday := 0;
|
|
TimeBankWith := 0;
|
|
END;
|
|
UserOn := TRUE;
|
|
Update_Screen;
|
|
SysOpLog('Logged on to Shuttle Menu as '+Caps(ThisUser.Name));
|
|
DoMenuCommand(Done,
|
|
MemCmd^[CmdToExec].Cmdkeys,
|
|
MemCmd^[CmdToExec].Options,
|
|
NewMenuCmd,
|
|
MemCmd^[CmdToExec].NodeActivityDesc);
|
|
END;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
(*
|
|
Print(FString.ILogon);
|
|
*)
|
|
RGNoteStr(9,FALSE);
|
|
Inc(Tries);
|
|
END;
|
|
END
|
|
ELSE
|
|
DoMenuCommand(Done,
|
|
MemCmd^[CmdToExec].Cmdkeys,
|
|
MemCmd^[CmdToExec].Options,
|
|
NewMenuCmd,
|
|
MemCmd^[CmdToExec].NodeActivityDesc);
|
|
UNTIL (CmdToExec = 0) OR (Done);
|
|
CASE TSHuttleLogon OF
|
|
1 : BEGIN
|
|
|
|
Reset(ValidationFile);
|
|
RecNum1 := -1;
|
|
RecNum := 1;
|
|
WHILE (RecNum <= NumValKeys) AND (RecNum1 = -1) DO
|
|
BEGIN
|
|
Seek(ValidationFile,(RecNum - 1));
|
|
Read(ValidationFile,Validation);
|
|
IF (Validation.Key = '!') THEN
|
|
RecNum1 := RecNum;
|
|
Inc(RecNum);
|
|
END;
|
|
Close(ValidationFile);
|
|
|
|
IF (RecNum1 <> -1) AND (ThisUser.SL > Validation.NewSL) THEN
|
|
Loggedon := TRUE
|
|
ELSE
|
|
BEGIN
|
|
PrintF('NOSHUTT');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You have not been validated yet.');
|
|
*)
|
|
RGNoteStr(31,FALSE);
|
|
SL1('* Illegal Shuttle Logon attempt');
|
|
Inc(Tries);
|
|
END;
|
|
|
|
END;
|
|
2 : BEGIN
|
|
IF (NOT General.ClosedSystem) AND PYNQ(RGMainStr(2,TRUE){FString.LogonAsNew},0,FALSE) THEN
|
|
BEGIN
|
|
NewUserInit;
|
|
NewUser;
|
|
IF (UserNum > 0) AND (NOT HangUp) THEN
|
|
BEGIN
|
|
GotName := TRUE;
|
|
UserOn := TRUE;
|
|
DailyMaint;
|
|
END;
|
|
CurMenu := General.ShuttleLogonMenu;
|
|
LoadMenu;
|
|
END;
|
|
END;
|
|
END;
|
|
IF (Tries >= General.MaxLogonTries) THEN
|
|
HangUp := TRUE;
|
|
UNTIL (Loggedon) OR (HangUp);
|
|
CurMenu := SaveMenu;
|
|
NewMenuToLoad := TRUE;
|
|
END;
|
|
|
|
FUNCTION GetUser: Boolean;
|
|
VAR
|
|
User: UserRecordType;
|
|
MHeader: MHeaderRec;
|
|
Pw,
|
|
S,
|
|
ACSReq: AStr;
|
|
OverridePW: Str20;
|
|
Lng: SmallInt;
|
|
Tries,
|
|
I,
|
|
TTimes,
|
|
Zz,
|
|
EventNum: Integer; (* Tries/TTimes should be Byte, may NOT need TTimes *)
|
|
Done,
|
|
Nu,
|
|
Ok,
|
|
TooMuch,
|
|
ACSUser: Boolean;
|
|
BEGIN
|
|
WasNewUser := FALSE;
|
|
UserNum := -1;
|
|
LoadURec(ThisUser,0);
|
|
TimeOn := GetPackDateTime;
|
|
ChatChannel := 0;
|
|
Update_Node(RGNoteStr(35,TRUE){ Logging on },TRUE); (* New *)
|
|
|
|
LoadNode(ThisNode); (* New *)
|
|
NodeR.GroupChat := FALSE;
|
|
SaveNode(ThisNode);
|
|
|
|
CreditsLastUpdated := GetPackDateTime;
|
|
|
|
PublicReadThisCall := 0;
|
|
|
|
ExtraTime := 0;
|
|
FreeTime := 0;
|
|
ChopTime := 0;
|
|
CreditTime := 0;
|
|
|
|
SL1('');
|
|
|
|
S := '^3Logon node '+IntToStr(ThisNode)+'^5 ['+Dat+']^4 (';
|
|
IF (ComPortSpeed > 0) THEN
|
|
BEGIN
|
|
S := S + IntToStr(ActualSpeed)+' baud';
|
|
IF (Reliable) THEN
|
|
S := S + '/Reliable)'
|
|
ELSE
|
|
S := S + ')';
|
|
IF (CallerIDNumber > '') THEN
|
|
BEGIN
|
|
IF (NOT Telnet) THEN
|
|
S := S + ' Number: '+CallerIDNumber
|
|
ELSE
|
|
S := S + ' IP Number: '+CallerIDNumber;
|
|
END;
|
|
END
|
|
ELSE
|
|
S := S + 'Keyboard)';
|
|
SL1(S);
|
|
|
|
Nu := FALSE;
|
|
Pw := '';
|
|
|
|
IF (ActualSpeed < General.MinimumBaud) AND (ComPortSpeed > 0) THEN
|
|
BEGIN
|
|
IF ((General.MinBaudHiTime - General.MinBaudLowTime) > 1430) THEN
|
|
BEGIN
|
|
IF (General.MinBaudOverride <> '') THEN
|
|
BEGIN
|
|
(*
|
|
Prt('Baud rate override password: ');
|
|
*)
|
|
RGMainStr(0,FALSE);
|
|
GetPassword(OverridePW,20);
|
|
END;
|
|
IF (General.MinBaudOverride = '') OR (OverRidePW <> General.MinBaudOverride) THEN
|
|
BEGIN
|
|
PrintF('NOBAUD.ASC');
|
|
IF (NoFile) THEN
|
|
RGNoteStr(3,FALSE);
|
|
(*
|
|
Print('You must be using at least '+IntToStr(General.MinimumBaud)+' baud to call this BBS.');
|
|
*)
|
|
HangUp := TRUE;
|
|
Exit;
|
|
END;
|
|
END
|
|
ELSE IF (NOT InTime(Timer,General.MinBaudLowTime,General.MinBaudHiTime)) THEN
|
|
BEGIN
|
|
IF (General.MinBaudOverride <> '') THEN
|
|
BEGIN
|
|
(*
|
|
Prt('Baud rate override password: ');
|
|
*)
|
|
RGMainStr(0,FALSE);
|
|
GetPassword(OverridePW,20);
|
|
END;
|
|
IF (General.MinBaudOverride = '') OR (OverridePW <> General.MinBaudOverride) THEN
|
|
BEGIN
|
|
PrintF('NOBAUDH.ASC');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('Hours for those using less than '+IntToStr(General.MinimumBaud)+' baud are from '+
|
|
Ctim(General.MinBaudLowTime)+' to '+Ctim(General.MinBaudHiTime));
|
|
*)
|
|
RGNoteStr(4,FALSE);
|
|
HangUp := TRUE;
|
|
Exit;
|
|
END;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
IF (NOT HangUp) THEN
|
|
IF ((General.MinBaudLowTime <> 0) OR (General.MinBaudHiTime <> 0)) THEN
|
|
BEGIN
|
|
PrintF('YESBAUDH.ASC');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('NOTE: Callers at less than '+IntToStr(General.MinimumBaud)+' baud are');
|
|
Print('restricted to the following hours ONLY:');
|
|
Print(' '+Ctim(General.MinBaudLowTime)+' to '+Ctim(General.MinBaudHiTime));
|
|
*)
|
|
RGNoteStr(5,FALSE);
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
ACSUser := FALSE;
|
|
FOR I := 1 TO NumEvents DO
|
|
WITH MemEventArray[I]^ DO
|
|
IF ((EventIsActive IN EFlags) AND (EventIsLogon IN EFlags) AND (CheckEventTime(I,0))) THEN
|
|
BEGIN
|
|
ACSUser := TRUE;
|
|
ACSReq := MemEventArray[I]^.EventACS;
|
|
EventNum := I;
|
|
END;
|
|
|
|
Check_Ansi;
|
|
IEMSI;
|
|
GotName := FALSE;
|
|
IF ((General.ShuttleLog) AND (NOT FastLogon) AND (NOT HangUp)) THEN
|
|
Doshuttle;
|
|
Setc(7);
|
|
CLS;
|
|
Print(Centre(VerLine(1)));
|
|
Print(Centre(VerLine(2)));
|
|
Print(Centre(VerLine(3)));
|
|
PrintF('PRELOGON');
|
|
IF (ACSUser) THEN
|
|
BEGIN
|
|
PrintF('ACSEA'+IntToStr(EventNum));
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('Restricted: Only certain users allowed online at this time.');
|
|
*)
|
|
RGNoteStr(6,FALSE);
|
|
END;
|
|
IF (NOT GotName) THEN
|
|
TryIEMSILogon;
|
|
TTimes := 0;
|
|
Tries := 0;
|
|
REPEAT
|
|
REPEAT
|
|
IF (UserNum <> - 1) AND (TTimes >= General.MaxLogonTries) THEN
|
|
HangUp := TRUE;
|
|
OldUser := ThisUser;
|
|
IF (NOT GotName) THEN
|
|
BEGIN
|
|
(*
|
|
IF (FString.Note[1] <> '') THEN
|
|
Print(FString.Note[1]);
|
|
IF (FString.Note[2] <> '') THEN
|
|
Print(FString.Note[2]);
|
|
IF (FString.Lprompt <> '') THEN
|
|
Prompt(FString.Lprompt);
|
|
*)
|
|
RGMainStr(1,FALSE);
|
|
FindUser(UserNum);
|
|
Inc(TTimes);
|
|
IF (ACSUser) AND (UserNum = -1) THEN
|
|
BEGIN
|
|
PrintF('ACSEB'+IntToStr(EventNum));
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('This time window allows certain other users to get online.');
|
|
Print('Please call back later, after it has ended.');
|
|
*)
|
|
RGNoteStr(7,FALSE);
|
|
HangUp := TRUE;
|
|
END;
|
|
IF (NOT HangUp) AND (UserNum = 0) THEN
|
|
BEGIN
|
|
PrintF('LOGERR');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('Name not found in user list.');
|
|
*)
|
|
RGNoteStr(8,FALSE);
|
|
IF NOT (General.ShuttleLog) AND (NOT General.ClosedSystem) THEN
|
|
IF PYNQ(RGMainStr(2,TRUE){FString.LogonAsNew},0,FALSE) THEN
|
|
UserNum := -1;
|
|
END;
|
|
END;
|
|
UNTIL (UserNum <> 0) OR (HangUp);
|
|
IF (ACSUser) AND (UserNum = -1) THEN
|
|
BEGIN
|
|
PrintF('ACSEB'+IntToStr(EventNum));
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('This time window allows certain other users to get online.');
|
|
Print('Please call back later, after it has ended.');
|
|
*)
|
|
RGNoteStr(7,FALSE);
|
|
HangUp := TRUE;
|
|
END;
|
|
Ok := TRUE;
|
|
Done := FALSE;
|
|
IF (NOT HangUp) THEN
|
|
BEGIN
|
|
IF (UserNum = -1) THEN
|
|
BEGIN
|
|
NewUserInit;
|
|
Nu := TRUE;
|
|
Done := TRUE;
|
|
Ok := FALSE;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
I := UserNum;
|
|
UserNum := 0;
|
|
LoadURec(ThisUser,I);
|
|
UserNum := I;
|
|
TempPause := (Pause IN ThisUser.Flags);
|
|
NewFileDate := ThisUser.LastOn;
|
|
MsgArea := ThisUser.LastMsgArea;
|
|
FileArea := ThisUser.LastFileArea;
|
|
IF (AutoDetect IN ThisUser.SFlags) THEN
|
|
BEGIN
|
|
IF (Rip IN OldUser.SFlags) THEN
|
|
Include(ThisUser.SFlags,Rip)
|
|
ELSE
|
|
Exclude(ThisUser.SFlags,Rip);
|
|
IF (Ansi IN OldUser.Flags) THEN
|
|
Include(ThisUser.Flags,Ansi)
|
|
ELSE
|
|
Exclude(ThisUser.Flags,Ansi);
|
|
IF (Avatar IN OldUser.Flags) THEN
|
|
Include(ThisUser.Flags,Avatar)
|
|
ELSE
|
|
Exclude(ThisUser.Flags,Avatar);
|
|
END;
|
|
IF (Pd2Date(ThisUser.LastOn) <> DateStr) THEN
|
|
WITH ThisUser DO
|
|
BEGIN
|
|
OnToday := 0;
|
|
TLToday := General.TimeAllow[SL];
|
|
TimeBankAdd := 0;
|
|
DLToday := 0;
|
|
DLKToday := 0;
|
|
TimeBankWith := 0;
|
|
END
|
|
ELSE IF (General.PerCall) THEN
|
|
ThisUser.TLToday := General.TimeAllow[ThisUser.SL];
|
|
|
|
IF (ThisUser.Expiration > 0) AND
|
|
(ThisUser.Expiration <= GetPackDateTime) AND
|
|
(ThisUser.ExpireTo IN ['!'..'~']) THEN
|
|
BEGIN
|
|
SysOpLog('Subscription expired to level: "'+ThisUser.ExpireTo+'".');
|
|
AutoValidate(ThisUser,UserNum,ThisUser.ExpireTo);
|
|
END;
|
|
|
|
IF (CallerIDNumber <> '') THEN
|
|
ThisUser.CallerID := CallerIDNumber;
|
|
SaveURec(ThisUser,UserNum);
|
|
IF (NOT GotName) THEN
|
|
GetPWS(Ok,Tries);
|
|
IF (Ok) THEN
|
|
Done := TRUE;
|
|
IF (NOT Done) THEN
|
|
BEGIN
|
|
ThisUser := OldUser;
|
|
UserNum := 0;
|
|
Update_Screen;
|
|
END;
|
|
END;
|
|
END;
|
|
UNTIL ((Done) OR (HangUp));
|
|
Reset(SchemeFile);
|
|
IF (ThisUser.ColorScheme > 0) AND (ThisUser.ColorScheme <= FileSize(SchemeFile) ) THEN
|
|
Seek(SchemeFile,ThisUser.ColorScheme - 1)
|
|
ELSE
|
|
ThisUser.ColorScheme := 1;
|
|
Read(SchemeFile,Scheme);
|
|
Close(SchemeFile);
|
|
IF (ACSUser) AND NOT (AACS(ACSReq)) THEN
|
|
BEGIN
|
|
PrintF('ACSEB'+IntToStr(EventNum));
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('This time window allows certain other users to get online.');
|
|
Print('Please call back later, after it has ended.');
|
|
*)
|
|
RGNoteStr(7,FALSE);
|
|
HangUp := TRUE;
|
|
END;
|
|
IF NOT (AACS(Liner.LogonACS)) AND (NOT HangUp) THEN
|
|
BEGIN
|
|
PrintF('NONODE');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You don''t have the required ACS to logon to this node!');
|
|
*)
|
|
RGNoteStr(10,FALSE);
|
|
SysOpLog(ThisUser.Name+': Attempt to logon node '+IntToStr(ThisNode)+' without access.');
|
|
HangUp := TRUE;
|
|
END;
|
|
IF ((LockedOut IN ThisUser.SFlags) AND (NOT HangUp)) THEN
|
|
BEGIN
|
|
PrintF(ThisUser.LockedFile);
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You have been locked out of the BBS by the SysOp.');
|
|
*)
|
|
RGNoteStr(11,FALSE);
|
|
SysOpLog(ThisUser.Name+': Attempt to access system when locked out^7 <--');
|
|
HangUp := TRUE;
|
|
END;
|
|
IF ((NOT Nu) AND (NOT HangUp)) THEN
|
|
BEGIN
|
|
TooMuch := FALSE;
|
|
IF (Accountbalance < General.Creditminute) AND (General.Creditminute > 0) AND
|
|
NOT (FNoCredits IN ThisUser.Flags) THEN
|
|
BEGIN
|
|
PrintF('NOCREDTS');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You have insufficient credits for online time.');
|
|
*)
|
|
RGNoteStr(14,FALSE);
|
|
SysOpLog(ThisUser.Name+': insufficient credits for logon.');
|
|
IF (General.CreditFreeTime < 1) THEN
|
|
HangUp := TRUE
|
|
ELSE
|
|
BEGIN
|
|
ThisUser.TLToday := General.CreditFreeTime DIV General.Creditminute;
|
|
Inc(ThisUser.lCredit,General.CreditFreeTime);
|
|
END;
|
|
END
|
|
ELSE IF (((Rlogon IN ThisUser.Flags) OR (General.CallAllow[ThisUser.SL] = 1)) AND
|
|
(ThisUser.OnToday >= 1) AND (Pd2Date(ThisUser.LastOn) = DateStr)) THEN
|
|
BEGIN
|
|
PrintF('2MANYCAL');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You can only log on once per day.');
|
|
*)
|
|
RGNoteStr(15,FALSE);
|
|
TooMuch := TRUE;
|
|
END
|
|
ELSE IF ((ThisUser.OnToday >= General.CallAllow[ThisUser.SL]) AND
|
|
(Pd2Date(ThisUser.LastOn) = DateStr)) THEN
|
|
BEGIN
|
|
PrintF('2MANYCAL');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Print('You can only log on '+IntToStr(General.CallAllow[ThisUser.SL])+' times per day.');
|
|
*)
|
|
RGNoteStr(16,FALSE);
|
|
TooMuch := TRUE;
|
|
END
|
|
ELSE IF (ThisUser.TLToday <= 0) AND NOT (General.PerCall) THEN
|
|
BEGIN
|
|
PrintF('NOTLEFTA');
|
|
IF (NoFile) THEN
|
|
(*
|
|
Prompt('You can only log on for '+IntToStr(General.TimeAllow[ThisUser.SL])+' minutes per day.');
|
|
*)
|
|
RGNoteStr(17,FALSE);
|
|
TooMuch := TRUE;
|
|
IF (ThisUser.TimeBank > 0) THEN
|
|
BEGIN
|
|
(*
|
|
Print('^5However, you have '+IntToStr(ThisUser.TimeBank)+' minutes left in your Time Bank.');
|
|
*)
|
|
RGNoteStr(18,FALSE);
|
|
IF PYNQ(RGMainStr(8,TRUE){'Withdraw from Time Bank? '},0,TRUE) THEN
|
|
BEGIN
|
|
InputIntegerWOC('Withdraw how many minutes',Lng,[NumbersOnly],1,32767);
|
|
BEGIN
|
|
IF (Lng > ThisUser.TimeBank) THEN
|
|
Lng := ThisUser.TimeBank;
|
|
Dec(ThisUser.TimeBankAdd,Lng);
|
|
IF (ThisUser.TimeBankAdd < 0) THEN
|
|
ThisUser.TimeBankAdd := 0;
|
|
Dec(ThisUser.TimeBank,Lng);
|
|
Inc(ThisUser.TLToday,Lng);
|
|
(*
|
|
Print('^5In your account: ^3'+IntToStr(ThisUser.TimeBank)+'^5 Time left online: ^3'+Formattedtime(NSL));
|
|
*)
|
|
RGNoteStr(19,FALSE);
|
|
SysOpLog('TimeBank: Withdrew '+ IntToStr(Lng)+' minutes at logon.');
|
|
END;
|
|
END;
|
|
IF (NSL >= 0) THEN
|
|
TooMuch := FALSE
|
|
ELSE
|
|
(*
|
|
Print('Hanging up.');
|
|
*)
|
|
RGNoteStr(20,FALSE);
|
|
END;
|
|
END;
|
|
IF (TooMuch) THEN
|
|
BEGIN
|
|
SL1(ThisUser.Name+' attempt to exceed time/call limits.');
|
|
HangUp := TRUE;
|
|
END;
|
|
IF (Tries >= General.MaxLogonTries) THEN
|
|
HangUp := TRUE;
|
|
IF (NOT HangUp) THEN
|
|
Inc(ThisUser.OnToday);
|
|
END;
|
|
IF (UserNum > 0) AND (NOT HangUp) THEN
|
|
BEGIN
|
|
GetUser := Nu;
|
|
IF (NOT FastLogon) THEN
|
|
BEGIN
|
|
PrintF('WELCOME');
|
|
IF (NOT NoFile) THEN
|
|
PauseScr(FALSE);
|
|
I := 0;
|
|
REPEAT
|
|
Inc(I);
|
|
PrintF('WELCOME'+IntToStr(I));
|
|
IF (NOT NoFile) THEN
|
|
PauseScr(FALSE);
|
|
UNTIL (I = 9) OR (NoFile) OR (HangUp);
|
|
END;
|
|
UserOn := TRUE;
|
|
Update_Screen;
|
|
(*
|
|
Update_Node('Logged on',TRUE);
|
|
*)
|
|
InitTrapFile;
|
|
UserOn := FALSE;
|
|
CLS;
|
|
END;
|
|
IF (HangUp) THEN
|
|
GetUser := FALSE;
|
|
END;
|
|
|
|
END.
|