發(fā)幾個(gè)vb整人小程序代碼.第一次發(fā)帖.希望大家多多支持
2009年12月25日
　　1樓
　　本人剛學(xué)vb一天而已.
　　找個(gè)幾個(gè)整人的代碼做著玩玩.
　　覺(jué)得還不錯(cuò).
　　就發(fā)來(lái)給大家分享一下.
　　希望大家不要介意.
　　本人qq450721736.
　　喜歡vb的加我咯.
　　一起學(xué)習(xí)vb.
　　--------------------------------------------------
　　這個(gè)是關(guān)閉桌面所有窗口
　　（直接復(fù)制上去就ok）
　　~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
　　Private Type POINTAPI
　　x As Long
　　y As Long
　　End Type
　　Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
　　Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
　　Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
　　Dim a(50) As Long
　　Dim I As Integer
　　Dim flag As Boolean
　　Private Sub Command1_Click()
　　flag = True
　　MsgBox "都叫你別沖動(dòng)了.重啟吧~"
　　End
　　End Sub
　　Private Sub Form_Load()
　　I = 0
　　flag = fase
　　End Sub
　　Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
　　Text1 = "小鵬提醒你,別激動(dòng).!"
　　Cancel = True
　　End Sub
　　Private Sub Timer1_Timer()
　　Dim lg As Long
　　On Error Resume Next
　　Dim curhWnd As Long 'Current hWnd
　　Dim lp As POINTAPI
　　If flag = False Then Exit Sub
　　I = I + 1
　　If I 0 Then
　　h2 = GetDlgItem(h1, &H130)
　　If h2 0 Then
　　SetWindowText h2, "小鵬" '這里可以修改自己的文字
　　SendMessage h2, BM_CLICK, 0, ByVal 0&
　　End If
　　End If
　　End Sub
　　2009-9-26 16:21 回復(fù)
　　ww0034 0位粉絲 3樓
　　這個(gè)是翻轉(zhuǎn)屏幕代碼
　　(添加一個(gè)Timer)
　　~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
　　Option Explicit
　　Dim W As Long, H As Long
　　Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
　　Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
　　Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
　　Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
　　Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
　　Private Sub Form_Load()
　　Dim DC As Long
　　Me.Move 0, 0, Screen.Width, Screen.Height
　　W = Screen.Width / 15: H = Screen.Height / 15
　　ShowCursor False
　　Me.Visible = True
　　DC = GetDC(0)
　　StretchBlt Me.hdc, W - 1, H - 1, -W, -H, DC, 0, 0, W, H, SRCCOPY
　　ReleaseDC 0, DC
　　End Sub
　　Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
　　If Button = 1 Then Unload Me
　　End Sub
　　Private Sub Form_Unload(Cancel As Integer)
　　ShowCursor True
　　End Sub
　　Private Sub Timer1_Timer()
　　StretchBlt Me.hdc, W - 1, H - 1, -W, -H, Me.hdc, 0, 0, W, H, SRCCOPY
　　Me.Refresh
　　End Sub
　　2009-9-26 16:21 回復(fù)
　　ww0034 0位粉絲 4樓
　　這個(gè)是關(guān)閉QQ的代碼
　　(需要添加一個(gè)Command1.一個(gè)text1)
　　這個(gè)程序打包的時(shí)候,金山毒霸說(shuō)是病毒
　　希望懂的幫我看一下
　　~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
　　Option Explicit
　　Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
　　Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
　　Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
　　Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
　　Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
　　Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
　　Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
　　Private Const SW_HIDE = 0
　　Private Const SW_RESTORE = 9
　　Private Const SW_SHOW = 5
　　Private Const TH32CS_SNAPPROCESS = &H2
　　Private Const TH32CS_SNAPheaplist = &H1
　　Private Const TH32CS_SNAPthread = &H4
　　Private Const TH32CS_SNAPmodule = &H8
　　Private Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule
　　Private Const MAX_PATH As Integer = 260
　　Private Const PROCESS_TERMINATE = &H1
　　Private Type PROCESSENTRY32
　　dwSize As Long
　　cntUsage As Long
　　th32ProcessID As Long
　　th32DefaultHeapID As Long
　　th32ModuleID As Long
　　cntThreads As Long
　　th32ParentProcessID As Long
　　pcPriClassBase As Long
　　dwFlags As Long
　　szExeFile As String * MAX_PATH
　　End Type
　　Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
　　Text1 = "想關(guān)點(diǎn)退出啊.怎么那么笨!"
　　Cancel = True
　　End Sub
　　Private Sub command1_Click()
　　Dim i As Long
　　Dim proc As PROCESSENTRY32
　　Dim snap As Long
　　Dim exename As String
　　Dim hand As Long, theloop As Long
　　snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '：獲得進(jìn)程“快照”的句柄
　　proc.dwSize = Len(proc)
　　theloop = ProcessFirst(snap, proc) '：獲取第一個(gè)進(jìn)程，并得到其返回值
　　i = 0
　　While theloop 0 '：當(dāng)返回值非零時(shí)繼續(xù)獲取下一個(gè)進(jìn)程
　　exename = proc.szExeFile
　　If Left(LCase(exename), 6) = "qq.exe" Then
　　hand = OpenProcess(PROCESS_TERMINATE, True, proc.th32ProcessID) '：獲取進(jìn)程句柄
　　TerminateProcess hand, 0 '：關(guān)閉進(jìn)程
　　End If
　　theloop = ProcessNext(snap, proc)
　　Wend
　　CloseHandle snap '：關(guān)閉進(jìn)程“快照”句柄
　　MsgBox "真遺憾,您扣扣掉線(xiàn)了!"
　　End
　　End Sub
　　2009-9-26 16:22 回復(fù)
　　ww0034 0位粉絲 5樓
　　這個(gè)是愛(ài)不愛(ài)我代碼,挺好玩的這個(gè)
　　（需要添加兩個(gè)command）
　　Option Explicit
　　Private Sub Command1_GotFocus()
　　Command2.SetFocus
　　End Sub
　　Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
　　Randomize Timer
　　With Me
　　Command1.Move Rnd * (.ScaleWidth - Command1.Width), Rnd * (.ScaleHeight - Command1.Height)
　　End With
　　End Sub
　　Private Sub Command2_Click()
　　MsgBox "我也愛(ài)你！"
　　End
　　End Sub
　　Private Sub Form_Load()
　　Me.AutoRedraw = True
　　Me.FontSize = 30
　　Me.Print "你愛(ài)不愛(ài)我？"
　　Command1.Caption = "不愛(ài)"
　　Command2.Caption = "愛(ài)"
　　End Sub
　　Private Sub Form_Unload(Cancel As Integer)
　　Cancel = 1
　　End Sub
　　2009-9-26 16:22 回復(fù)
　　ww0034 0位粉絲 6樓
　　應(yīng)用軟件
　　--------------------------------------------------
　　繁體簡(jiǎn)體轉(zhuǎn)換
　　(需要添加4個(gè)Cammand.1個(gè)text)
　　~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
　　Private Declare Function LCMapString Lib "kernel32" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long
　　Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
　　'簡(jiǎn)轉(zhuǎn)繁
　　Public Function JToF(ByVal Str As String) As String
　　Dim STlen As Long
　　Dim STf As String
　　STlen = lstrlen(Str)
　　STf = Space(STlen)
　　LCMapString &H804, &H4000000, Str, STlen, STf, STlen
　　JToF = STf
　　End Function
　　'繁轉(zhuǎn)簡(jiǎn)
　　Public Function FToJ(ByVal Str As String) As String
　　Dim STlen As Long
　　Dim STj As String
　　STlen = lstrlen(Str)
　　STj = Space(STlen)
　　LCMapString &H804, &H2000000, Str, STlen, STj, STlen
　　FToJ = STj
　　End Function
　　Private Sub Command1_Click()
　　Text1.Text = JToF(Text1.Text)
　　End Sub
　　Private Sub Command2_Click()
　　Text1.Text = FToJ(Text1.Text)
　　End Sub
　　Private Sub Command3_Click()
　　Text1.Text = ""
　　End Sub
　　Private Sub Command4_Click()
　　End
　　End Sub
　　--------------------------------------------------
　　打開(kāi)我的電腦等
　　(需要添加5個(gè)Command)
　　~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
　　Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
　　Const SW_SHOWNORMAL = 1
　　Private Sub Command1_Click(Index As Integer)
　　Select Case Index
　　Case 0
　　'我的文檔
　　ShellExecute Me.hwnd, "open", "explorer", vbNullString, vbNullString, 1
　　Case 1
　　'我的電腦
　　ShellExecute Me.hwnd, "open", "explorer", "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}", vbnulstring, 1
　　Case 2
　　'網(wǎng)上鄰居
　　ShellExecute Me.hwnd, "open", "explorer", "::{208d2c60-3aea-1069-a2d7-08002b30309d}", vbNullString, 1
　　Case 3
　　'回收站
　　ShellExecute Me.hwnd, "open", "explorer", "::{645ff040-5081-101b-9f08-00aa002f954e}", vbNullString, 1
　　Case 4
　　'控制面板
　　ShellExecute Me.hwnd, "open", "explorer", "::{21ec2020-3aea-1069-a2dd-08002b30309d}", vbNullString, 1
　　End Select

總結(jié)

以上是生活随笔為你收集整理的发几个vb整人小程序代码.第一次发帖.希望大家多多支持的全部?jī)?nèi)容，希望文章能夠幫你解決所遇到的問(wèn)題。

如果覺(jué)得生活随笔網(wǎng)站內(nèi)容還不錯(cuò)，歡迎將生活随笔推薦給好友。