cpp4vb.frm

The code for this article was written for version 1.0 of the Active Template Library (ATL). The cu

    BugMessage s
    txtTest = s
End Sub

Private Sub cmdBits_Click()
    Dim dw As Long, w As Integer, r As Single, d As Double
    Dim c As Currency, s As String, i As Integer
    Dim pl As Long, PI As Long, pr As Long, pd As Long
    Dim pc As Long, ps As Long, psz As Long
    Dim sOutput As String
    sOutput = ""

    w = &HABCD
    w = &HFFFF
    dw = &HFEDCBA98
    dw = &HFFFF0000
    r = 1.23456789
    d = 9.87654321
    c = 999.99
    s = "Test"

    Dim bHi As Integer, bLo As Integer
    Dim wHi As Integer, wLo As Integer
    Dim wPack  As Integer, dwPack  As Long
    Dim wRShift As Integer, wLShift As Integer
    Dim dwRShift As Long, dwLShift As Long

    sOutput = "VB Versions" & sCrLf
    bLo = LoByte(w)
    sOutput = sOutput & "Low byte of word (" & Hex$(w) & "): " & Hex$(bLo) & sCrLf
    bHi = HiByte(w)
    sOutput = sOutput & "High byte of word (" & Hex$(w) & "): " & Hex$(bHi) & sCrLf
    wPack = MakeWord(bLo, bHi)
    sOutput = sOutput & "Packed hi/lo bytes of word: " & Hex$(wPack) & sCrLf
    wLo = LoWord(dw)
    sOutput = sOutput & "Low Word of DWord (" & Hex$(dw) & "): " & Hex$(wLo) & sCrLf
    wHi = HiWord(dw)
    sOutput = sOutput & "High Word of DWord (" & Hex$(dw) & "): " & Hex$(wHi) & sCrLf
    dwPack = MakeDWord(wHi, wLo)
    sOutput = sOutput & "Packed hi/lo Word of DWord: " & Hex$(dwPack) & sCrLf

    
    sOutput = sOutput & "Word shifted right" & sCrLf
    For i = 0 To 15
        sOutput = sOutput & Hex$(RShiftWord(w, i)) & "  "
    Next
    sOutput = sOutput & sCrLf
    sOutput = sOutput & "Word shifted left" & sCrLf
    For i = 0 To 15
        sOutput = sOutput & Hex$(LShiftWord(w, i)) & "  "
    Next
    sOutput = sOutput & sCrLf
    sOutput = sOutput & "DWord shifted right C" & sCrLf
    For i = 0 To 31
        sOutput = sOutput & Hex$(RShiftDWord(dw, i)) & "  "
    Next
    sOutput = sOutput & sCrLf
    sOutput = sOutput & "DWord shifted left C" & sCrLf
    For i = 0 To 31
        sOutput = sOutput & Hex$(LShiftDWord(dw, i)) & "  "
    Next
    sOutput = sOutput & sCrLf
    txtTest.Text = sOutput

End Sub

Private Sub cmdWin32_Click()

    Dim i As Integer, s As String, sVal As String
    Dim sName As String, sFullName As String
    Dim c As Long, f As Boolean
    Dim iDir As Long, iBase As Long, iExt As Long
    Dim vDir As Variant, vBase As Variant, vExt As Variant
       
    ''@B SearchDirs2
    vDir = Environ$("INCLUDE")
    'sFullName = SearchDirs("WINDOWS.H", , vDir)
    sFullName = SearchDirs("WINDOWS.H", , Environ$("INCLUDE"))
    'sFullName = SearchDirs("WINDOWS.H", , Environ("INCLUDE"))
    ''@E SearchDirs2
    If sFullName <> sEmpty Then
        s = s & "File found in: " & sFullName & sCrLf
    Else
        s = s & "File not found" & sCrLf
    End If
    
   
    sName = "nosuch.txt"
    ' Test GetFullPathName
    s = s & sCrLf & "Test GetFullPathName" & sCrLf & sCrLf
    ''@B GetFullPathName
    Dim sBase As String, pBase As Long
    sFullName = String$(cMaxPath, 0)
    c = GetFullPathName(sName, cMaxPath, sFullName, pBase)
    sFullName = Left$(sFullName, c)
    If c Then
        s = s & "Full name: " & sFullName & sCrLf
    ''@E GetFullPathName
#If Win32 = 0 Then
        ' Fails 32-bit because pointer is to temporary Unicode string
        sBase = String$(20, 0)
        Call lstrcpyFromLp(sBase, pBase)
        sBase = StrZToStr(sBase)
        s = s & "Name: " & sBase & sCrLf
