 Rem File: Cmd190.bas ' 03/10/2021
 Rem Sub: |Password
 Rem $Include: 'dndbbs.inc'
 On Error Goto Main.Error
 TempX$=Nul
 If Chained=0 Then
    Local.Mode=True
    User.Linelength=80
    Call Read.Rows(Var)
    User.Pagelength=Var
    Max.Row=Var
    Call Save.Screen2(0)
    CALL StatusLine
    Locate Max.Row-1,1,1
 Endif
 Strng="RBBS Password Hack v1.4a"
 Call IO.O
 If Chained=-2 Then
    Gosub Get.Password
    If TempQ=0 Then
       Goto Main.Resume
    Endif
 Endif
 Call RBBS.Password
Main.Resume:
 If Chained=-2 Then
    Chain DND.Path+"DNDBBS.EXE"
 Endif
 COLOR 7, 0
 LOCATE Max.Row, 1, 1
 PRINT SPACE$(80);
 Call Save.Screen2(-1)
' Locate Max.Row,1,1
 If TempX=0 Then TempX=1
 Locate TempX,1,1
 Color 15
 Locate ,,0
 Print
 Strng="RBBS Password Hack v1.4a"
 Print Strng
 If Len(TempX$) Then
    Color 14
    Print " ";TempX$
 Endif
 Color 7
 Print "Now exiting utility."
 Color 7
 Locate ,,1
 End
Get.Password:
 TempQ=False
 Temp$=Ucase$(Rtrim$(Config3(46)))
 If Temp$=Nul Then
    Strng="Function not available."
    Call IO.O
    Return
 Endif
 Graphics.Off=True
 Strng="Password? "
 Line.Length=20
 Hidden=True
 Call IO.I
 Hidden=False
 Graphics.Off=False
 If Len(Out2) Then
    Out2=Ucase$(Out2)
    Var$=Nul
    Call Cryptograph(Out2)
    For Var=1 To Len(Out2)
       Var2=Asc(Mid$(Out2,Var,1))
       Var$=Var$+Right$("0"+Hex$(Var2),2)
    Next
    If Var$=Temp$ Then
       TempQ=True
       Return
    Endif
 Endif
 Strng="Illegal password attempt!"
 Call IO.O
 Return
Main.Error:
 Resume Main.Resume

Sub RBBS.Password
 ON LOCAL ERROR GOTO Error.Trap73
 Strng="Stealth mode(y/n)? "
 No.Input.Out="N"
 Graphics.Off=True
 Call IO.I
 TempX=Yes
 Close #TempFile1
 Close #TempFile2
StartLoop:
 Strng="Specify (1)List users, (2)Edit users, (3)Quit? "
 No.Input.Out="3"
 Graphics.Off=True
 Call IO.I
 If Out2="" Then
    Out2="3"
 Endif
 TempZ=Int(Val(Out2)+.5)
 Select Case TempZ
 Case 1
    Goto ListLoop
 Case 2
    Goto EditLoop
 Case 3
    Strng="Program aborted." : TempX$="Program aborted."
    Graphics.Off=False
    Call IO.O
    Exit Sub
 Case Else
    Goto StartLoop
 End Select
