- 浏览: 25548 次
最新评论
发几个vb整人小程序代码.第一次发帖.希望大家多多支持
2009年12月25日
1楼
本人刚学vb一天而已.
找个几个整人的代码做着玩玩.
觉得还不错.
就发来给大家分享一下.
希望大家不要介意.
本人qq450721736.
喜欢vb的加我咯.
一起学习vb.
--------------------------------------------------
这个是关闭桌面所有窗口
(直接复制上去就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 "都叫你别冲动了.重启吧~"
End
End Sub
Private Sub Form_Load()
I = 0
flag = fase
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Text1 = "小鹏提醒你,别激动.!"
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 回复
ww0034 0位粉丝 3楼
这个是翻转屏幕代码
(添加一个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 回复
ww0034 0位粉丝 4楼
这个是关闭QQ的代码
(需要添加一个Command1.一个text1)
这个程序打包的时候,金山毒霸说是病毒
希望懂的帮我看一下
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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 = "想关点退出啊.怎么那么笨!"
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) ':获得进程“快照”的句柄
proc.dwSize = Len(proc)
theloop = ProcessFirst(snap, proc) ':获取第一个进程,并得到其返回值
i = 0
While theloop 0 ':当返回值非零时继续获取下一个进程
exename = proc.szExeFile
If Left(LCase(exename), 6) = "qq.exe" Then
hand = OpenProcess(PROCESS_TERMINATE, True, proc.th32ProcessID) ':获取进程句柄
TerminateProcess hand, 0 ':关闭进程
End If
theloop = ProcessNext(snap, proc)
Wend
CloseHandle snap ':关闭进程“快照”句柄
MsgBox "真遗憾,您扣扣掉线了!"
End
End Sub
2009-9-26 16:22 回复
ww0034 0位粉丝 5楼
这个是爱不爱我代码,挺好玩的这个
(需要添加两个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 "我也爱你!"
End
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Me.FontSize = 30
Me.Print "你爱不爱我?"
Command1.Caption = "不爱"
Command2.Caption = "爱"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = 1
End Sub
2009-9-26 16:22 回复
ww0034 0位粉丝 6楼
应用软件
--------------------------------------------------
繁体简体转换
(需要添加4个Cammand.1个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
'简转繁
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
'繁转简
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
--------------------------------------------------
打开我的电脑等
(需要添加5个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
'网上邻居
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
发表评论
-
在Windows下安装Hadoop遇到的几个问题
2012-01-20 01:02 848在Windows下安装Hadoop遇到 ... -
windows下使用gcc编译boost库
2012-01-20 01:02 3527windows下使用gcc编译boost ... -
Visual Studio 2008 SP1 补丁安装时发生严重错误-安装失败-解决方法整合版!-分享
2012-01-20 01:02 2881Visual Studio 2008 SP1 补丁 ... -
编译 boost
2012-01-20 01:02 799编译 boost 2011年05月17日 ... -
将 Flex 3 的应用程序迁移到 Flex 4 ―第 1 部分:将 Flex 3 Dashboard 应用程序导入 Flash Builder 4
2012-01-20 01:02 691将 Flex 3 的应用程序迁移到 Flex 4 ―第 1 部 ... -
网络语言进课堂:上海禁止北京面对
2012-01-19 08:51 655网络语言进课堂:上海禁 ... -
跟着我去流浪
2012-01-19 08:51 617跟着我去流浪 2011年09 ... -
关于非诚勿扰
2012-01-19 08:51 650关于非诚勿扰 2012年01月17日 ... -
全国十大美女城市客观排行 2008/03/08 11:0
2012-01-19 08:51 693全国十大美女城市客观排行 2008/03/08 11:0 2 ... -
CUDA的VISUAL STUDIO 2008环境配置(转)
2012-01-17 01:19 1048CUDA的VISUAL STUDIO 2008环境配置(转) ... -
3dsmax使用哪个版本好
2012-01-17 01:19 37393dsmax使用哪个版本好 20 ... -
关于Android的一些设计
2012-01-17 01:19 655关于Android的一些设计 2012年01月13日 ... -
WMI(Windows管理规范)常见问题解答
2012-01-17 01:19 715WMI(Windows管理规范)常见 ... -
下载安卓源代码过程
2012-01-17 01:19 685下载安卓源代码过程 2011年12月23日 linux和 ... -
学编程的同学看看
2012-01-15 20:02 630学编程的同学看看 2009年11月21日 ... -
三种语言的下载者源代码:C Delphi Vb
2012-01-15 20:02 768三种语言的下载者源代码:C Delphi Vb 2010年0 ... -
VB制作快捷打开电脑里的应用软件比如:我的电脑 网上邻居 等....
2012-01-15 20:01 625VB制作快捷打开电脑里的应用软件比如:我的电脑 网上邻居 等. ... -
VB如何连接帮助文件
2012-01-15 20:01 784VB如何连接帮助文件 2009年12月04日 VB如何 ... -
关于在后台实现前台表单的格式验证设计(annotation+spring aop)iteye技术网站
2012-01-11 12:12 730关于在后台实现前台表单的格式验证设计(annotation+s ... -
java操作word等
2012-01-11 12:12 503java操作word等 2011年05月01日 1、一个 ...
相关推荐
整人小程序 vb编写 命令关机
VB小程序源代码.pdf
12套VB操作题程序代码.pdf
通过大量的循环和大量的窗口程序达到整人效果,让被整对象欲哭无泪。此程序为VB代码,绿色安全环保,无人如何病毒程序添加,包含解药。
日记本VB源代码.呵呵.喜欢的就下吧...........
微软发布的VB数据库编程代码包.rar微软发布的VB数据库编程代码包.rar微软发布的VB数据库编程代码包.rar微软发布的VB数据库编程代码包.rar微软发布的VB数据库编程代码包.rar微软发布的VB数据库编程代码包.rar微软发布...
vb小程序代码收集.pdf
VB小程序代码实例.doc
VB整人程序 挂起所有正在运行的程序
精彩编程与编程技巧-一组VB实用小程序 ...
VB6.exe可以将cls模块、普通模块、窗体代码frm先生存汇编代码文件,然后再继续编译,但我们看不到这些代码,是因为编译器C2.exe隐藏或删除了,为了在VB6的程序里可以嵌入汇编代码或C代码,就要让C2.exe将这些汇编...
VB编程程序代码.doc
vb程序代码文件
Vb扫雷程序代码.doc
VB编程程序代码.pdf