#End If
    End If
 
    s = s & sCrLf & "Test GetFullPath with invalid argument" & sCrLf & sCrLf
    sFullName = GetFullPath("", vBase, vExt, vDir)
    If sFullName = sEmpty Then
        s = s & "Failed: Error " & Err.LastDllError & sCrLf
    Else
        s = s & "File: " & sFullName & sCrLf
    End If

    ''@B GetFullPath
    s = s & sCrLf & "Test GetFullPath with all optional arguments" & sCrLf & sCrLf
    sFullName = GetFullPath(sName, vBase, vExt, vDir)
    If sFullName <> sEmpty Then
        s = s & "Relative file: " & sName & sCrLf
        s = s & "Full name: " & sFullName & sCrLf
        s = s & "File: " & Mid$(sFullName, vBase) & sCrLf
        s = s & "Extension: " & Mid$(sFullName, vExt) & sCrLf
        s = s & "Base name: " & Mid$(sFullName, vBase, _
                                     vExt - vBase) & sCrLf
        s = s & "Drive: " & Left$(sFullName, vDir - 1) & sCrLf
        s = s & "Directory: " & Mid$(sFullName, vDir, _
                                     vBase - vDir) & sCrLf
        s = s & "Path: " & Left$(sFullName, vBase - 1) & sCrLf
    Else
        s = s & "Invalid name: " & sName
    End If
    ''@E GetFullPath
    
    s = s & sCrLf & "Test GetFullPath with some optional arguments" & sCrLf & sCrLf
    sFullName = GetFullPath(sName, vBase, vExt)
    If sFullName <> sEmpty Then
        s = s & "Relative file: " & sName & sCrLf
        s = s & "Full name: " & sFullName & sCrLf
        s = s & "File: " & Mid$(sFullName, vBase) & sCrLf
        s = s & "Extension: " & Mid$(sFullName, vExt) & sCrLf
        s = s & "Base name: " & Mid$(sFullName, vBase, _
                                     vExt - vBase) & sCrLf
        s = s & "Path: " & Left$(sFullName, vBase - 1) & sCrLf
    Else
        s = s & "Invalid name: " & sName
    End If
    
    s = s & sCrLf & "Test GetFullPath with no optional arguments" & sCrLf & sCrLf
    sFullName = GetFullPath(sName)
    If sFullName <> sEmpty Then
        s = s & "Relative file: " & sName & sCrLf
        s = s & "Full name: " & sFullName & sCrLf
    Else
        s = s & "Invalid name: " & sName
    End If

    ' Test SearchPath
    s = s & sCrLf & "Test SearchPath" & sCrLf & sCrLf
    sName = "vb.hlp"
    sFullName = String$(cMaxPath, 0)
    i = SearchPath(vbNullString, sName, vbNullString, cMaxPath, sFullName, pBase)
    sFullName = Left$(sFullName, i)
    If i Then
        s = s & "File " & sName & " found in: " & sFullName & sCrLf
#If Win32 = 0 Then
        ' Fails 32-bit because pointer is to temporary Unicode string
        sBase = String$(20, 0)
        Call lstrcpyFromLp(sBase, pBase)
        sBase = StrZToStr(sBase)
        s = s & "Name: " & sBase & sCrLf
