假設有應用 myapp.exe 及一個注冊文件 myapp.reg，下面的代碼將自動裝入注冊設置。
Dim strFile As String
strFile = App.Path & "\myapp.reg"
If Len(Dir$(strFile)) > 1 Then
lngRet = Shell("Regedit.exe /s " & strFile, vbNormalFocus)
End If

確定當前 WIN95 的啟動狀態(tài)
定義：
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CLEANBOOT = 67
使用：
Select Case GetSystemMetrics(SM_CLEANBOOT)
Case 1: MsgBox "在安全模式。"
Case 2: MsgBox "在帶網(wǎng)絡環(huán)境的安全模式。"
Case Else: MsgBox "正常模式。"
End Select
返回

聲明：
Declare Function GetTickCount& Lib "kernel32" ()

使用該函數(shù)，可以得到從開機開時的運行時間，以 1/1000 秒記數(shù)。
返回

聲明：
Declare Function AddFontResource Lib "gdi32" Alias "AddFontResourceA" (ByVal lpFileName As String) As Long
Declare Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" (ByVal lpFileName As String) As Long
增加字體：
Dim lResult As Long
lResult = AddFontResource("c:\myApp\myFont.ttf")
刪除字體：
Dim lResult As Long
lResult = RemoveFontResource("c:\myApp\myFont.ttf")
返回

任務欄一般是顯示在窗口的最底下，但有時我們需要隱藏它。
聲明：
Dim hWnd1 As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
隱藏的例子：
hWnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
顯示的例子：
Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)

退出并關閉 Windows
聲明：
Global Const EWX_LOGOFF = 0
Global Const EWX_REBOOT = 2
Global Const EWX_SHUTDOWN = 1
Declare Function ExitWindows Lib "User32" Alias "ExitWindowsEx" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
使用：
lresult = ExitWindowsEx(EWX_SHUTDOWN, 0&) '關閉計算機
lresult = ExitWindowsEx(EWX_REBOOT, 0&) '重新啟動計算機
參見： 文件下載中的 X020 模擬關閉系統(tǒng)
返回

最近用過的文件會自動出現(xiàn)在文檔菜單中，只要用很少的代碼，在你的程序中也可實現(xiàn)這樣的功能：
聲明：
Public Const SHARD_PATH = &H2&
Public Declare Function SHAddToRecentDocs Lib "shell32.dll" (ByVal dwFlags As Long, ByVal dwData As String) As Long
函數(shù)：
Public Sub AddRecent(strFile As String)
Dim lRetVal As Long
If strFile = "" Then
lRetVal = SHAddToRecentDocs(SHARD_PATH, vbNullString)
Else
lRetVal = SHAddToRecentDocs(SHARD_PATH, strFile)
End If
End Sub
例子：
AddRecent "C:\myfile.txt"
AddRecent "" '清除文檔菜單
返回

聲明：
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
例子：
Dim S As String * 80, Length As Long
Dim WinPath As String, SysPath As String
Length = GetWindowsDirectory(S, Len(S))
WinPath = Left(S, Length)
Length = GetSystemDirectory(S, Len(S))
SysPath = Left(S, Length)

WinPath 為 Windows 的所在目錄，SysPath 為 System 所在目錄。
返回

聲明：
Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
例子：
Dim LocaleID As Long
LocalID = GetSystemDefaultLCID

= &H404 中文繁體（臺灣）
= &H804 中文簡體（大陸）
= &H409 英文 ...
返回

在進行重要的操作或特定的情況下，我們可能需要重新驗證用戶的口令，以提高系統(tǒng)的安全性。

Private Declare Function WNetVerifyPassword Lib "mpr.dll" Alias "WNetVerifyPasswordA" (ByVal lpszPassword As String, ByRef pfMatch As Long) As Long

Function VerifyPassWin95(sPassword As String) As Boolean
Dim lRetVal As Long
If (WNetVerifyPassword(sPassword, lRetVal)) <> 0 Then
MsgBox "VerifyPassWin95: Application Error"
Else
If lRetVal <> 0 Then
VerifyPassWin95 = True
Else
VerifyPassWin95 = False
End If
End If
End Function
返回

'get format of currency with API call GetLocalInfo
Public Const LOCALE_USER_DEFAULT = &H400
Public Const LOCALE_SCURRENCY = &H14 ' local monetary symbol
Public Const LOCALE_SINTLSYMBOL = &H15 ' intl monetary symbol
Public Const LOCALE_SMONDECIMALSEP = &H16 ' monetary decimal separator
Public Const LOCALE_SMONTHOUSANDSEP = &H17 ' monetary thousand separator
Public Const LOCALE_SMONGROUPING = &H18 ' monetary grouping
Public Const LOCALE_ICURRDIGITS = &H19 ' # local monetary digits

Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long


'
' Locale specific information
'
Public Sub GetInfo()
Dim buffer As String * 100
Dim dl&

'compare this with
'Start/Settings/Control Panel/Regional Settings/Currency

#If Win32 Then
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, buffer, 99)
Form1.list1.AddItem " Local curency symbol: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SINTLSYMBOL, buffer, 99)
Form1.list1.AddItem " International currency symbol: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONDECIMALSEP, buffer, 99)
Form1.list1.AddItem " Decimaal separator: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONTHOUSANDSEP, buffer, 99)
Form1.list1.AddItem " Thousand separator: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONGROUPING, buffer, 99)
Form1.list1.AddItem " Number of digits in group: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_ICURRDIGITS, buffer, 99)
Form1.list1.AddItem " Number of digits behind the decimal separator: " & LPSTRToVBString(buffer)
#Else
Form1.list1.AddItem " Not implemented under Win16"
#End If

End Sub


'
' Extracts a VB string from a buffer containing a null terminated
' string
Public Function LPSTRToVBString$(ByVal s$)
Dim nullpos&
nullpos& = InStr(s$, Chr$(0))
If nullpos > 0 Then
LPSTRToVBString = Left$(s$, nullpos - 1)
Else
LPSTRToVBString = ""
End If
End Function
返回

下面的函數(shù)演示如何獲得某個文件夾下的所有子目錄
Public Sub HaalDirOp(ByVal Path$)
Dim vDirName As String, LastDir As String

Screen.MousePointer = vbHourglass
If Right(Path$, 1) <> "\" Then Path$ = Path$ & "\"
vDirName = Dir(Path, vbDirectory) ' Retrieve the first entry.
Do While Not vDirName = ""
If vDirName <> "." And vDirName <> ".." Then
If (GetAttr(Path & vDirName) And vbDirectory) = vbDirectory Then
LastDir = vDirName

MsgBox vDirName

Call HaalDirOp(Path$ & vDirName)

vDirName = Dir(Path$, vbDirectory)
Do Until vDirName = LastDir Or vDirName = ""
vDirName = Dir
Loop
If vDirName = "" Then Exit Do
End If
End If
vDirName = Dir
Loop
Screen.MousePointer = vbNormal
End Sub
返回

Declare Function OSfCreateShellGroup Lib "STKIT432.DLL" Alias "fCreateShellFolder" _
(ByVal lpstrDirName As String) As Long

Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal _
lpstrFolderName As String, ByVal lpstrLinkName As String, _
ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long


'-----------------------------------------------------------
' SUB: CreateShellGroup
'
' Creates a new program group off of Start>Programs in the
' Windows 95 shell if the specified folder doesn't already exist.
'
' IN: [strFolderName] - text name of the folder.
' This parameter may not contain
' backslashes.
' ex: "My Application" - this creates
' the folder Start>Programs>My Application
'-----------------------------------------------------------
'
Public Sub CreateShellGroup(ByVal strFolderName As String)

If strFolderName = "" Then
Exit Sub
End If

Dim fSuccess As Boolean
fSuccess = OSfCreateShellGroup(strFolderName)

End Sub


'use as

Dim res&
Dim vLocation$

vLocation$ = "testing"
Call CreateShellGroup(vLocation$)
vLocation$ = "..\..\Start Menu\Programs\" & vLocation$
res& = fCreateShellLink(vLocation, [title], [path&executable], "")

'where
' title = name to be mentioned
' path&executable = full path and executable name of application
返回

1. 建立一個新的工程文件。

2. 將一個CommandButton (Name屬性設置為 cmdForceShutdown) 加入到 Form1。

3. 將下面的代碼加入到Form1的 General Declarations 段:

Option Explicit

Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type

' Beginning of Code
Private Const EWX_SHUTDOWN As Long = 1
Private Const EWX_FORCE As Long = 4
Private Const EWX_REBOOT = 2

Private Declare Function ExitWindowsEx Lib "user32" ( _
ByVal dwOptions As Long, ByVal dwReserved As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" ( _
ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" _
Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, _
ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" ( _
ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, _
PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Sub AdjustToken()

Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
TOKEN_QUERY), hdlTokenHandle

' Get the LUID for shutdown privilege.
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

tkp.PrivilegeCount = 1 ' One privilege to set
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this
' process.
AdjustTokenPrivileges hdlTokenHandle, False, tkp, _
Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded

End Sub

Private Sub cmdForceShutdown_Click()
AdjustToken
ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE Or EWX_REBOOT), &HFFFF
End Sub

