打开APP
未登录
开通VIP,畅享免费电子书等14项超值服
开通VIP
首页
好书
留言交流
下载APP
联系客服
VB入门技巧N例(9)
zele
>《VB》
2011.01.31
关注
27.清空回收站
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
复制代码
29.动态增加控件并响应事件
Option Explicit
'通过使用WithEvents关键字声明一个对象变量为新的命令按钮
Private WithEvents NewButton As CommandButton
'增加控件
Private Sub Command1_Click()
If NewButton Is Nothing Then
'增加新的按钮cmdNew
Set NewButton = Controls.Add("VB.CommandButton", "cmdNew", Me)
'确定新增按钮cmdNew的位置
NewButton.Move Command1.Left + Command1.Width + 240, Command1.Top
NewButton.Caption = "新增的按钮"
NewButton.Visible = True
End If
End Sub
'删除控件(注:只能删除动态增加的控件)
Private Sub Command2_Click()
If NewButton Is Nothing Then
Else
Controls.Remove NewButton
Set NewButton = Nothing
End If
End Sub
'新增控件的单击事件
Private Sub NewButton_Click()
MsgBox "您选中的是动态增加的按钮!"
End Sub
复制代码
30.得到磁盘序列号
Function GetSerialNumber(strDrive As String) As Long
Dim SerialNum As Long
Dim Res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
Res = GetVolumeInformation(strDrive, Temp1, Len(Temp1), SerialNum, 0, 0, Temp2, _
Len(Temp2))
GetSerialNumber = SerialNum
End Function
调用形式 Label1.Caption = GetSerialNumber("c:\")
复制代码
31.打开屏幕保护
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
'我们将要调用的那个消息,在MSDN中搜索WM_SYSCOMMAND就可以找到具体说明
Const WM_SYSCOMMAND = &H112
'这个参数指明了我们让系统启动屏幕保护
Const SC_SCREENSAVE = &HF140&
Private Sub Command1_Click()
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0
End Sub
复制代码
32.获得本机IP地址
方法一:利用Winsock控件
winsockip.localip
方法二:
Private Const MAX_IP = 255
Private Type IPINFO
dwAddr As Long
dwIndex As Long
dwMask As Long
dwBCastAddr As Long
dwReasmSize As Long
unused1 As Integer
unused2 As Integer
End Type
Private Type MIB_IPADDRTABLE
dEntrys As Long
mIPInfo(MAX_IP) As IPINFO
End Type
Private Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination _
As Any, Source As Any, ByVal Length As
Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, _
pdwSize As Long, ByVal Sort As Long) As Long
Dim strIP As String
Private Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Public Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True
If Ret <= 0 Then Exit Sub
ReDim bBytes(0 To Ret - 1) As Byte
GetIpAddrTable bBytes(0), Ret, False
CopyMemory Listing.dEntrys, bBytes(0), 4
strIP = "你机子上有 " & Listing.dEntrys & " 个 IP 地址。" & vbCrLf
strIP = strIP & "------------------------------------------------" & vbCrLf & vbCrLf
For Tel = 0 To Listing.dEntrys - 1
CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len _(Listing.mIPInfo(Tel))
strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
Next
Exit Sub
END1:
MsgBox "ERROR"
End Sub
Private Sub Form_Load()
Start
MsgBox strIP
End Sub
复制代码
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报
。
打开APP,阅读全文并永久保存
查看更多类似文章
猜你喜欢
类似文章
【热】
打开小程序,算一算2024你的财运
VB关于webbrowser相关操作大全
IE webbrowser技巧集
特殊网页爬虫——VBA开发文档
VB中获取exe自身所在路径的几种方法
VBA常用代码解析(第四十讲)
VB实用代码,收藏!!
更多类似文章 >>
生活服务
热点新闻
留言交流
回顶部
联系我们
分享
收藏
点击这里,查看已保存的文章
导长图
关注
一键复制
下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!
联系客服
微信登录中...
请勿关闭此页面
先别划走!
送你5元优惠券,购买VIP限时立减!
5
元
优惠券
优惠券还有
10:00
过期
马上使用
×