ListLoop:
 Close #TempFile1
 Close #TempFile2
 Strng="Specify file (1)Users, (2)Mainu.def, (3)Other, (4)Quit? "
 No.Input.Out="4"
 Graphics.Off=True
 Call IO.I
 If Out2="" Then
    Out2="4"
 Endif
 Var=Int(Val(Out2)+.5)
 If Var>=1 And Var<=4 Then
    Eat$=Nul
 Else
    Goto ListLoop
 Endif
 If Var=4 Then
    Strng="Function aborted." : TempX$="Function aborted."
    Graphics.Off=False
    Call IO.O
    Goto StartLoop
 Endif
 Select Case Var
 Case 1
    FileName$ = "C:\RBBS\USERS"
 Case 2
    FileName$ = "C:\RBBS\MAINU.DEF"
 Case 3
    Strng="Enter filename"
    Strng=Strng+": "
    Graphics.Off=True
    Call IO.I
    FileName$ = Out2
 End Select
 IF DIR$(FileName$) = Nul THEN
    Strng="Input file "+FileName$+" not found." : TempX$=Strng
    Graphics.Off=False
    Call IO.O
    Goto Error.Resume73
 Endif
 OPEN "R", TempFile1, FileName$, 128
 FIELD TempFile1, 31 AS UserName$, 15 AS PassWord$, 2 AS SecLevel$, 80 AS T$
 V! = Lof(TempFile1)/128
 If V!=0! Then
    Strng="Input "+FileName$+" filelength is zero bytes." : TempX$=Strng
    Graphics.Off=False
    Call IO.O
    Goto Error.Resume73
 Endif
 If V!<>Int(V!) Then 
    Strng="Input "+FileName$+" filelength is not multiple of 128 bytes." : TempX$=Strng
    Graphics.Off=False
    Call IO.O
    Goto Error.Resume73
 Endif
 S = 0
 If TempX = 0 Then
    Strng="Specify security level(y/n)? "
    Graphics.Off=True
    Call IO.I
    If Lcase$(Out2)="y" Then
       Strng="Enter security level? "
       Graphics.Off=True
       Call IO.I
       Var=Int(Val(Out2)+.5)
       If Var>=0 And Var<=32767 Then
          S = Var
       Endif
       If S Then
          Graphics.Off=False
          Strng="Enter comparison:"
          Call IO.O
          Strng="(1) < (2) <= (3) = (4) >= (5) >"
          Call IO.O
          Strng="Specify 1-5 (or <enter> for default)? "
          Graphics.Off=True
          Call IO.I
          Z=Int(Val(Out2)+.5)
          If Z>=1 And Z<=5 Then
             N$=""
          Else
             Z=3
          Endif
       Endif
    Endif
 Endif

 Var$ = "C:\RBBS\FILES\RBBSHACK.OUT"
 If TempX = 0 Then
    Strng="Default output path\filename = "+Lcase$(Var$)
    Graphics.Off=False
    Call IO.O
    Strng="Enter output path\filename(<enter> for default)? "
    Graphics.Off=True
    Call IO.I
    If Out2 <> "" Then
       Var$ = Out2
    Endif
 Endif

 Open Var$ For Output As #TempFile2
 d1$=format$(now,"mm-dd-yyyy")
 Print #TempFile2, "RBBS password list for "+FileName$+" at "+d1$+" "+Format$(Now,"hh:mm:ss")
 Print #TempFile2, ""
 X! = 0! ' record
 Y = 2 ' pagelength
 Strng="Username                        Password        Security Level"
 Print #TempFile2, Strng
 Strng="--------                        --------        --------------"
 Print #TempFile2, Strng

 DO
    X! = X! + 1!
    IF X! > LOF(TempFile1) / 128! THEN
       EXIT DO
    END IF
    GET #TempFile1, X!
    V$ = RTRIM$(UserName$)
    If V$ = Nul Or V$ = String$(31, Chr$(0)) Then
       Eat$ = Nul
    Else
       V$=Lcase$(V$)
       Mid$(V$,1,1)=Ucase$(Mid$(V$,1,1))
       Var=Instr(V$," ")
       If Var<Len(V$) Then
          Do While Var
             Mid$(V$,Var+1,1)=Ucase$(Mid$(V$,Var+1,1))
             Var=Instr(Var+1,V$," ")
          Loop
       Endif
       V$ = V$ + SPACE$(32 - LEN(V$))
       X$ = Rtrim$(PassWord$)
       If Len(X$) = 0 Or X$ = String$(15, Chr$(0)) Then
          X$ = "<none>"
       Endif
       Strng = V$ + X$ + SPACE$(16 - LEN(X$))
       Strng2 = Mid$(Str$(Cvi(SecLevel$)),2)
       Strng = Strng + Space$(6 - Len(Strng2)) + Strng2
       V = -1
       If S Then
          V = 0
          Select Case Z
          Case 1
             If Cvi(SecLevel$)<S Then
                V=-1
             Endif
          Case 2
             If Cvi(SecLevel$)<=S Then
                V=-1
             Endif
          Case 3
             If Cvi(SecLevel$)=S Then
                V=-1
             Endif
          Case 4
             If Cvi(SecLevel$)>=S Then
                V=-1
             Endif
          Case 5
             If Cvi(SecLevel$)>S Then
                V=-1
             Endif
          End Select
       Endif
       If V Then
          Print #TempFile2, Strng
       END IF
    END IF
 LOOP

 Strng="Data written to "+Var$
 Graphics.Off=False
 Call IO.O
 If TempX = 0 Then
    Strng="Display output file(y/n)? "
    No.Input.Out="N"
    Graphics.Off=True
    Call IO.I
    If Yes Then
       Close #TempFile1
       Close #TempFile2
       Call Out.File(Var$,"-1")
    Endif
 Endif

 Goto ListLoop
