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) ' 清空回收站, 確認(rèn)
- ' 若有錯(cuò)誤出現(xiàn)，則返回回收站圖示
- If retval <> 0 Then ' error
- retval = SHUpdateRecycleBinIcon()
- End If
- End Sub
- Private Sub Command2_Click()
- Dim retval As Long ' return value
- ' 清空回收站, 不確認(rèn)
- retval = SHEmptyRecycleBin(RecycleBin.hwnd, "", SHERB_NOCONFIRMATION)
- ' 若有錯(cuò)誤出現(xiàn),，則返回回收站圖示
- If retval <> 0 Then ' error
- retval = SHUpdateRecycleBinIcon()
- End If
- Command1_Click
- End Sub
復(fù)制代碼
28.獲得系統(tǒng)文件夾的路徑
- 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
復(fù)制代碼
29.動(dòng)態(tài)增加控件并響應(yīng)事件
- Option Explicit
- '通過使用WithEvents關(guān)鍵字聲明一個(gè)對(duì)象變量為新的命令按鈕
- 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
- '刪除控件(注：只能刪除動(dòng)態(tài)增加的控件)
- 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 "您選中的是動(dòng)態(tài)增加的按鈕,！"
- End Sub
復(fù)制代碼
30.得到磁盤序列號(hào)
- 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
- 調(diào)用形式 Label1.Caption = GetSerialNumber("c:\")
復(fù)制代碼
31.打開屏幕保護(hù)
- 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
- '我們將要調(diào)用的那個(gè)消息,，在MSDN中搜索WM_SYSCOMMAND就可以找到具體說明
- Const WM_SYSCOMMAND = &H112
- '這個(gè)參數(shù)指明了我們讓系統(tǒng)啟動(dòng)屏幕保護(hù)
- Const SC_SCREENSAVE = &HF140&
- Private Sub Command1_Click()
- SendMessage Me.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0
- End Sub
復(fù)制代碼
32.獲得本機(jī)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 = "你機(jī)子上有 " & Listing.dEntrys & " 個(gè) 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
復(fù)制代碼
|
