VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CExploitScanner"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'License:   GPL
'Copyright: 2005 iDefense a Verisign Company
'Site:      http://labs.idefense.com
'
'Author:    David Zimmer <david@idefense.com, dzzie@yahoo.com>
'
'         This program is free software; you can redistribute it and/or modify it
'         under the terms of the GNU General Public License as published by the Free
'         Software Foundation; either version 2 of the License, or (at your option)
'         any later version.
'
'         This program is distributed in the hope that it will be useful, but WITHOUT
'         ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
'         FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
'         more details.
'
'         You should have received a copy of the GNU General Public License along with
'         this program; if not, write to the Free Software Foundation, Inc., 59 Temple
'         Place, Suite 330, Boston, MA 02111-1307 USA

Const Bagle1 = "\x43\xFF\xFF\xFF\x30\x30\x30\x01\x0A\x1F\x2B\x28\x2B\xA1\x32\x01"

Const Bagle2 = "\x43\xFF\xFF\xFF\x30\x30\x30\x01\x0A\x28\x91\xA1\x2B\xE6\x60\x2F\x32\x8F\x60\x15\x1A\x20\x1A"

Const dameware = "\x30\x11\x00\x00\x00\x00\x00\x00" & _
                 "\xC3\xF5\x28\x5C\x8F\xC2\x0D\x40" & _
                 "\x00\x00\x00\x00\x00\x00\x00\x00"

Const dcom = "\x05\x00\x00\x03\x10\x00\x00\x00\xE8\x03\x00\x00\xE5\x00\x00\x00" & _
            "\xD0\x03\x00\x00\x01\x00\x04\x00\x05\x00\x06\x00\x01\x00\x00\x00" & _
            "\x00\x00\x00\x00\x32\x24\x58\xFD\xCC\x45\x64\x49\xB0\x70\xDD\xAE"

Const lsass = "\x52\x4B\x20\x50\x52\x4F\x47\x52\x41\x4D\x20\x31\x2E\x30\x00\x02" & _
              "\x4C\x41\x4E\x4D\x41\x4E\x31\x2E\x30\x00\x02\x57\x69\x6E\x64\x6F" & _
              "\x77\x73\x20\x66\x6F\x72\x20\x57\x6F\x72\x6B\x67\x72\x6F\x75\x70"

Const workstation = "\xeb\x19\x5e\x31\xc9\x81\xe9\x89\xff" & _
                    "\xff\xff\x81\x36\x80\xbf\x32\x94\x81\xee\xfc\xff\xff\xff\xe2\xf2" & _
                    "\xeb\x05\xe8\xe2\xff\xff\xff\x03\x53\x06\x1f\x74\x57\x75\x95\x80" & _
                    "\xbf\xbb\x92\x7f\x89\x5a\x1a\xce\xb1\xde\x7c\xe1\xbe\x32\x94\x09"

Const Doom = "\x85\x13\x3c\x9e\xa2"


Const arcServer = "\x9b\x53\x45\x52\x56\x49\x43\x45\x50\x43\x18\xc0\xa8\x02\x67"


Const wins = "\x00\x00\x00\x00\x60\x56\x02\x01\x00\x1F\x6E\x03" & _
             "\x00\x1F\x6E\x03\x08\xFE\x66\x03\x00"

Const veritas = "\x31\xF6\xC1\xEC\x0C\xC1\xE4\x0C\x89\xE7\x89\xFB\x6A\x01\x8B\x74" & _
                "\x24\xFE\x31\xD2\x52\x42\xC1\xE2\x10\x52\x57\x56\xB8\x00\x00\x00" & _
                "\x00\xC1\xE8\x08\xFF\x10\x85\xC0\x79\x07\x89\xDC\x4E\x85\xF6\x75"


'kuang Constants
'#define K2_UPLOAD_FILE  0x46445055
'#define K2_ERROR        0x52525245
'#define K2_DONE         0x454E4F44
'#define K2_RUN_FILE     0x464E5552
'#define K2_QUIT         0x54495551
Const WebDav = "<g:searchrequest xmlns:g=""DAV:"">"
Const mssql = "EXEC master..xp_cmdshell"
Const netdevil = "pass_pleaz"
Const Optix = "022¬OPtest¬v1."
Const sub71 = "PWD715"
Const sub72 = "PWD14438136782715101980"

Private Declare Function GetTickCount Lib "kernel32" () As Long

Dim sigs() As String
Dim names() As String
Dim external_sigs As String


Private Function toBytes(sin) As String
    Dim x() As String, i
    Dim k As Byte
     
    x = Split(sin, "\x")
    
    For i = 0 To UBound(x)
        If Len(x(i)) > 0 Then
            k = CByte("&h" & x(i))
            toBytes = toBytes & Chr(k)
        End If
    Next
    
End Function

Function KnownExploits() As Collection
    
    Dim i As Long
    Dim c As New Collection
    
    For i = 0 To UBound(names)
        c.Add names(i)
    Next
    
    Set KnownExploits = c
    
