winapis.bas

来自「扫描软件」· BAS 代码 · 共 65 行

Attribute VB_Name = "WinAPIs"
Option Explicit

'**************************************************************
' Windows APIs
'**************************************************************
    
    '----------------------------------------------------------
    ' Windows API declares.
    '----------------------------------------------------------
    Public Declare Function GetDeviceCaps Lib "gdi32" _
        (ByVal hdc As Long, ByVal nIndex As Long) As Long
        
    Public Declare Function GetWindowsDirectory Lib "kernel32" _
        Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
        ByVal nSize As Long) As Long
        
    Public Declare Function WinExec Lib "kernel32" _
        (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
    
    '----------------------------------------------------------
    ' Windows API constants
    '----------------------------------------------------------
    Public Const REG_SZ As Long = 1
    Public Const REG_BINARY As Long = 3
    Public Const REG_DWORD As Long = 4

Public Function GetWindowsDir(WithSlash As Boolean) As String
'**************************************************************
' PUBLIC FUNCTION GetWindowsDir:  Returns the path to the
' Windows directory with or without a trailing backslash.
'**************************************************************
'** Longs
    Dim lngResult As Long
'** Strings
    Dim lpBuffer$
    Dim strGetWin As String
    
    '----------------------------------------------------------
    ' Initalize a buffer that is large enough to hold the
    ' result, otherwise you'll get a GPF.
    '----------------------------------------------------------
    lpBuffer = Space$(2048)
    
    '----------------------------------------------------------
    ' Call the function, and strip the null terminator using
    ' the return value.
    '----------------------------------------------------------
    lngResult = GetWindowsDirectory(lpBuffer, Len(lpBuffer))
    strGetWin = LCase$(Left$(lpBuffer, lngResult))
    
    '----------------------------------------------------------
    ' Add or Remove the slash depending on what was returned,
    ' and the value of WithSlash.
    '----------------------------------------------------------
    If Right$(strGetWin, 1) <> "\" And WithSlash Then
        GetWindowsDir = strGetWin & "\"
    ElseIf Right$(strGetWin, 1) = "\" And Not WithSlash Then
        GetWindowsDir = Left$(strGetWin, Len(strGetWin) - 1)
    Else
        GetWindowsDir = strGetWin
    End If
    
End Function