Code:
Option Explicit Off
Option Strict On
Imports System.IO
Public Module GlobalMod
Public Key As String
Public MasterPassword As String
Public SW As StreamWriter
Public SR As StreamReader
' Public Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Integer)
Sub New()
Key = ReadOnLine("Data/CryptKey.txt", 0)
MasterPassword = ReadOnLine("Data/CryptKey.txt", 1)
End Sub
Public Function StringValid(ByVal Str As String, ByVal Strs As String(), Optional ByVal AllSpecialChars As Boolean = False) As Boolean
StringValid = Nothing
Dim CChars As String()
If AllSpecialChars Then
CChars = {" ", "!", Chr(34), "#", "$", "%", "&", "'", "(", ")", "*", "+", ",", "-", ".", "/", ":", ";", "<", "=", ">", "?", "@", "[", "\", "]", "^", "_", "`", "{", "|", "}", "~"}
Else
CChars = Strs
End If
Dim ContainsInvalid As Boolean = False
Dim TempChar As String = Nothing
For I = 0 To (Str.Length - 1)
TempChar = Str.Chars(I)
If (Asc(TempChar) >= 32) And (Asc(TempChar) <= 126) Then
For II = 0 To UBound(CChars)
If TempChar = CChars(II) Then
ContainsInvalid = True
Exit For
End If
Next
Else
ContainsInvalid = True
End If
If ContainsInvalid Then Exit For
Next
If Not ContainsInvalid Then
StringValid = True
Else
StringValid = False
End If
End Function
Public Sub BubbleSort(ByRef arr() As Integer)
Dim intTemp As Integer
For I = LBound(arr) To UBound(arr)
For II = LBound(arr) To UBound(arr)
If Not II = UBound(arr) Then
If arr(II) > arr(II + 1) Then
intTemp = arr(II + 1)
arr(II + 1) = arr(II)
arr(II) = intTemp
End If
End If
Next
Next
End Sub
Public Function STR_InArray(ByVal STR As String, ByVal Array() As String, Optional ByRef WhichRec As Integer = 0) As Boolean
For I = 0 To UBound(Array)
If (Array(I) = STR) Then
STR_InArray = True
WhichRec = I
Exit Function
End If
Next
STR_InArray = False
End Function
Public Function ReadOnLine(ByVal FileName As String, ByVal Line As Integer) As String
If File.Exists(FileName) Then
AppendFile(FileName, Line)
Dim SR As New StreamReader(FileName)
Dim TempS(Line) As String
For I = 0 To Line
TempS(I) = SR.ReadLine()
Next
ReadOnLine = TempS(Line)
SR.Close()
End If
End Function
Public Function ReadAllLines(ByVal FileName As String) As String()
ReadAllLines = Nothing
If File.Exists(FileName) Then
Dim SR As StreamReader = _
New StreamReader(FileName)
ReadAllLines = Split(SR.ReadToEnd(), vbNewLine)
SR.Close()
End If
End Function
Public Sub ThrowError(ByVal Msg As String)
MsgBox(Msg, MsgBoxStyle.Exclamation, "Error!")
End Sub
Public Function GatherUserData(ByVal WhichUser As Integer) As String()
Dim TempRes(8) As String
For I = 0 To 7
TempRes(I) = ReadOnLine("Data/" & CStr(I) & ".txt", WhichUser)
Next
GatherUserData = TempRes
End Function
Public Function GetFileLength(ByVal FileName As String) As Integer
If File.Exists(FileName) Then
GetFileLength = UBound(ReadAllLines(FileName))
End If
End Function
Public Function GetUserArray() As String()
If Not File.Exists("Data0.txt") Then
GetUserArray = Nothing
ThrowError("File - " & "Data0.txt" & " Not Found!")
Exit Function
Else
GetUserArray = ReadAllLines("Data0.txt")
End If
End Function
Public Sub AppendFile(ByVal FileName As String, ByVal Length As Integer)
If File.Exists(FileName) Then
Dim TempLen() As String = ReadAllLines(FileName)
If (Length > UBound(TempLen)) Then
Dim NewLen(Length - 1) As String
For I = 0 To (Length - 1)
NewLen(I) = ""
Next
For I = 0 To UBound(TempLen)
NewLen(I) = NewLen(I) & TempLen(I)
Next
WriteAllLines(FileName, NewLen)
End If
End If
End Sub
Public Sub WriteAllLines(ByVal FileName As String, ByVal Lines() As String)
Try
If File.Exists(FileName) Then
Dim LinesT() As String = Lines
File.Delete(FileName)
File.Create(FileName)
Dim SW As New StreamWriter(FileName)
For I = 0 To UBound(LinesT)
SW.WriteLine(LinesT(I))
Next
End If
Catch Ex As Exception
ThrowError(Ex.Message)
Finally
SW.Close()
End Try
End Sub
Public Sub WriteOnLine(ByVal FileName As String, ByVal Line As Integer, ByVal Str As String)
Dim L As Integer = Line
AppendFile(FileName, Line + 2)
Dim Lines() As String = ReadAllLines(FileName)
Lines(Line + 1) = Lines(Line + 1) & Str
WriteAllLines(FileName, Lines)
End Sub
Public Sub WriteToLine(ByVal FileName As String, ByVal Line As Integer, ByVal Str As String)
AppendFile(FileName, Line + 2)
Dim Lines() = ReadAllLines(FileName)
Lines(Line + 1) = Str
WriteAllLines(FileName, Lines)
End Sub
Public Function Encrypt(ByVal Str As String, ByVal Key As String) As String
Dim TempChar As Char() = CType(Str, Char())
Dim TempAsc(UBound(TempChar)) As Integer
For I = 0 To UBound(TempChar)
TempAsc(I) = Asc(TempChar(I))
Next
Dim KeyChar As Char() = CType(Key, Char())
Dim KeyAsc(UBound(KeyChar)) As Integer
For I = 0 To UBound(KeyChar)
KeyAsc(I) = Asc(KeyChar(I))
Next
Dim KeyLen(UBound(TempAsc)) As String
Dim II As Integer = 0
For I = 0 To UBound(KeyLen)
KeyLen(I) = CStr(KeyAsc(II))
If II = (UBound(KeyAsc)) Then
II = 0
Else
II = II + 1
End If
Next
Dim NewKeys(UBound(KeyLen)) As String
For I = 0 To UBound(NewKeys)
NewKeys(I) = CStr(TempAsc(I) * CInt((KeyLen(I))))
Next
For I = 0 To UBound(NewKeys)
Dim NKC As Char() = CType(NewKeys(I), Char())
Array.Reverse(NKC)
NewKeys(I) = CType(NKC, String)
Next
Dim S As String = Nothing
S = NewKeys(0)
For I = 1 To UBound(NewKeys)
S = S & " " & NewKeys(I)
Next
Dim C As Integer
Dim S2 As String = Nothing
For I = 1 To Len(S)
C = I Mod Len(Key)
If C = 0 Then C = Len(Key)
S2 = S2 & Chr(Asc(Mid(Key, C, 1)) Xor Asc(Mid(S, I, 1)))
Next
Encrypt = S2
End Function
Public Function Decrypt(ByVal Str As String, ByVal Key As String) As String
Dim C As Integer
Dim S2 As String = Nothing
For I = 1 To Len(Str)
C = I Mod Len(Key)
If C = 0 Then C = Len(Key)
S2 = S2 & (Chr(Asc(Mid(Key, C, 1)) Xor Asc(Mid(Str, I, 1))))
Next
Dim NewKeys() As String = Split(S2, " ")
For I = 0 To UBound(NewKeys)
Dim NKC As Char() = CType(NewKeys(I), Char())
Array.Reverse(NKC)
NewKeys(I) = CType(NKC, String)
Next
Dim KeyChar As Char() = CType(Key, Char())
Dim KeyAsc(UBound(KeyChar)) As Integer
For I = 0 To UBound(KeyChar)
KeyAsc(I) = Asc(KeyChar(I))
Next
Dim KeyLen(UBound(NewKeys)) As String
Dim II As Integer = 0
For I = 0 To UBound(KeyLen)
KeyLen(I) = CStr(KeyAsc(II))
If II = (UBound(KeyAsc)) Then
II = 0
Else
II = II + 1
End If
Next
For I = 0 To UBound(NewKeys)
NewKeys(I) = CStr(CInt(NewKeys(I)) / CInt(KeyLen(I)))
Next
For I = 0 To UBound(NewKeys)
NewKeys(I) = Chr(CInt(NewKeys(I)))
Next
Dim S As String = Nothing
S = NewKeys(0)
For I = 1 To UBound(NewKeys)
S = S & NewKeys(I)
Next
Decrypt = S
End Function
End Module