EditLoop:
 Close #TempFile1
 Close #TempFile2
 Strng="Specify file (1)Users, (2)Mainu.def, (3)Other, (4)Quit? "
 No.Input.Out="4"
 Graphics.Off=True
 Call IO.I
 If Out2="" Then
    Out2="4"
 Endif
 Var=Int(Val(Out2)+.5)
 If Var>=1 And Var<=4 Then
    Eat$=Nul
 Else
    Goto EditLoop
 Endif
 If Var=4 Then
    Strng="Function aborted."
    Graphics.Off=False
    Call IO.O
    Goto StartLoop
 Endif
 Select Case Var
 Case 1
    FileName$ = "C:\RBBS\USERS"
 Case 2
    FileName$ = "C:\RBBS\MAINU.DEF"
 Case 3
    Strng="Enter filename"
    Strng=Strng+": "
    Graphics.Off=True
    Call IO.I
    FileName$ = Out2
 End Select
 IF DIR$(FileName$) = Nul THEN
    Strng="Input "+FileName$+" file not found." : TempX$=Strng
    Graphics.Off=False
    Call IO.O
    Goto Error.Resume73
 Endif
 OPEN "R", TempFile1, FileName$, 128
 FIELD TempFile1, 31 AS UserName$, 15 AS PassWord$, 2 AS SecLevel$, 80 AS T$
 V! = Lof(TempFile1)/128
 If V!=0! Then
    Strng="Input "+FileName$+" filelength is zero bytes." : TempX$=Strng
    Graphics.Off=False
    Call IO.O
    Goto Error.Resume73
 Endif
 If V!<>Int(V!) Then
    Strng="Input "+FileName$+" filelength is not multiple of 128 bytes." : TempX$=Strng
    Graphics.Off=False
    Call IO.O
    Goto Error.Resume73
 Endif
 Strng="Enter username(?, * allowed), or <enter> to quit? "
 Graphics.Off=True
 Call IO.I
 Var1$=Ucase$(Out2)
 If Len(Var1$) = 0 Then
    Goto StartLoop
 Endif
 X! = 0!
 Z = 0
 DO
    X! = X! + 1!
    IF X! > LOF(TempFile1) / 128! THEN
       EXIT DO
    END IF
    GET #TempFile1, X!
    V$ = RTRIM$(UserName$)
    If V$ = Nul Or V$ = String$(31, Chr$(0)) Then
       Eat$ = Nul
    Else
       Call InstrSUB(VarX,V$,Var1$)
       If VarX Then
          Z = -1
          Strng="Username '"+V$+"' found."
          Graphics.Off=False
          Call IO.O
          Strng="Enter password, or <enter> to skip? "
          Graphics.Off=True
          Call IO.I
          Out2=Ucase$(Out2)
          If Len(Out2) > 0 Then
             LSET Password$ = Out2
             PUT #TempFile1, X!
          Endif
          Strng="Enter security level(0-32767), or Q to quit? "
          No.Input.Out=Ltrim$(Str$(Cvi(SecLevel$)))
          Graphics.Off=True
          Call IO.I
          If Len(Out2) > 0 Then
             If Lcase$(Out2)="q" Then
                Strng="Exit user edit."
                Graphics.Off=False
                Call IO.O
                Exit Do
             Endif
             L = Int(Val(Out2)+.5)
             If L >= 0 And L <= 32767 Then
                LSET SecLevel$ = MKI$(L)
                PUT #TempFile1, X!
             Endif
          Endif
       Endif
    Endif
 LOOP
 If Z = 0 Then
    Strng = "Username not found."
    Graphics.Off=False
    Call IO.O
 Endif
 Goto EditLoop
Error.Resume73:
 EXIT SUB

Error.Trap73:
 Select Case Err
 Case 53
    Strng=" file not found"
 Case 55
    Strng=" file already open"
 Case 57
    Strng=" device i/o error"
 Case 61
    Strng=" disk full"
 Case 62
    Strng=" input past eof"
 Case 64
    Strng=" bad file name"
 Case 67
    Strng=" not enough file handles"
 Case 68
    Strng=" device unavailable"
 Case 70
    Strng=" permission denied"
 Case 71
    Strng=" disk not ready"
 Case 75
    Strng=" path/file access error"
 CASE 76
    Strng=" pathname not found"
 Case Else
    Strng=Str$(Var2)
 End Select
 Strng="File error:"+Strng+"." : TempX$=Strng
 Graphics.Off=True
 Call IO.O
 RESUME Error.Resume73
End Sub

Sub Read.Rows(Var)
 On Local Error Goto Error.Trap62x
 Temp1=50
 Locate 50,1,0
 Var=50
 Exit Sub
Next.Trap1:
 Temp1=43
 Locate 43,1,0
 Var=43
 Exit Sub
Next.Trap2:
 Var=25
Error.Resume62x:
 Exit Sub
Error.Trap62x:
 If Temp1=50 Then
    Resume Next.Trap1
 Endif
 If Temp1=43 Then
    Resume Next.Trap2
 Endif
 Resume Error.Resume62x
End Sub

REM Format of RBBS USERS file: (copied from \RBBS\DOC\RBBSDOC.ASC).

