打开和关闭其他应用
打开和关闭其他应用
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
打开应用：
Private Sub Command1_Click()
 Shell "Calc.exe", vbNormalFocus
End Sub
关闭应用：
Private Sub Command2_Click()
Dim lpClassName As String
Dim lpCaption As String
Dim Handle As Long

Const NILL = 0&
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060&

lpClassName = "SciCalc"
lpCaption = "Calculator"
'* Determine the handle to the Calculator window.
Handle = FindWindow(lpClassName$, lpCaption$)
'* Post a message to Calc to end its existence.
Handle = SendMessage(Handle, WM_SYSCOMMAND, SC_CLOSE, NILL)
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

例子：
Dim ret&
ret& = ShellExecute(Me.hwnd, "Open", "http://vbmw.yeah.net", "", App.Path, 1)
End Sub
也可以直接发送 Mail，只要把以上的 http 地址换为 "mailto:vvv123@163.net"

代码块注释和块取消注释
代码块注释和块取消注释
VB5 的新功能，你可以成块地将代码注释或取消注释，在调试时特别有用。请使用 注释块/取消注释块  命令对。
“注释块”和“取消注释块”命令可以在“编辑”工具栏中找到。使用这些命令使多行代码成为注释块，或从一块代码中删除注释字符：

1.     添加“编辑”工具栏。在“编辑”菜单上选择“工具栏”命令，然后选择“编辑”；或将光标放在工具栏上，按右鼠标键，然后选择“编辑”。
2.     打开代码模块，并且突出显示希望创建注释块的代码，或希望从中删除注释字符的代码。
3.     按“编辑”工具栏上的“注释块”或“取消注释块”按钮。

或者代码将移入一个块，并且添加了注释字符；或者被分离成独立的代码片段，并且从中删除了注释字符。

弹出驱动器
   below is example for how to open & close CD-ROM drive.

   'Private Declare Function mciSendString Lib "winmm.dll" Alias_
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString
   As String, _
   ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

   'Open CD drive door
   retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)

   'Close CD drive door
   retvalue = mciSendString("set CDAudio door closed", returnstring, 127,0)

当前系统目录
当前系统目录
声明：
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 所在目录。

得到鼠标位置
得到鼠标位置
声明：
Private Type POINTAPI
   x As Long
   y As Long
End Type
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

例子：
Dim p As POINTAPI
Call GetCursorPos( p )
' ( p.x, p.y )为鼠标位置

动态改变屏幕设置
动态改变屏幕设置
Private Declare Function lstrcpy  Lib "kernel32" Alias "lstrcpyA"  (lpString1 As Any, lpString2 As Any) As Long
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function _
ChangeDisplaySettings Lib _
"User32" Alias "ChangeDisplaySettingsA" (_
ByVal lpDevMode As Long, _
ByVal dwflags As Long) As Long
'函数
Public Function SetDisplayMode(Width As _
Integer,Height As Integer, Color As _
Integer) As Long
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Dim NewDevMode As DEVMODE
Dim pDevmode As Long
With NewDevMode
.dmSize = 122
If Color = -1 Then
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
Else
.dmFields = DM_PELSWIDTH Or _
DM_PELSHEIGHT Or DM_BITSPERPEL
End If
.dmPelsWidth = Width
.dmPelsHeight = Height

If Color <> -1 Then
.dmBitsPerPel = Color
End If
End With
pDevmode = lstrcpy(NewDevMode, NewDevMode)
SetDisplayMode = ChangeDisplaySettings(pDevmode, 0)
End Function
例子调用：改变为 640x480x24位：
i = SetDisplayMode(640, 480, 24)
如果成功返回 0 。

断开所有的数据连接
断开所有的数据连接 98-8-21
如果在代码中使用了数据控件如 DAO， RDO， 或  ADO， 在退出时应该关闭所有打开的 recordset，  database，和  workspace 。 虽然对象能自动注销， 但是数据连接不会马上断开， 可能会导致一些内存不能被系统重新分配。

下面的代码可以关闭所有打开的 DAO workspace， 并释放所占的内存。

Private Sub Form_Unload(Cancel As Integer)
   On Error Resume Next
   '
   Dim ws As Workspace
   Dim db As Database
   Dim rs As Recordset
   '
   For Each ws In Workspaces
       For Each db In ws.Databases
           For Each rs In db.Recordsets
               rs.Close
               Set rs = Nothing
           Next
           db.Close
           Set db = Nothing
       Next
       ws.Close
       Set ws = Nothing
   Next
   '
End Sub

断开与 Internet 的连接
断开与 Internet 的连接 98-7-20
声明：
Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412

Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Public Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type

Public Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _
Any, lpcb As Long, lpcConnections As Long) As Long

Public Declare Function RasHangUp Lib "rasapi32.dll" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As Long
Public gstrISPName As String
Public ReturnCode As Long

函数：
Public Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, _
lpcConnections)

If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) _
= Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If

End Sub

Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function

对ListView中的列排序
001 对ListView中的列排序
设置 ListView 控件到 report 视图。下面的代码允许你使用
任何的列进行排序，主要在列头上点击。
如果已经排序，顺序将反一下。

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As ColumnHeader)
With ListView1
If (ColumnHeader.Index - 1) = .SortKey Then
.SortOrder = (.SortOrder + 1) Mod 2
Else
.Sorted = False
.SortOrder = 0
.SortKey = ColumnHeader.Index - 1
.Sorted = True
End If
End With
End Sub