返回

    在Windows系統(tǒng)中包含了一些圖標，這些圖標用于在系統(tǒng)消息框中顯示一些提示，例如驚嘆號圖標等。，這個技巧介紹了如何在VB程序中利用這些圖標。
    這些系統(tǒng)圖標的定義如下：

    Const IDI_APPLICATION = 32512&
    Const IDI_HAND = 32513&
    Const IDI_QUESTION = 32514&
    Const IDI_EXCLAMATION = 32515&
    Const IDI_ASTERISK = 32516&

    在在VB中使用這些圖標之前，你需要首先利用Windows API函數(shù)LoadIcon將圖標載如到需要顯示圖標的對象的繪圖設備中，利用Windows API函數(shù)GetWindowDC可以獲得一個對象（例如PictureBox等）的圖形繪圖設備句柄。GetWindowsDC的定義如下:

    Private Declare Function GetWindowDC Lib "User" (ByVal hWnd As Integer)As Integer
    (注：如果上面的函數(shù)定義在你的瀏覽器中顯示為兩行或以上，則在你的程序中必須書寫在一行以內(nèi)）
    上面的函數(shù)中的參數(shù)hWnd指定了需要獲得繪圖設備句柄的對象的窗口，如果函數(shù)調(diào)用成功的話，函數(shù)將返回對象的繪圖句柄，否則將返回0。
    當你不在需要使用繪圖設備時，需要調(diào)用Windows API函數(shù)ReleaseDC來釋放繪圖設備句柄。
    當獲得了繪圖誰被句柄之后，你可以調(diào)用LoadIcon函數(shù)來在繪圖設備上顯示圖標了。因為這些圖標是系統(tǒng)內(nèi)建的，所以我們需要將LoadIcon函數(shù)的第一個參數(shù)的值設置為0，而第二個參數(shù)需定義為上面定義的圖標常量。
    范例
    1. 在VB中建立一個新的工程文件。
    2. 將下面的代碼加入到form1的代碼窗口中（注意沒一個定義必須書寫在一行之內(nèi)）:

Private Declare Function DrawIcon Lib "User" (ByVal hDC As Integer, ByVal X As Integer, ByVal y As Integer, ByVal hIcon As Integer) As Integer
Private Declare Function LoadIcon Lib "User" (ByVal hInstance As Integer, ByVal lpIconName As Any) As Integer
Private Declare Function GetWindowDC Lib "User" (ByVal hWnd As Integer) As Integer
Private Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
Const IDI_EXCLAMATION = 32515&

3. 在Form1中加入一個PictureBox控件，將它的AutoRedraw 屬性設置為 True。
4. 在Form1中加入一個CommandButton控件。
5. 將下面的代碼加入到Command1的Click事件中：

Private Sub Command1_Click()
Dim hDCCur As Long
Dim hIcon As Integer
Dim X As Integer

hDCCur = GetWindowDC(Picture1.hWnd)
hIcon = LoadIcon(0, IDI_EXCLAMATION)
X = DrawIcon(hDCCur, 0, 0, hIcon)
Call ReleaseDC(Picture1.hWnd, hDCCur)
End Sub
返回

Abstract
The Microsoft Visual Basic List Box control lets you add individual items to
create a list of data. This article explains how to add tab stops to create
multicolumn items, no matter what type of font or font size is used.

Using the GetDialogBaseUnits Function
When adding items to a List Box control, you can create columns of data by
inserting a tab stop within the control. However, the data will only be correctly
aligned in the columns if you use the default font and font size used by the List
Box control.

As the example program below shows, you can use the Microsoft Windows俺
application programming interface (API) GetDialogBaseUnits function to determine
the width and height of the average character in the selected font. The width and
height of the character are returned in dialog base units. From these values, you
can calculate the average width of the characters in the selected font.
After you know the width of the character set, you can add the tab stops to the
List Box control. Then, using whatever font and font size you want, you can add
new items to the control. The columns of data will appear in separate rows.

Example Program
This program shows how to add tab stops to a List Box control. No matter what font
or font size is used when adding items to the control, the columns will line up
correctly.

1. Create a new project in Visual Basic. Form1 is created by default.
2. Add the following Constant and Declare statements to the General Declarations
section of Form1 (note that each Declare statement must be typed as a single
line of text):

Private Declare Function GetFocus Lib "user32" () As Long

Private Declare Function GetDialogBaseUnits Lib "user32" () 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
Private Declare Sub APISetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long)

Const WM_USER = &H400
Const LB_SETTABSTOPS = WM_USER + 19
3. Add the following code to the Form_Load event for Form1:

Private Sub Form_Load()
Dim TB As String * 1
Dim OldHandle As Integer
Dim ListHandle As Integer
Dim DlgWidthUnits As Integer
Dim I As Integer
ReDim TabStop(2) As Integer

TabStop(0) = 10
TabStop(1) = 30
TabStop(2) = 50

TB = Chr$(9)
Show
OldHandle = Getfocus()

List1.SetFocus
ListHandle = Getfocus()
DlgWidthUnits = (GetDialogBaseUnits() Mod 65536) / 2

For I = 0 To 2
TabStop(I) = TabStop(I) * DlgWidthUnits
Next I

Call SendMessage(ListHandle, LB_SETTABSTOPS, 3, TabStop(0))
Call APISetFocus(OldHandle)
List1.AddItem "Item" + TB + "Quan." + TB + "Price"
List1.AddItem "Disks" + TB + "10" + TB + "$9.50"
List1.AddItem "Paper" + TB + "12" + TB + "$22.50"
End Sub

4. Add a List Box control to Form1. List1 is created by default.