A real-life Fan Fiction Application

; contents of the source code:

Procedure.s Decoding(to_decode.s, key.s)

  result.s = ""

  ; alphanumeric system needed: a-z = 0-25, A-Z = 26-51, 0-9 = 52-61 (mod 62)

  length_t = Len(to_decode)
  length_k = Len(key)

  Dim text_letters(length_t)
  Dim key_letters(length_k)

  For i = 1 To length_t
    my_number = Asc(Right(to_decode, length_t-i+1))
    Select my_number
      Case 48 To 57 ; number
        text_letters(i) = my_number + 4
      Case 65 To 90 ; uppercase letter
        text_letters(i) = my_number - 39
      Case 97 To 122 ; lowercase letter
        text_letters(i) = my_number - 97
      Default ; undefined
        Debug "Error: string to decode contains non-alphanumeric characters"
        End
    EndSelect
  Next

  For i = 1 To length_k
    my_number = Asc(Right(key, length_k-i+1))
    Select my_number
      Case 48 To 57 ; number
        key_letters(i) = my_number + 4
      Case 65 To 90 ; uppercase letter
        key_letters(i) = my_number - 39
      Case 97 To 122 ; lowercase letter
        key_letters(i) = my_number - 97
      Default ; undefined
        Debug "Error: key contains non-alphanumeric characters"
        End
    EndSelect
  Next

  For i = 1 To length_t
    key_letter_used = (i-1) % length_k + 1
    my_number = (text_letters(i) - key_letters(key_letter_used) + 62) % 62
    Select my_number
      Case 0 To 25 ; lowercase letter
        result + Chr(my_number + 97)
      Case 26 To 51 ; uppercase letter
        result + Chr(my_number + 39)
      Case 52 To 61 ; number
        result + Chr(my_number - 4)
      Default ; undefined
        Debug "Error: incorrect modulo arithmetics"
        End
    EndSelect
  Next

  ProcedureReturn result

EndProcedure

; introduction

OpenConsole()
EnableGraphicalConsole(1)
PrintN("Aperture Science BBS System Fan Fiction Application, version 19.1.0.4")

; the last number is the number of days I worked on this thing + the number of side programs I've written;
; how much you're going to bet on the number not reaching two digits?

PrintN("Handling humanity's history since Jesus Christ")
PrintN("")

; login

Dim logins.s(2, 1)
i = 1
OpenFile(0, "./global_dir/logins.txt")
key.s = ReadString(0)
While Not Eof(0)
  username.s = ReadString(0)
  password_encoded.s = ReadString(0)
  password.s = Decoding(password_encoded, key)
  logins(1, i) = username
  logins(2, i) = password
  i + 1
  ReDim logins(2, i)
Wend
i - 1
CloseFile(0)

; good luck figuring out what ASBusinessMagnet's, interdimensionalPortaller's
; and WheatleyMoronic's passwords are

PrintN("Please log in to the system in order to use it.")
lines = 4
Username:
Print("Username: ")
lines + 1
username.s = Input()
If username = "quit"
  End
EndIf
okay = 0
For j = 1 To i
  If logins(1, j) = username
    okay = 1
    check = j
  EndIf
Next
If okay = 0
  PrintN("No such username found within the database, access denied.")
  PrintN("")
  PrintN("Please try again or type "+Chr('"')+"quit"+Chr('"')+" to exit the Application.")
  lines  + 3
  Goto Username
EndIf
key2 = -1
Print("Password: ")
lines + 1
password = ""
chars = 0
Repeat
  key.s = Inkey()
  If key <> ""
    key2 = RawKey()
    If key2 = 8 And chars <> 0
      If chars = 1 : password = "" : Else : password = Left(password, Len(password)-1) : EndIf
      chars - 1
      ConsoleLocate(chars+10, lines-1)
      Print(" ")
      ConsoleLocate(chars+10, lines-1)
    ElseIf key2 = 13
    ElseIf key2 = 8 And chars = 0
    Else
      password = password + key
      chars + 1
      Print("*")
    EndIf
  EndIf