End Function

Private Sub push(ary, value) 'this modifies parent ary object
    On Error GoTo init
    Dim x
    x = UBound(ary) '<-throws Error If Not initalized
    ReDim Preserve ary(UBound(ary) + 1)
    ary(UBound(ary)) = value
    Exit Sub
init:     ReDim ary(0): ary(0) = value
End Sub

Function Scan(fPath As String) As Collection
    On Error GoTo hell
    
    Dim b() As Byte
    Dim offset As Long
    Dim tmp As String
    Dim i As Long
    Dim f As Long
    Dim ret As New Collection
    Dim start

    If Not FileExists(fPath) Then
        ret.Add "File not found: " & fPath
        GoTo retnow
    End If
    
    If FileLen(fPath) < 1000 Then
        ReDim b(FileLen(fPath))
    Else
        ReDim b(1000)
    End If
    

    ret.Add "Scanning for " & UBound(sigs) & " signatures"
    
    f = FreeFile
    offset = 1
    start = GetTickCount()
    
    Open fPath For Binary As f
    
    While Not EOF(f)
    
        Get f, offset, b()
        
        tmp = StrConv(b, vbUnicode)
        
        For i = 0 To UBound(sigs)
            If InStr(tmp, sigs(i)) > 0 Then
                 ret.Add "*** Found: " & names(i)
            End If
        Next
        
        offset = offset + 950
        If offset > LOF(f) Then ReDim b(offset - LOF(f))
        
    Wend
    
    Close f
        
        start = GetTickCount() - start
        
        ret.Add "Scan Complete: " & CLng(FileLen(fPath) / 1024) & "Kb in " & (start / 1000) & " seconds"
retnow: Set Scan = ret

  Exit Function
hell:
    MsgBox "Error: " & Err.Description, vbExclamation
    Close
End Function



Private Sub Class_Initialize()
    
    push sigs, toBytes(Bagle1)
    push names, "Bagle Backdoor Exploitation 1"
     
    push sigs, toBytes(Bagle2)
    push names, "Bagle Backdoor Exploitation 2"
    
    push sigs, toBytes(dameware)
    push names, "DameWare Mini Remote Control Buffer Overflow"
    
    push sigs, toBytes(dcom)
    push names, "RPC DCOM Exploit MS03-026"
    
    push sigs, toBytes(lsass)
    push names, "LSASS exploit - MS04-011"
    
    push sigs, toBytes(workstation)
    push names, "Microsoft Workstation Vulnurability"
    
    push sigs, toBytes(Doom)
    push names, "MyDoom Backdoor Exploitation"
    
    push sigs, WebDav
    push names, "IIS 5.0 WebDAV Exploit"
    
    push sigs, mssql
    push names, "Spreads Via Weak Passwords in MSSQL Server"
    
    push sigs, netdevil
    push names, "NetDevil Exploit"
    
    push sigs, Optix
    push names, "Optix Trojan Default Password"
    
    push sigs, sub71
    push names, "Sub7 Default Password 1"
    
    push sigs, sub72
    push names, "Sub7 Default Password 2"
     
    push sigs, arcServer
    push names, "BrightStor ARCserve Backup Remote Buffer Overflow Vulnerability (Feb. 13, 2005)"

    push sigs, veritas
    push names, "Veritas Backup Exec Agent Browser Registration Request Buffer Overflow Vulnerability (Nov. 3, 2004)"

    push sigs, wins
    push names, "Microsoft WINS Name Validation Buffer Overflow Vulnerability (Dec. 14, 2004)"
 
    external_sigs = App.path & "\exploit_sigs.txt"
    
    On Error Resume Next
    Dim i As Long, tmp, x
    
    If FileExists(external_sigs) Then
        tmp = ReadFile(external_sigs)
        tmp = Split(tmp, vbCrLf)
        For i = 0 To UBound(tmp)
            tmp(i) = Trim(tmp(i))
            If Len(tmp(i)) > 0 Then
                x = Split(tmp(i), "=")
                If UBound(x) = 1 Then
                    If InStr(x(1), "\x") > 0 Then
                        push sigs, toBytes(Trim(x(1)))
                    Else
                        push sigs, Trim(x(1))
                    End If
                    push names, Trim(x(0))
                Else
                    MsgBox "Line " & i & " of external sig file bad format", vbInformation
                End If
            End If
        Next
    End If
                
        
End Sub

 

Function FileExists(path) As Boolean
  On Error Resume Next
  If Len(path) = 0 Then Exit Function
  If Dir(path, vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then FileExists = True
End Function



Private Function ReadFile(filename)
  Dim f, temp
  f = FreeFile
  temp = ""
   Open filename For Binary As #f        ' Open file.(can be text or image)
     temp = Input(FileLen(filename), #f) ' Get entire Files data
   Close #f
   ReadFile = temp
End Function
