VB入门技巧N例(9)

zele 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