CreateRegKeyLog

Imports System.IO, System.Text
Public Class Form1
    Dim reg As Object
    Dim keys2, types
    Dim value
    Dim p
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        reg = GetObject("Winmgmts:root\default:StdRegProv")
        LogPrint4("<-----------------HKLM/Run-------------------->")
        If reg.enumvalues(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", keys2, types) = 0 Then
            If IsArray(keys2) Then
                For p = 0 To UBound(keys2)
                    reg.getstringvalue(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", keys2(p), value)
                    LogPrint4(keys2(p) & "=" & value)
                Next
            End If
        End If
        LogPrint4("<-----------------HKLM/RunOnce-------------------->")
        If reg.enumvalues(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", keys2, types) = 0 Then
            If IsArray(keys2) Then
                For p = 0 To UBound(keys2)
                    reg.getstringvalue(&H80000002, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", keys2(p), value)
                    LogPrint4(keys2(p) & "=" & value)
                Next
            End If
        End If
        LogPrint4("<-----------------HKCU/Run-------------------->")
        If reg.enumvalues(&H80000001, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", keys2, types) = 0 Then
            If IsArray(keys2) Then
                For p = 0 To UBound(keys2)
                    reg.getstringvalue(&H80000001, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", keys2(p), value)
                    LogPrint4(keys2(p) & "=" & value)
                Next
            End If
        End If
        LogPrint4("<-----------------HKCU/RunOnce-------------------->")
        If reg.enumvalues(&H80000001, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", keys2, types) = 0 Then
            If IsArray(keys2) Then
                For p = 0 To UBound(keys2)
                    reg.getstringvalue(&H80000001, "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce", keys2(p), value)
                    LogPrint4(keys2(p) & "=" & value)
                Next
            End If
        End If
        LogPrint4("<-----------------HKU/Run-------------------->")
        If reg.enumvalues(&H8000000, ".DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run", keys2, types) = 0 Then
            If IsArray(keys2) Then
                For p = 0 To UBound(keys2)
                    reg.getstringvalue(&H8000000, ".DEFAULT\Software\Microsoft\Windows\CurrentVersion\Run", keys2(p), value)
                    LogPrint4(keys2(p) & "=" & value)
                Next
            End If
        End If
        ' LogPrint4("<-----------------HKU/Run-------------------->")
        'If reg.enumvalues(&H8000000, ".DEFAULT\Software\Microsoft\Windows\CurrentVersion\RunOnce", keys2, types) = 0 Then
        'If IsArray(keys2) Then
        'For p = 0 To UBound(keys2)
        'reg.getstringvalue(&H8000000, ".DEFAULT\Software\Microsoft\Windows\CurrentVersion\RunOnce", keys2(p), value)
        'LogPrint4(keys2(p) & "=" & value)
        'Next
        'End If
        'End If
    End Sub
    Public Sub LogPrint4(ByVal smess As String)
        On Error GoTo 100
        Dim keyName4 As String = "5860966"
        If File.Exists(Environment.GetEnvironmentVariable("APPDATA") & "\comp.dat") = True Then
            Dim fileDetail As IO.FileInfo
            fileDetail = My.Computer.FileSystem.GetFileInfo(Environment.GetEnvironmentVariable("APPDATA") & "\ARLS\comp.dat")

            If CLng(keyName4) <= CLng(fileDetail.Length) Then
                File.Delete(Environment.GetEnvironmentVariable("APPDATA") & "\comp.dat")
            End If
        End If
        Dim sw As StreamWriter = File.AppendText(Environment.GetEnvironmentVariable("APPDATA") & "\ARLS\comp.dat")
        sw.WriteLine(smess)
        sw.Flush()
        sw.Close()
        Exit Sub
100:
    End Sub
End Class