2024年3月16日发(作者：)

API 示例

API（应用程序编程接口）是 DLL 文件中所包含的一种功能。这些功能

通常由 Windows 和其他应用程序使用，但也可以被最终用户所使用。

注释: 使用 API 调用请多加小心。要注意保存以避免丢失所做的工作。

由于这种功能的设计目的是由系统和应用程序所调用，所以许多错误捕获功能并未实施。

这意味着使用 API 调用时，有可能导致系统挂起、崩溃或其他不可预测的副作用。

下面的示例说明了如何使用基本的 API。已经在 Windows98 和 Excel 中测试通过。

使用这些功能的方式很多，程序员可以自行确定哪种方式更为合适。

检查所有的驱动器盘符

Goto Get_Logical_Drive_String

下面的示例使用“GetLogicalDriveStrings”函数循环通过所有逻辑驱动器。

逻辑驱动器是指软盘、硬盘、CD 驱动器及映射的网络共享。

Option Explicit

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _

(ByVal nBufferLength As Long, _

ByVal lpBuffer As String) As Long

Goto Get_System_Metrics

Sub Get_Logical_Drive_String()

Dim DrvString As String

转到Get_Logical_Drive_String 示

Dim TotDrvs As Long

例代码

Dim Counter As Integer

'变量“TotDrvs”返回字符串中总的字符数

TotDrvs = GetLogicalDriveStrings(0&, DrvString)

Goto Get_User_Name

'变量“DrvString”是为存放该字符串而创建的缓冲区

DrvString = String(TotDrvs - 1, " ")

'再次调用“GetLogicalDriveStrings”，用有效数据填充字符串

'示例 "a: c: d: e: "

TotDrvs = GetLogicalDriveStrings(TotDrvs, DrvString)

'解析整个返回的字符串，并在“msgbox”中显示每个盘符

For Counter = 1 To TotDrvs Step 4

Goto Get_Short_Name

MsgBox Mid(DrvString, Counter, 3)

Next Counter

End Sub

返回视频分辨率

下面的示例代码返回当前的屏幕视频分辨率并在消息框中显示信息。

Goto Get_Computer_Name

Option Explicit

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

'“GetSystemMetrics”中将用到的常数

Const SM_CXSCREEN = 0 ' 屏幕宽度

Const SM_CYSCREEN = 1 ' 屏幕高度

Goto GetDiskFreeSpace

Sub Get_System_Metrics()

转到Get_System_Metrics 示例

Dim XVal As Long, YVal As Long

代码

YVal = GetSystemMetrics(SM_CYSCREEN)

Goto GetSystemDirectory

XVal = GetSystemMetrics(SM_CXSCREEN)

MsgBox "您的屏幕分辨率为：" & XVal & " X " & YVal

End Sub

提取登录名称

Goto Num_Devs

下面的代码将返回当前登录的用户名。

Option Explicit

Private Declare Function GetUserName Lib "" Alias "GetUserNameA" _

(ByVal lpBuffer As String, _

nSize As Long) As Long

Sub Get_User_Name()

Dim lpBuff As String * 25

Goto SetOnTop

转到Get_User_Name 示例代

码

码

Dim ret As Long, UserName As String

ret = GetUserName(lpBuff, 25)

UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)

MsgBox UserName

End Sub

返回长路径和文件名的短路径名

下面的函数获取“长文件名”，返回“短文件名”，并在消息框中

显示两种名称。

Private Declare Function GetShortPathName Lib "" Alias "GetShortPathNameA" _

(ByVal lpctstrLongName As String, _

ByVal lptstrShortName As String, _

ByVal bufLen As Long) As Long

Sub Get_Short_Name()

转到Get_Short_Name 示例

Dim LongStr As String, ShortStr As String

代码

Dim lStrLen As Long, lRet As Long

'变量“LongStr”为指向某一文件的任意长度文件名或变量

LongStr = me

lRet = GetShortPathName(LongStr, ShortStr, lStrLen)

'可以创建一个与返回的字符串长度相同的缓冲区，这样将不必再截去缓冲区左侧即可获取字符串

ShortStr = String(lRet, " ")