Until key2 = 13
PrintN("")
If password = logins(2, check)
  PrintN("Access granted.")
  lines + 1
  Goto MainLoop
Else
  PrintN("Password incorrect, access denied.")
  PrintN("")
  PrintN("Please try again Or type "+Chr(34)+"quit"+Chr(34)+" To exit the Application.")
  lines + 3
  Goto Username
EndIf

MainLoop:

Repeat
  PrintN("")
  Print("> ")
  command.s = Input()
  PrintN("")
  lines + 3
  command + " "
  first_pos = FindString(command, " ", 1)
  first_word.s = Left(command, first_pos-1)
  Select first_word
    Case "logout"
      PrintN("Successfully logged out.")
      PrintN("")
      lines + 2
      Goto Username
    Case "dir"
      Gosub dir
    Case "years"
      Gosub years
    Case "quit"
      PrintN("Quitting...")
    Default
      PrintN("No such command.")
      lines + 1
  EndSelect
Until first_word = "quit"

CloseConsole()

End

dir:

PrintN("Directory listing:")
PrintN("")
lines + 2
files = 0
folders = 0
Directory$ = ".\local_dir\"
; separate examinations for first folders then files
If ExamineDirectory(0, Directory$, "*.*")
  While NextDirectoryEntry(0)
    If DirectoryEntryType(0) <> #PB_DirectoryEntry_File
      foldername.s = DirectoryEntryName(0)
      Select foldername
        Case "."
        Case ".."
          PrintN(DirectoryEntryName(0))
          lines + 1
        Default
          folders + 1
          PrintN(DirectoryEntryName(0))
          lines + 1
      EndSelect
    EndIf
  Wend
EndIf
FinishDirectory(0)
If ExamineDirectory(1, Directory$, "*.*")
  While NextDirectoryEntry(1)
    If DirectoryEntryType(1) = #PB_DirectoryEntry_File
      files + 1
      PrintN(DirectoryEntryName(1))
      lines + 1
    EndIf
  Wend
EndIf
FinishDirectory(1)
PrintN("")
Print(Str(folders)+" folder")
If folders % 10 <> 1 Or (folders % 100) / 10 = 1
  Print("s")
EndIf
Print(", "+Str(files)+" file")
If files % 10 <> 1 Or (files % 100) / 10 = 1
  Print("s")
EndIf
PrintN(" in total.")
lines + 2

Return

years:

PrintN("Year listing:")
PrintN("")
lines + 2
OpenFile(1, "./global_dir/years.txt")
ReadString(1) ; reading useless note
timeline_count = 0
Dim timeline_catalogue.s(4, 1)
timeline_codename.s = ReadString(1)
While timeline_codename <> "[YEAR]"
  timeline_name.s = ReadString(1)
  bc_prefix.s = ReadString(1)
  ad_prefix.s = ReadString(1)
  timeline_count + 1
  ReDim timeline_catalogue(4, timeline_count)
  timeline_catalogue(1, timeline_count) = timeline_codename
  timeline_catalogue(2, timeline_count) = timeline_name
  timeline_catalogue(3, timeline_count) = bc_prefix
  timeline_catalogue(4, timeline_count) = ad_prefix
  timeline_codename.s = ReadString(1)
Wend
year_count = 0
Dim year_catalogue.s(2, 1)
While Not Eof(1)
  year_name.s = ReadString(1)
  year_timeline.s = ReadString(1)
  year_foldername.s = ReadString(1)
Wend

; still to be done...

Return

; contents of file global_dir/logins.txt:

; ASBBSSFFA
; ASBusinessMagnet
; f6SUS3oMEubId03QJNN0VN
; interdimensionalPortaller
; jZF236TIYhSJOT61X5RSODZ0XJ
; WheatleyMoronic
; 8iNe6b5hOR6O