'    Position Length           Description
'      1 - 31    31  Users first and last name (separated by a blank).
'     32 - 46    15  Users password for logon (not encrypted),
'     47 - 48     2  Users security level (permanent).
'     49 - 62    14  Users logon options (see detail breakdown below).
'     63 - 86    24  City and state from which the user is calling.
'     87 - 88     2  ---- RESERVED FOR FUTURE USE ----
'     89 - 89     1  Number of minutes banked.  0 to 255.  Use ASCII value.
'     90 - 93     4  Number of files downloaded today
'     94 - 97     4  Number of bytes downloaded today
'     98 - 101    4  Number of bytes downloaded (ever).
'    102 - 105    4  Number of bytes uploaded (ever).
'    106 - 119   14  Date and time the user was last on (MM-DD-YY HH:MM).
'    120 - 122    3  Date the user last listed a directory.
'    123 - 124    2  Number of files downloaded (ever).
'    125 - 126    2  Number of files uploaded (ever).
'    127 - 128    2  Elapsed time the user was on for day of last access.
'
' The user's logon options, positions 49 through 62, are utilized as follows:
'
'    Position Length           Description
'     49 - 50     2   Number of times the user has logged on

'     51 - 52     2   Last message number read by the user
'        53       1   Protocol Preference (blank if none, otherwise letter)
'        54       1   Graphics Preference (see meaning below)
'     55 - 56     2   Margin length for this users messages
'     57 - 58     2   Bit Flag -- this 16-bit field is denoted by bit 0 being
' the  least significant (i.e.  right-most bit)  and  bit  15 being  the most
' significant (i.e.  left-most bit).   These "bit  flags" have  the following
' meanings (0=off, 1=on):
'
'                   BIT  Definition (what ON means) 
'                    0   Bell prompts
'                    1   "Expert" mode
'                    2   Nulls
'                    3   Upper case only
'                    4   Line feeds
'                    5   Skip old bulletins
'                    6   Check new files on logon
'                    7   Use autodownload
'                    8   Required questionnaire answered
'                    9   Mail Waiting
'                   10   Highlighting enabled
'                   11   "TurboKey" enabled
'                   12   Personal uploads waiting
'                 13-15  RESERVED FOR FUTURE USE
'
'     59 - 60     2   Date subscription began
'        61       1   Page length to use for this users terminal
'        62       1  ------- RESERVED FOR FUTURE USE ---------
'                ---
'                14
'
' -end-

Sub Save.Screen2(Var)
 On Local Error Goto Error.Trap62
 If Var=False Then
    VarX3=(Max.Row-1)*80+80
    Redim Temp.ArrayY(VarX3) As Long
    Redim Temp.ArrayZ(VarX3) As Double
    For Var1=1 To Max.Row
       For Var2=1 To 80
          TempZ1=Screen(Var1,Var2)
          TempZ2=Screen(Var1,Var2,1)
          VarX2=(Var1-1)*80+Var2
          Temp.ArrayY(VarX2)=TempZ1
          Temp.ArrayZ(VarX2)=TempZ2
       Next
    Next
 Else
    Cls
    For VarX=Max.Row To 1 Step -1
       For VarY=1 To 80
          VarX2=(VarX-1)*80+VarY
          If Temp.ArrayY(VarX2)<>32 Then
             Goto Next.Line
          Endif
       Next
    Next
Next.Line:
    TempX=VarX
    For Var1=1 To VarX ' Max.Row
       For Var2=1 To 80
          VarX2=(Var1-1)*80+Var2
          VarB=Int(Temp.ArrayZ(VarX2)/16)
          VarF=Temp.ArrayZ(VarX2) Mod 16
          TempZ1=Temp.ArrayY(VarX2)
          Locate Var1,Var2,0
          Color VarF,VarB
          Print Chr$(TempZ1);
       Next
    Next
 Endif
Error.Resume62:
 Exit Sub
Error.Trap62:
 Resume Error.Resume62
End Sub

' display statusline
SUB StatusLine
LOCATE Max.Row, 1, 1
COLOR 15, 1
S$ = "RBBS utility " + Version$ + " " + Release$ + " " + FORMAT$(Now,"mm-dd-yyyy") + " " + FORMAT$(Now, "hh:mm:ss")
IF Debug THEN
   Var2# = FRE(-1) + FRE("A") ' far+near segments
   Var2$ = Format$(Var2#, "#,##0.00;;")
   S$ = "RBBS utility - Free RAM: " + Var2$ + " bytes."
END IF
S$ = LEFT$(S$, 80)
S$ = S$ + SPACE$(80 - LEN(S$))
PRINT S$;
LOCATE Max.Row - 1, 1, 1
COLOR 15, 0
END SUB