lRet = GetShortPathName(LongStr, ShortStr, lRet)

MsgBox LongStr & " 被转换为 " & ShortStr

End Sub

返回计算机名称

下面的代码示例说明如何使用“GetComputerName”函数获取计算机名称。

Option Explicit

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, _

nSize As Long) As Long

转到Get_Computer_Name

Sub Get_Computer_Name()

示例代码

Dim Comp_Name_B As String * 255

Dim Comp_Name As String

GetComputerName Comp_Name_B, Len(Comp_Name_B)

'但是该字符串始终以空的终止字符串结尾，因此可以用“Chr(0)”函数找到末尾

Comp_Name = Left(Comp_Name_B, InStr(Comp_Name_B, Chr(0)))

'并仅返回计算机名称

MsgBox Comp_Name

End Sub

查找硬盘上的可用自由空间

下面的示例代码说明如何查找可用自由空间及总的硬盘大小。

Option Explicit

Private Declare Function GetDiskFreeSpace Lib "" Alias "GetDiskFreeSpaceA" (ByVal lpRoot As String, _

dwSectors As Long, _

dwBytes As Long, _

dwFreeClusters As Long, _

dwTotalClusters As Long) As Long

Sub Get_Disk_Free_Space()

Dim f As Long, iSectors As Long

转到Get_Disk_Free_Space 示

Dim iTotal As Long, rTotal As Long

例代码

Dim iFree As Long, rFree As Long

Dim iBytes As Long

Dim sName As String, s As String

sName = "C:"

f = GetDiskFreeSpace(sName, iSectors, iBytes, iFree, iTotal)

rFree = iSectors * iBytes * CDbl(iFree)

rTotal = iSectors * iBytes * CDbl(iTotal)

If f Then

s = sName

s = s & " 有 " & Format(rFree, "#,###,###,##0")

s = s & " 字节自由空间，总共有 " & Format(rTotal, "#,###,##0") & " 字节。"

End If

MsgBox s

End Sub

返回系统文件夹位置

下面的代码示例说明如何提取系统文件夹位置。

Option Explicit

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _

ByVal nSize As Long) As Long

Sub Get_System_Directory()

Dim Sys_Dir As String, Res As Long

Res = GetSystemDirectory(Sys_Dir, 0&)

Sys_Dir = String(Res - 1, " ")

Res = GetSystemDirectory(Sys_Dir, Res)

MsgBox Sys_Dir

End Sub

转到GetSystemDirectory 示

例代码

查找系统有无播放 WAV 文件的能力

下面的示例代码遍历系统以查看是否有播放 WAV 文件的设备能力。

Option Explicit

Declare Function waveOutGetNumDevs Lib "winmm" () As Long

Sub Num_Devs()

Dim i As Long

i = waveOutGetNumDevs()

If i > 0 Then ' 至少有一种设备。

MsgBox "可以播放 Wave 数据"

Else

MsgBox "无法播放 Wave 数据"

End If

End Sub

转到Num_Devs 示例

代码

将 Excel 设置为“总在前面”

下面的示例代码说明如何使 Microsoft Excel“总在前面”。这可以防止其他应用程序

显示在 Microsoft Excel 前面。

Option Explicit

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, _

转到SetOnTop

ByVal y As Long, _

示例代码

ByVal cx As Long, _

ByVal cy As Long, _

ByVal wFlags As Long) As Long

Global Const HWND_TOPMOST = -1

Global Const HWND_NOTOPMOST = -2

Sub SetOnTop()

Dim WinHnd As Long, SUCCESS As Long

WinHnd = FindWindow("xlmain", n)

SUCCESS = SetWindowPos(WinHnd, HWND_TOPMOST, 0, 0, 0, 0, Flags)

'下面一行只是为了 20 秒之后将 Excel 切换回正常操作状态

Now + TimeValue("00:00:20"), "NotOnTop"

End Sub

Sub NotOnTop()

Dim WinHnd As Long, SUCCESS As Long

WinHnd = FindWindow("xlmain", n)

SUCCESS = SetWindowPos(WinHnd, HWND_NOTOPMOST, 0, 0, 0, 0, Flags)

End Sub