#End If
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If
    
    s = s & sCrLf & "Test SearchDirs" & sCrLf & sCrLf
    ''@B SearchDirs1
    sName = "vb.hlp"
    sFullName = SearchDirs(sName, sEmpty, sEmpty, vBase, vExt, vDir)
    If sFullName <> sEmpty Then
        s = s & "Found file " & sName
        s = s & " in " & sFullName & sCrLf
        s = s & "File: " & Mid$(sFullName, vBase) & sCrLf
        s = s & "Extension: " & Mid$(sFullName, vExt) & sCrLf
        s = s & "Base name: " & Mid$(sFullName, vBase, _
                                     vExt - vBase) & sCrLf
        s = s & "Drive: " & Left$(sFullName, vDir - 1) & sCrLf
        s = s & "Directory: " & Mid$(sFullName, vDir, _
                                     vBase - vDir) & sCrLf
        s = s & "Path: " & Left$(sFullName, vBase - 1) & sCrLf
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If
    ''@E SearchDirs1

    sName = "hardcore.frm"
    sFullName = SearchDirs(sName, Empty, Empty)
    If sFullName <> sEmpty Then
        s = s & "File " & sName & " found in: " & sFullName & sCrLf
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If
    
    sName = "calc.exe"
    sFullName = SearchDirs(sName)
    If sFullName <> sEmpty Then
        s = s & "File " & sName & " found in: " & sFullName & sCrLf
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If
    
    sName = "gdi.exe"
    sFullName = SearchDirs(sName)
    If sFullName <> sEmpty Then
        s = s & "File " & sName & " found in: " & sFullName & sCrLf
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If

    sName = "find.exe"
    sFullName = SearchDirs(sName)
    If sFullName <> sEmpty Then
        s = s & "File " & sName & " found in: " & sFullName & sCrLf
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If

    ''@B SearchDirs2
    vDir = Environ$("INCLUDE")
    sFullName = SearchDirs("WINDOWS.H", , vDir)
    sFullName = SearchDirs("WINDOWS.H", , Environ$("INCLUDE"))
    sFullName = SearchDirs("WINDOWS.H", , Environ("INCLUDE"))
    ''@E SearchDirs2
    If sFullName <> sEmpty Then
        s = s & "File found in: " & sFullName & sCrLf
    Else
        s = s & "File not found" & sCrLf
    End If
    
    ''@B SearchDirs3
    sName = "DEBUG.BAS"
    sFullName = SearchDirs(sName, ".")
    ''@E SearchDirs3
    If sFullName <> sEmpty Then
        s = s & "File found in: " & sFullName & sCrLf
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If
    
    ''@B SearchDirs4
    sName = "EDIT"
    Dim asExts(1 To 4) As String
    asExts(1) = ".EXE": asExts(2) = ".COM"
    asExts(3) = ".BAT": asExts(4) = ".PIF"
    For i = 1 To 4
        sFullName = SearchDirs(sName, asExts(i))
        If sFullName <> sEmpty Then Exit For
    Next
    ''@E SearchDirs4
    If sFullName <> sEmpty Then
        s = s & "File found in: " & sFullName & sCrLf
    Else
        s = s & "File " & sName & " not found" & sCrLf
    End If

    ' Test GetDiskFreeSpace and GetDriveType
    s = s & sCrLf & "Test GetDiskFreeSpace and GetDriveType" & sCrLf & sCrLf
    Dim iSectors As Long, iBytes As Long
    Dim iFree As Long, iTotal As Long
    Dim rFree As Double, rTotal As Double
    sName = "%:\"
    Dim sTab As String
    For i = 1 To 26
        sVal = Chr$(i + Asc("A") - 1)
        Mid$(sName, 1, 1) = sVal

        ''@B CallGetDriveType
        c = GetDriveType(sName)
        s = s & "Disk " & sVal & " type: "
        s = s & Choose(c + 1, "Unknown", "Invalid", "Floppy ", _
                              "Hard   ", "Network", "CD-ROM ", "RAM    ")
        ''@E CallGetDriveType

        ''@B CallGetDiskFreeSpace
        f = GetDiskFreeSpace(sName, iSectors, iBytes, iFree, iTotal)
        rFree = iSectors * iBytes * CDbl(iFree)
        rTotal = iSectors * iBytes * CDbl(iTotal)
        If f Then
            s = s & " with " & Format$(rFree, "#,###,###,##0")
            s = s & " free from " & Format$(rTotal, "#,###,###,##0") & sCrLf
        ''@E CallGetDiskFreeSpace
        Else
            s = s & sCrLf
        End If
    Next
    ' txtTest.Text = s

    ' Test GetTempPath and GetTempFileName
    s = s & sCrLf & "Test GetTempPath and GetTempFileName" & sCrLf & sCrLf
    c = cMaxPath
    sFullName = String$(c, 0)
    c = GetTempPath(c, sFullName)
    sFullName = Left$(sFullName, c)
    s = s & "Temp Path: " & sFullName & sCrLf
    ''@B GetTempFileName
    sFullName = String$(cMaxPath, 0)
    Call GetTempFileName(".", "HC", 0, sFullName)
    sFullName = Left$(sFullName, InStr(sFullName, sNullChr) - 1)
    ''@E GetTempFileName
    s = s & "Temp File: " & sFullName & sCrLf
    
    s = s & sCrLf & "Test GetTempFile and GetTempDir" & sCrLf & sCrLf
     ''@B GetTempFile1
    ' Get temp file for current directory
    sFullName = GetTempFile(".", "HC")
    ''@E GetTempFile1
    s = s & "Temp file in current directory: " & sFullName & sCrLf
    ''@B GetTempFile2
    ' Get temp file for TEMP directory
    sFullName = GetTempFile(GetTempDir(), "HC")
    ''@E GetTempFile2
    s = s & "Temp file in TEMP directory: " & sFullName & sCrLf

   ' Test GetLogicalDrives
    s = s & sCrLf & "Test GetLogicalDrives" & sCrLf & sCrLf
    sVal = VBGetLogicalDrives()
    s = s & "Drives    ABCDEFGHIJKLMNOPQRSTUVWXYZ" & sCrLf
    s = s & "Drives    " & sVal & sCrLf

    On Error Resume Next
    Kill "~HC*.tmp"
    Kill "HC*.tmp"
    On Error GoTo 0
    
    BugMessage s
    txtTest.Text = s
    
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub