{$I DIRECT.INC}
unit GetLogin;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
interface
uses gentypes,dataproc;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure lGetLoginProc;
procedure lApplyProc(autoName : mStr);
function lCheckAcs : boolean;
procedure lFeedback;
procedure lSysopChat;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
implementation
uses Dos,Crt,DosMem,MkAvatar,configrt,modem,
userret,statret,gensubs,subs1,subsovr,Subs2,windows,mailret,nuv,
textret,overret1,mainr2,configur,rumors, FileLock, Feedback,
Acs, mycomman, bulletin, file0, file1, file2, file3, file4, filexfer,
mess1, mess2, mess3, Mess4, mainmenu,skaShit;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
var
doLocalTurbo : boolean;
isNew : boolean;
allowLogin : boolean;
fromLogonAnsi : boolean;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure ByeBye (ByeFile : SStr);
Begin
If ByeFile <> '' Then PrintFile(cfg.TextFileDir + ByeFile);
Unum := -1;
FullDisconnect;
End;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure NiceTry;
Begin
ByeBye('HACKER.ANS')
End;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function getSystemPassword:boolean;
var tries:integer;
b,mat:boolean;
W:Byte;
begin
if (length(cfg.systempassword)=0) or (cfg.autologin and local) or (DoLocalTurbo=true)
then Begin
getsystempassword:=True;
exit;
End;
GetSystemPassword := False;
Tries := 0;
Mat := Exist(cfg.TextFileDir + 'SYSPASS.ANS');
repeat
chainstr:='';
SetScreenSize(80,25);
GotoXy(1,25);
textbackground(1);
ClrEol;
skaWrite('|B1|03■ |07l|08ogon |07a|08ttempt #'+strr(tries)+' |15-|07- ');
skaWrite('|B1 |07s|08ystem|03_|07p|08w|07:|08: ');
skaWrite('|B1|15'+cfg.systempassword);
skaWrite('|B1|09 │ ');
Subs2.Password:=WhereX;
SetScreenSize(80,24);
SplitMode:=True;
dots:=true;
IF Mat THEN Begin
NoBreak := True;
ClearBreak;
Inpt[0]:=#0;
If Tries=0 Then InputFile(cfg.textfiledir+'SYSPASS.ANS') Else
Begin
GoXy(InptX,InptY);
AnsiColor(InptColor);
writestr(strng^.incorrect_logon_password);
If Length(Inpt)>6 Then For W:=1 To Length(Inpt)-6 Do SendFull(#32);
Delay(750);
If Length(Inpt)>6 Then For W:=1 To Length(Inpt)-6 Do SendFull(^H+' '+^H);
For W:=1 to 6 Do SendFull(^H+' '+^H);
GetStr(False);
End;
End
ELSE BEGIN
MultiColor(Strng^.SystemPasswordStr);
WriteStr('*');
End;
inc(tries);
b:=match(inpt,cfg.systempassword)
until (tries<2) or (b) or (hungupon);
SplitMode:=False;
Dots:=False;
InitWinds;
GetSystemPassword := B;
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function InBlackList (N : MStr) : Boolean;
Var F : File of MStr;
A : MStr;
Begin
InBlackList := False;
If Not Exist (cfg.DataDir + 'BLACKLST.DAT') Then Exit;
Assign(F,cfg.DataDir + 'BLACKLST.DAT');
Reset(F);
Repeat
NRead(F, A);
Until (EOF(F)) Or (Match(N, A));
If Match(N, A) Then InBlackList := True;
Close(F);
End;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
function validusername (m:mstr):boolean;
var n:integer;
begin
validusername:=true;
if inblacklist (m) then begin
Notice(cfg.sysopname,M+' has been rejected.');
validusername:=false;
if exist (cfg.textfiledir+'BLACKLST.ANS') then
printfile (cfg.textfiledir+'Blacklst.ANS') else
multicolor(^M+strng^.user_in_blacklist+^M);
byebye ('blacklst.ans');
end;
if length(m) < 1 then validusername:=false;
if (m='?') or (m='#') or (m='/') or (m='*') or (m='&') or (m=':') or
(M[1] = '?') or (M[1] = '#') or (M[1] = '*') or (M[1] = '&')
Or (M[ Length(M) ] = '*') Or
match(upstring(m),'NEW') or match(upstring(m),'Q') or match(upstring(m),'HACKER')
then begin
validusername:=false;
multicolor(^B^S^M+strng^.invalid_username);
exit;
end else begin
if (valu(m)=0) and (length(m)>0) then validusername:=true
end
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure lApplyProc(AutoName:Mstr);
Var RequestedNote : Mstr;
Procedure NewUserSetUp;
Type XyVar=Array[1..2] of Byte;
XyRec=Record
PH,NA,PW,C1,C2,C3,C4,
C5,C6,C7,SR,HK,UB,UN,Go,BD,ap,sk:XyVar;
End;
VAR T:Text;
BkColor:Byte;
XY:XyRec;
K:Char;
Procedure WriteOption(X,Y:Byte; C:ConfigType; Changeit:Boolean);
Begin
If X=0 then Exit;
If Changeit then Begin
If C In Urec.config
Then Urec.Config := Urec.config-[C] Else
urec.config:=urec.config+[C];
End;
goxy(X,Y);
AnsiColor(BkColor);
If C in urec.config then SendStr('Yes') Else SendStr('No!');
End;
Procedure GetString(X,Y:Byte; ttype,buf:byte; Var S);
Var Str:lstr Absolute S;
Int:Byte Absolute S;
i:Byte;
Begin
If X=0 then Exit;
inpt:='';
Goxy(X,Y);
SendStr(#27+'[s');
InputBox(Buf);
If inpt>'' then Begin
If ttype=1 then Str:=inpt else Begin
If (Valu(inpt)>0) and (Valu(inpt)<254) then int:=Valu(inpt);
End;
End;
SendStr(#27+'[u');
AnsiColor(BkColor);
If ttype=1 then Tab(str,Buf) else Tab(Strr(int),Buf);
End;
Procedure Process(VAR X:XyVar);
Begin
X[1]:=WhereX;
X[2]:=WhereY;
End;
Procedure Show(X,Y:Byte; Str:Mstr);
Begin
If X=0 Then Exit;
GoXy(X,Y);
SendStr(Str);
End;
Var Temp:String[12];
Begin
FillChar(XY,SizeOf(XY),0);
BkColor:=1;
Assign(T,cfg.TextFileDir+'NEWSETUP.ANS');
Reset(T);
While Not(Eof(T)) or (HungUpOn) Do Begin
Read(T,K);
IF K='|' Then Begin
Read(T,K);
Case Upcase(K) Of
'1':Process(Xy.C1);
'2':Process(Xy.C2);
'3':Process(Xy.C3);
'4':Process(Xy.C4);
'5':Process(Xy.C5);
'6':Process(Xy.C6);
'7':Process(Xy.C7);
'#':Process(Xy.Ph);
'P':Process(Xy.Pw);
'N':Process(Xy.Na);
'R':Process(Xy.Sr);
'H':Process(Xy.Hk);
'B':Process(Xy.Ub);
'U':Process(Xy.Un);
'D':Process(Xy.Bd);
'A':Process(xY.Ap);
'S':Process(Xy.Sk);
'@':Process(Xy.Go);
'=':Begin
Temp[0]:=#0;
Repeat
Read(T,K);
If Valu(K)>0 Then Temp:=Temp+K;
Until (Length(Temp)>3) or (K=';') or (HungUpOn);
BkColor:=Valu(Temp);
End;
End; (* Case *)
End Else SendStr(K);
End;
TextClose(T);
NoBreak:=True;
AnsiColor(BkColor);
Show(Xy.C1[1],Xy.C1[2],Strr(Urec.Color1));
Show(Xy.C2[1],Xy.C2[2],Strr(Urec.Color2));
Show(Xy.C3[1],Xy.C3[2],Strr(Urec.Color3));
Show(Xy.C4[1],Xy.C4[2],Strr(Urec.Color4));
Show(Xy.C5[1],Xy.C5[2],Strr(Urec.Color5));
Show(Xy.C6[1],Xy.C6[2],Strr(Urec.Color6));
Show(Xy.C7[1],Xy.C7[2],Strr(Urec.Color7));
Show(Xy.Ph[1],Xy.Ph[2],Urec.PhoneNum);
Show(Xy.Pw[1],Xy.Pw[2],Urec.Password);
Show(Xy.na[1],Xy.na[2],Urec.RealName);
Show(Xy.bd[1],xY.bd[2],Urec.BirthDate);
Show(Xy.ap[1],xy.ap[2],Urec.Aphilz);
Show(Xy.sk[1],xy.sk[2],Urec.Skillz);
WriteOption(Xy.Sr[1],Xy.Sr[2],ShowRumors,False);
WriteOption(Xy.Hk[1],Xy.Hk[2],HotKeys,False);
WriteOption(Xy.Ub[1],Xy.Ub[2],UseBars,False);
Show(Xy.Un[1],Xy.Un[2],Urec.SysOpNote);
Repeat
If WhereX=0 Then Begin
GoXy(1,24);
SendFull(^R'Selection? [Q]uits : ');
End Else
If (WhereX<>Xy.Go[1]) or (WhereY<>Xy.Go[2]) Then GoXy(Xy.Go[1],Xy.Go[2]);
K := WaitForChar(False);
Case Upcase(K) Of
'1':GetString(Xy.C1[1],Xy.C1[2],2,3,Urec.Color1);
'2':GetString(Xy.C2[1],Xy.C2[2],2,3,Urec.Color2);
'3':GetString(Xy.C3[1],Xy.C3[2],2,3,Urec.Color3);
'4':GetString(Xy.C4[1],Xy.C4[2],2,3,Urec.Color4);
'5':GetString(Xy.C5[1],Xy.C5[2],2,3,Urec.Color5);
'6':GetString(Xy.C6[1],Xy.C6[2],2,3,Urec.Color6);
'7':GetString(Xy.C7[1],Xy.C7[2],2,3,Urec.Color7);
'#':Begin
GetString(Xy.Ph[1],Xy.Ph[2],1,12,Temp);
If ValidPhone(False) Then Urec.PhoneNum:=Temp Else Begin
GoXy(Xy.Ph[1],Xy.Ph[2]);
SendStr('Invalid!');
Delay(2000);
AnsiColor(BkColor);
GoXy(Xy.Ph[1],Xy.Ph[2]);
Tab(Urec.PhoneNum,12);
End;
End;
'P':GetString(Xy.Pw[1],Xy.Pw[2],1,25,Urec.Password);
'N':GetSTring(Xy.Na[1],Xy.Na[2],1,30,Urec.RealName);
'R':WriteOption(Xy.Sr[1],Xy.Sr[2],ShowRumors,true);
'H':WriteOption(Xy.Hk[1],Xy.Hk[2],HotKeys,True);
'B':WriteOption(Xy.Ub[1],Xy.Ub[2],UseBars,True);
'D':GetString(Xy.Bd[1],Xy.Bd[2],1,8,Urec.BirthDate);
'S':GetString(Xy.Sk[1],Xy.Sk[2],1,30,Urec.Skillz);
'A':GetString(Xy.Ap[1],Xy.Ap[2],1,30,Urec.Aphilz);
'U':If cfg.ChangeNote Then
GetString(Xy.Un[1],Xy.Un[2],1,30,Urec.SysOpNote);
End;
Until (Upcase(K)='Q') or (HungUpOn);
End;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Function CheckLocals : Boolean;
VAR A,Z,Y:String[3];
X,X2,Total : Integer;
U : UserRec;
T : Text;
E,Local : Boolean;
Temp : Lstr;
BAD : Array[1..10] Of String[3];
Begin
Total := 0;
fillchar(bad,sizeof(bad),0);
A[0] := #0;
For X := 1 to 3 Do A := A + cfg.BoardPhone[X];
Bad[1] := A;
If Exist(cfg.TextFileDir + 'LOCAL.AC')
Then Begin
Assign(T,cfg.TextFileDir + 'LOCAL.AC');
Reset(T);
X := 1;
While Not Eof(T) Do Begin
Inc(X);
Readln(T,Bad[x]);
End;
TextClose(T);
End;
Z[0] := #0;
For X := 1 to 3 Do Z := Z + Urec.Phonenum[X];
E := Exist(cfg.TextFileDir+'EXEMPT.AC');
Local := FALSE;
For X2 := 1 to 10 Do If Bad[x2] = Z Then Local := True;
IF Local Then Begin
MultiColor(Strng^.Checking_PhoneNum);
For X:=1 to NumUsers Do Begin
Seek(UFile,X);
Read(UFile,U);
Local := FALSE;
If (U.Handle>'') And (U.Phonenum>'') Then Begin
Y[0] := #0;
For X2:=1 to 3 Do Y:=Y+U.PhoneNum[X2];
For X2 := 1 to 10 Do If Bad[x2] = Y
Then Local := TRUE;
If LOCAL then Begin
Inc(Total);
If E Then Begin
Assign(T,cfg.TextFileDir+'EXEMPT.AC');
Reset(T);
While Not(Eof(T)) Do Begin
Readln(T,Temp);
If Match(Temp,U.Handle) Then Dec(Total);
End;
TextClose(T);
End
End
End
End;
X := Round(Percentage(Total,NumUsers));
If (X > cfg.PercentLocal) AND (cfg.percentlocal <> 0)
then Begin
Unum := -1;
If Exist(cfg.TextFileDir+'NOLOCALS.ANS') Then
Printfile(cfg.TextFileDir+'NOLOCALS.ANS') Else
multicolor(strng^.no_more_locals+^M);
Notice(cfg.sysopname,Unam+' was denied (local area code ratio outta whack!)');
FullDisconnect;
End;
End;
CheckLocals:=True;
End;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure getoption (c:configtype; txt:string; b:boolean);
const yn:array [false..true] of string[3]=('No','Yes');
begin
if hungupon then exit;
DefYes:=B;
writestr (txt);
if length(inpt)<>0 then b:=yes;
if b
then urec.config:=urec.config+[c]
else urec.config:=urec.config-[c]
end;
Var oldn,try:integer;
k:char;
me:message;
m:mailrec;
i:Byte;
Begin
if cfg.private then byebye ('PRIVATE.ANS') else begin
If AutoName='' Then Begin
if (fromLogonAnsi) then goXY(dMciData^[7].xPos,dMciData^[7].yPos);
WriteStr(Strng^.ApplyAsNewStr);
If not yes then exit;
End;
UpdateNode('New User Applying!','New User');
If Exist (cfg.textfiledir+'NEWUSER.ANS') then printfile (cfg.textfiledir+'NEWUSER.ANS')
Else writestr(strng^.enter_new_user_info);
HoldScreen;
if exist(cfg.textfiledir+'NUPINFO.ANS') then
printfile(cfg.textfiledir+'NUPINFO.ANS');
unum:=0;
oldn:=0;
If cfg.newuserpassword>'' then Begin
try:=0;
SendCr('');
multicolor(strng^.nup_required+^M);
Repeat
WriteStr(Strng^.GetNupStr);
If not (match(inpt,cfg.newuserpassword)) then MultiColor(strng^.invalid_Nup);
inc(try); If try>4 then NiceTry;
Until (Match(inpt,cfg.newuserpassword)) or (hungupon);
End;
unam:='';
i:=1;
Repeat
if oldn<>0 then unam:='';
If (i<2) and (AutoName<>'')
Then
Unam:=Autoname;
if length(unam)=0 then begin
If (I<2) and (AutoName<>'') Then Unam:=AutoName
Else Begin
BufLen := 30;
WriteStr(Strng^.NewUserNameStr);
Unam:=Inpt;
End;
inc(i);
if Not ValidUserName(Unam) then begin
MultiColor (Strng^.Invalid_UserName);
SendCr('');
oldn:=1
end
end;
If HungUpOn
Then exit;
if length(unam)=0
then oldn:=0
else begin
MultiColor (Strng^.Checking_User_Base);
SendCr('');
if not validuname(unam)
then oldn:=1
else begin
oldn:=lookupuser(unam);
if oldn<>0 then MultiColor (Strng^.Name_Already_Used)
end
end
until oldn=0;
ulvl:=1;
if unam<>'' then begin
unum:=adduser (urec);
if unum<1 then begin
writestr(strng^.no_more_local_users);
FullDisconnect;
end;
UpdateNode('New User Application',Unam);
AnsiCls;
MultiColor(Strng^.Welcome_NewUser);
Sr.C[1] := 'UN'; Sr.S[1] := Strr(Unum);
MultiColor(Strng^.Your_UserNum);
SendCr('');
Repeat
MultiColor(Strng^.CreateAPassword);
Until GetPassword or HungUpOn;
Repeat
MultiColor(Strng^.Enter_RealName);
InputBox(25);
Until (Length(inpt)>3) and (pos(' ',inpt)>0) or (hungupon);
Urec.Realname := Inpt;
Urec.SysopNote:= strng^.default_sysop_note+'('+DateStr(Now)+')';
If cfg.ChangeNote then Begin
MultiColor(Strng^.Enter_UserNote);
InputBox(35);
urec.sysopnote:=inpt;
End;
with urec do begin
level:=1;
udlevel:=1;
udpoints:=0;
color1:=cfg.defcolor1;
color2:=cfg.defcolor2;
color3:=cfg.defcolor3;
color4:=cfg.defcolor4;
color5:=cfg.defcolor5;
color6:=cfg.defcolor6;
color7:=cfg.defcolor7;
pcr:=cfg.defpcr;
udfratio:=cfg.defudratio;
udkratio:=cfg.defudkratio;
Prompt := Strng^.defprompt;
MsgLength:=cfg.defmsglength;
KDownToday:=0;
dailykblimit:=cfg.defdailykblimit;
EmailAnnounce := -1;
AutoSig := -1;
end;
urec.config:=urec.config+[ansigraphics,linefeeds,eightycols,asciigraphics,fseditor,postprompts,usebars];
MultiColor(Strng^.Enter_Number_Header);
Repeat
GetPhoneNum;
Until Validphone(True) or HungUpOn;
Urec.PhoneNum := Inpt;
If Not CheckLocals
Then Begin
Unum := -1;
Exit;
End;
urec.timetoday:=5;
settimeleft(5);
SendCr('');
Multicolor(strng^.your_group_or_aphilz);
inputbox(25);
urec.aphilz := inpt;
multicolor(strng^.computer_type);
inputbox(25);
urec.computer_type := inpt;
MultiColor(Strng^.Your_Current_Prompt);
Sr.C[1]:='MN';
Sr.S[1]:='New User Config';
MultiColor(urec.prompt);
DefYes := False;
WriteStr(Strng^.Design_New_Prompt);
If yes then GetPrompt;
SendCr('');
GetOption(Hotkeys,Strng^.Want_HotKeys,false);
GetOption(ShowRumors,Strng^.Want_Rumors,true);
If Exist(cfg.TextFileDir+'NEWSETUP.ANS')
Then NewUserSetUp;
SendCr('');
ANSiRESET;
ANSiCOLOR(Urec.Color4);
if hungupon then begin
unum := -1;
exit
end;
AnsiCls;
Infoforms;
Writeurec;
If cfg.AutoAddNuv
then AddToNUV(urec.handle);
if exist (cfg.textfiledir+'MSG2SYS.ANS') then
printfile (cfg.textfiledir+'MSG2SYS.ANS')
else begin
multicolor(strng^.ask_sysop_for_access);
SendCr('')
end;
HoldScreen;
me.title:=urec.handle+'''s Application';
me.sendto:='The Sysops';
m.anon := false;
okfortitle := false;
me.add_autosig := false;
m.line:=editor(me,true,false,false,'0','The SysOp''s','0','FEEDBACK.TXT','FEEDBACK.MAP');
If M.Line > 0 Then begin
M.Title := 'New User Access';
M.Sentby := Unam;
M.Anon := False;
M.When := Now;
AddFeedback (m);
End;
Inc(Log.NewUsers);
isnew:=true;
If cfg.HangUpOnNew Then ByeBye('CALLBACK.ANS');
end else begin
unum := 0;
end
end
end;
{::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
procedure getunum;
var tries,cnt:integer;
u:userrec;
enterednum,A:boolean;
begin
tries:=0;
A:=Exist(cfg.textfiledir+'ALIAS.ANS');
repeat
Inc(Tries);
if tries>3 then nicetry else begin
chainstr:='';
If A Then Begin
If Tries=1 Then InputFile(cfg.textfiledir+'ALIAS.ANS') Else
Begin
GoXy(InptX,InptY);
AnsiColor(InptColor);
GetStr(False);
End;
End Else Begin
MultiColor(Strng^.WhatsYourAlias);
WriteStr('*');
End;
unam:=inpt;
isnew:=false;
enterednum := valu(unam) <> 0;
if hungupon then unum:=-1 else
if length(unam)=0
then unum:=0
else begin
Unum := LookUpUser (Unam);
if unum=0
then
begin
If A = False Then Begin
DefYes := False;
WriteStr (Strng^.User_Not_Found);
if yes then Begin
lApplyProc(Unam);
Exit;
End;
End Else Begin
GoXy(InptX,InptY);
AnsiColor(InptColor);
multicolor(strng^.user_not_found);
Delay(750);
GoXy(InptX,InptY);
Tab('',30);
End;
end
else if (not (enterednum)) and (Not(A))
then multicolor(^M+strng^.user_number+Strr(unum));
end
end;
If HungUpOn then Begin
Unum:=-1;
Exit;
End;
until unum<>0
end;
procedure getpwd;
var u:userrec;
begin
seek (ufile,unum);
read (ufile,u); che;
if not checkpassword(u) then begin
nicetry;
writelog (0,2,unam)
end;
IF U.Level < cfg.LogonLevel
Then Begin
unum := -1;
If Exist(cfg.TextFileDir+'NOLOGON.ANS') Then
PrintFile(cfg.TextFileDir+'NOLOGON.ANS') Else
multicolor(strng^.access_to_low_to_login);
FullDisconnect;
End;
SendCr(^M)
end;
procedure matrixlogoff;
begin
FullDisconnect;
end;
Procedure LoginAnsi;
Label StartOver;
Var K : Char;
Procedure Display(X:byte; What:Lstr);
Begin
If (dMciData^[x].xPos<>0) and (dMciData^[x].yPos<>0)
Then Begin
GoXy(dMciData^[x].xPos,dMciData^[x].yPos);
ansiColor(dMciData^[x].attr);
SendFull(What);
End;
End;
Function NewUserScreen : Char;
Begin
Urec.Handle := Unam;
InputFile(cfg.TextFileDir+'ASKNEW.ANS');
Urec.Handle := '';
If Not (Upcase(Inpt[1]) in ['C','R','G'])
Then Inpt[1]:='C';
Case Upcase(Inpt[1]) Of
'C':Begin
lApplyProc(Unam);
NewUserScreen := 'N';
Exit;
End;
'R':Begin
NewUserScreen := 'R';
Exit;
End;
'G':MatrixLogoff;
End;
End;
Var Key : Char;
Tries : Byte;
W : Byte;
Unum : longInt;
Begin
dInitMciMem(true);
dAddMciCode('HA'); { handle }
dAddMciCode('PW'); { password }
dAddMciCode('SN'); { sysop note }
dAddMciCode('DA'); { date }
dAddMciCode('TI'); { time }
dAddMciCode('RE'); { ask for reent }
dAddMciCode('NE'); { ask for apply }
dAddMciCode('IN'); { information }
StartOver:
dShowMciFile('LOGON.ANS');
Tries:=0;
Unum:=0;
ChainStr[0]:=#0;
Inpt[0]:=#0;
While (Unum < 1) Do Begin
If HungUpOn Then Begin
Unum := -1;
MatrixLogOff;
Exit;
End;
Inc(Tries);
If Tries>5
Then NiceTry;
GoXy(dMciData^[1].xPos,dMciData^[1].yPos);
AnsiColor(dMciData^[1].attr);
BufLen := 30;
GetStr(false);
Subs1.Unum := -1;
if hungupon then unum:=-1 else
if length(Inpt) = 0
then unum := 0
else begin
Unum := Lookupuser (Inpt);
Subs1.Unum := -1;
If Unum > 0 Then Begin
Seek(UFile,Unum);
NRead(UFile,Urec);
Display(3,Urec.SysOpNote);
Display(4,DateStr(Urec.LastOn));
Display(5,TimeStr(Urec.LastOn));
End Else
if Unum = 0 then begin
If ValidUserName(Inpt) Then
If Tries < 10 Then Begin
If Exist(cfg.TextFileDir+'ASKNEW.ANS') Then Begin
Key := NewUserScreen;
If Key = 'R'
Then Goto StartOver;
If Key = 'N'
Then Begin
MatrixLogOff;
Exit;
End;
End Else Begin
GoXy(dMciData^[8].xPos,dMciData^[8].yPos);
AnsiColor(dMciData^[8].attr);
multicolor(strng^.user_not_found);
Delay(1000);
GoXy(dMciData^[1].xPos,dMciData^[1].yPos);
If Length(Unam) > 13
Then Tab(' ',Length(Unam))
Else SendFull(' ');
GoXy(dMciData^[6].xPos,dMciData^[6].yPos);
AnsiColor(dMciData^[6].attr);
Buflen:=1;
DefYes := TRUE;
WriteStr(strng^.reenter_name_boolean);
If (Yes=false) Then
Begin
fromLogonAnsi := true;
lApplyProc(Unam);
MatrixLogoff;
Exit;
fromLogonAnsi := false;
End;
End;
End;
End
End
End;
If HungUpOn then Begin
Unum:=-1;
Exit;
End;
Tries:=0;
Inpt := '';
While (Not (Match(Inpt,Urec.Password))) and (Not (HungUpOn)) Do Begin
Inc(Tries);
If Tries>5
Then NiceTry;
SetScreenSize(80,25);
GotoXy(1,25);
TextAttr:=16;
ClrEol;
skaWrite('|B1 |08[|15attempt|08] |07'+Strr(Tries)+' |00:: |08[|15user|08] ');
skaWrite('|B1|07'+Urec.Handle);
skaWrite('|B1 |08[|15password|08] |07'+Urec.PassWord);
skaWrite('|B1|00 │ ');
Subs2.Password:=WhereX;
Dots:=True;
SplitMode:=True;
SetScreenSize(80,24);
GoXy(dMciData^[2].xPos,dMciData^[2].yPos);
AnsiColor(dMciData^[2].attr);
Buflen:=30;
GetStr(False);
If Not Match(Inpt,Urec.Password) Then Begin
GoXy(dMciData^[2].xPos,dMciData^[2].yPos);
Tab('Wrong!',Length(Inpt));
Delay(1000);
For W:=WhereX DownTo dMciData^[2].xPos+1 Do SendFull(^H+' '^H);
End
End;
If HungUpOn Then Begin
Unum:=0;
Exit;
End;
If Urec.Level < cfg.LogonLevel
Then Begin
CheckNuv(urec.handle);
AnsiCls;
multicolor(strng^.access_to_low_to_login);
ByeBye('NOACCESS.ANS');
End;
Subs1.Unum := UNUM;
NoBreak:=False;
InitWinds;
SplitMode:=False;
dInitMciMem(false);
End;
Function lCheckAcs : Boolean;
BEGIN
lCheckAcs := false;
getunum;
seek(ufile,unum);
read(ufile,urec); che;
ulvl:=urec.level;
if unum>0 then
BEGIN
IF NOT checkpassword(urec) then ELSE
BEGIN
IF (cfg.systempassword='') and (ulvl<cfg.LogonLevel) then BEGIN
lCheckAcs := true;
multicolor(strng^.no_system_password);
HoldScreen;
Exit;
END;
If Ulvl >= cfg.Logonlevel Then Begin
lCheckAcs := true;
Writehdr(strng^.system_validation_header);
Sr.C[1] := 'DA'; Sr.S[1] := DateStr(Now);
Sr.C[2] := 'PW'; Sr.S[2] := cfg.SystemPassword;
MultiColor(Strng^.Sys_PW_Is);
SendCr(^M);
End Else Begin
MultiColor(Strng^.You_Are_Not_Validated);
SendCr('');
CheckNuv(Urec.Handle);
MatrixLogoff;
End;
HoldScreen;
END;
END;
END;
procedure lFeedBack;
var mail:mailrec;
mes:message;
begin
SendCr('');
unam:='';
MultiColor(Strng^.WhatsYourAlias);
WriteStr('*');
if length(inpt)>0 then begin
unam:=inpt;
unum:=0;
ulvl:=0;
end;
if (length(unam)>0) then begin
SendCr('');
multicolor(strng^.sending_matrix_email);
delay (100);
SendCr('');
okfortitle := False;
Mes.Add_AutoSig := False;
Mail.Line:=editor(mes,false,False,true,'0','Matrix E-Mail','0','FEEDBACK.TXT','FEEDBACK.MAP');
if mail.line>0 then begin
mail.title:='Matrix Logon Feedback';
mail.sentby:=unam;
mail.anon:=false;
mail.when:=now;
addfeedback (mail);
end;
end;
end;
Procedure lSysopChat;
Var i:Byte;
begin
If SysOpIsAvail
Then Begin
AnsiCls;
WriteHdr(strng^.requesting_matrix_chat_header);
Unam := '';
Writestr (Strng^.WhatsYourAlias);
If Length(Inpt) > 0 Then Begin
Unam := Inpt;
Unum := 0;
Ulvl := 0;
End;
SendCr('');
If (Length(Unam) > 0) and (cfg.chatnoise)
Then For i := 1 to 5 Do SummonBeep;
SendCr('');
End Else Begin
multicolor(strng^.matrix_chat_disabled);
HoldScreen;
End;
End;
Procedure InitUser;
Var M : MailRec;
Cnt : Integer;
Tmp : String;
F : Text;
K : Char;
Quick : Boolean;
Begin
ReadUrec;
If ULvl = -1 Then Begin
ByeBye ('Trashcan');
Exit
End;
If Urec.Graphics > 1
Then Load_Theme(Urec.Graphics);
If Urec.Level < cfg.LogonLevel
Then ByeBye('LOWLEVEL.ANS');
CheckPageLength := False;
LineCount := 1;
For Cnt:=1 to 5 Do
if (pos(strr(cnt),cfg.requiredforms)>0) and (urec.infoform[cnt]<0) then infoform(cnt);
AnsiCls;
With Urec Do Begin
Inc(Numon);
If Not Local Then Begin
Status.TotalCallers := Status.TotalCallers + 1;
Inc(Status.CallsToday);
Inc(Log.Calls);
AddLastCaller(Urec.Handle,False);
End;
If DatePart(Laston) <> DatePart(Now)
Then Begin
Cnt := Level;
If Cnt < 1 Then Cnt := 1;
If Cnt > 100 Then Cnt := 100;
If TimePerDay < 1
Then TimeToday := cfg.UserTime[Cnt]
Else TimeToday := TimePerDay;
KDownToday := 0
End;
NoBreak := False;
Subs1.Laston := Laston;
Laston := Now;
LogonTime := Timer;
LogOFFTime := Timer + TimeToday;
LogONUnum := UNum;
LineCount := 1;
End;
UpdateNode('Logging into BBS','');
ClearChain;
Inpt[0] := #0;
if local
then tmp := ' <Local>'
else tmp := #32 + baudstr;
writelog (0,1,unam+tmp);
If (TimeTillEvent < (Urec.TimeToday+3)) and (TimeTillEvent <= 63)
Then Begin
multicolor(strng^.event_coming);
End;
disconnected := false;
Status.LastUSER := Urec.Handle;
writeurec;
bottomLine;
if wanted in urec.config then if sysopisavail
then begin
multicolor(strng^.sysop_paging_you);
for cnt:=1 to 10 do if not keyhit then summonbeep;
chatmode:=true
end;
END;
procedure lGetLoginProc;
Var Tries : Byte;
cool: boolean;
Begin
allowLogin := false;
repeat
inc(tries);
cool := getSystemPassword;
until (cool=true) or (tries>3);
if not cool then byeBye('BADSYSPW.ANS');
tries := 0;
if cfg.autologin and local and (not carrier) or (doLocalTurbo=true) then begin
unum:=lookupuser (cfg.sysopname);
if unum=0
then WriteLn('User ',cfg.sysopname,' not found!')
else begin
unum:=1;
status.lastuser:=cfg.sysopname;
inituser;
exit
end
end;
If (cfg.NumPreLogon > 0) Then Begin
Randomize;
Printfile (cfg.TextFileDir + 'PRELOGON.'+Strr(Random(cfg.NumPrelogon) + 1));
HoldScreen;
End;
If Not AllowLogin Then
If Exist(cfg.TextFileDir+'LOGON.ANS')
Then LoginAnsi
Else Begin
IF NOT AllowLogin then GetUNUM;
if HungUPON then exit;
IF not allowlogin then GetPWD;
if HungUPON then exit;
End;
If Unum < 1 then NiceTry;
AnsiColor(7);
AnsiCls;
Inituser;
end;
begin fromLogonAnsi := false; end.