system.cls

Visual.Basic.NET实用编程百例-47.6M.zip

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "System"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'---------------------------------------------------------------------------
' API declarations in order to obtain names (computer and user names)
'---------------------------------------------------------------------------
Private Declare Function apiUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'---------------------------------------------------------------------------
' API declarations in order to obtain the Windows / System and Temporary
' directories.
'---------------------------------------------------------------------------
Private Declare Function apiWindDir Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function apiSysDir Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function apiTempDir Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'---------------------------------------------------------------------------


'---------------------------------------------------------------------------
' API declarations to obtain the Windows version and the type of
' keyboard.
'---------------------------------------------------------------------------
Private Declare Function apiGetVersion Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
        ' size of 'Type' = (5 x 4 bytes) =  20 bytes (the 5 Longs)
        '                                  128 bytes (fixed-length string)
        '                                 ----- +
        '                                  148 bytes
        
        dwOSVersionInfoSize As Long         ' Has to be set to size of 'type'= 148
        dwMajorVersion As Long              ' Gives the Major version
        dwMinorVersion As Long              ' Gives the Minor version
        dwBuildNumber As Long               ' Gives the buildnumber (I don't use it)
        dwPlatformId As Long                ' Gives the operating system.
        szCSDVersion As String * 128        ' ?
End Type







Public Function TempDir() As String
'---------------------------------------------------------------------------
' FUNCTION: TempDir
'
' Get the Temporary directory windows uses.
'
' OUT: TempDir  - String containing the directory.
'
' If the function fails a empty string is returned.
'---------------------------------------------------------------------------
'
Dim Bufstr As String
Bufstr = Space$(50)


'---------------------------------------------------------------------------
' Call the API and remove the spaces using RTrim. Next, remove the terminating
' character using StripTerminator, and add a backslash, when if it wasn't
' already there.
'---------------------------------------------------------------------------
If apiTempDir(50, Bufstr) > 0 Then
    TempDir = Bufstr
    TempDir = RTrim(TempDir)
    TempDir = StripTerminator(TempDir)
    
    If Right$(TempDir, 1) <> "\" Then
        TempDir = TempDir + "\"
    End If
    
Else
    TempDir = ""
End If
        
End Function
Public Function SystemDir() As String
'---------------------------------------------------------------------------
' FUNCTION: SystemDir
'
' Gets the WINDOWS\SYSTEM directory.
'
' Returns a string containing the full path, ends with a "\". If the
' call fails a empty string is returned.
'---------------------------------------------------------------------------
'
Dim Bufstr As String
Bufstr = Space$(50)


'---------------------------------------------------------------------------
' Call the API and remove the spaces using RTrim. Remove the terminating
' character and add a backslash when it isn't already there.
'---------------------------------------------------------------------------
If apiSysDir(Bufstr, 50) > 0 Then
    SystemDir = Bufstr
    SystemDir = RTrim(SystemDir)
    SystemDir = StripTerminator(SystemDir)
    
    If Right$(SystemDir, 1) <> "\" Then
        SystemDir = SystemDir + "\"
    End If
    
Else
    SystemDir = ""
End If
        
End Function
Private Function StripTerminator(ByVal strString As String) As String
'---------------------------------------------------------------------------
' FUNCTION: StripTerminator
'
' Returns a string without any zero terminator.  Typically,
' this was a string returned by a Windows API call.
'
' IN: [strString] - String to remove terminator from
'
' Returns: The value of the string passed in minus any
'          terminating zero.
'
'
' THIS FUNCTION I GOT FROM THE SETUP PROJECT THAT CAME WITH VISUAL BASIC 4.
'---------------------------------------------------------------------------
'
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If

End Function
Public Function UserName() As String
'---------------------------------------------------------------------------
' FUNCTION: UserName
'
' Get the name of the user.
'
' OUT: UserName     - String containing the name of the user of the computer.
'
' If the function fails, an empty string is returned.
'---------------------------------------------------------------------------
'
Dim Bufstr As String
Bufstr = Space$(50)


'---------------------------------------------------------------------------
' Call the API, remove the spaces using RTrim, remove the NULL-character
' using StripTerminator.
'---------------------------------------------------------------------------
If apiUserName(Bufstr, 50) > 0 Then
    UserName = Bufstr
    UserName = RTrim(UserName)
    UserName = StripTerminator(UserName)
Else
    UserName = ""
End If
        
End Function


Public Function WinDir() As String
'---------------------------------------------------------------------------
' FUNCTION: WinDir
'
' Returns the Windows directory (Mostly "C:\WINDOWS\")
'
' If the function fails an empty string is returned.
'---------------------------------------------------------------------------
'
Dim Bufstr As String
Bufstr = Space$(50)


'---------------------------------------------------------------------------
' Call the API, remove the extra spaces using RTrim, remove the NULL-character
' using StripTerminator, and add a backslash.
'---------------------------------------------------------------------------
If apiWindDir(Bufstr, 50) > 0 Then
    WinDir = Bufstr
    WinDir = RTrim(WinDir)
    WinDir = StripTerminator(WinDir)
    
    If Right$(WinDir, 1) <> "\" Then
        WinDir = WinDir + "\"
    End If
    
Else
    WinDir = ""
End If
        
End Function
Public Sub WinVer(ByRef intMajor As Integer, ByRef intMinor As Integer, ByRef strPlatform As String)
'---------------------------------------------------------------------------
' SUB: WinVer
'
' This sub returns information about the operating system, and about
' the Windows Version.
'
' e.g. Windows 3.11
'      The sub will return:
'         - intMajor    = 3
'         - intMinor    = 11
'         - strPlatform = Windows 3.11
'
' OUT:  intMajor        - Integer containing the major version of Windows.
'       intMinor        - Integer containing the minor version of windows.
'
' strPlatfrom returns one of the following :
'   Windows 95
'   Windows NT
'   Windows + Version
'
' If the call fails intMajor = 0, intMinor = 0, and strPlatform = ""
'---------------------------------------------------------------------------
'
Dim OSystem As OSVERSIONINFO

OSystem.dwOSVersionInfoSize = 148
' The size of the structure must be set before the call.

If apiGetVersion(OSystem) Then
' Call the API. It fills the OSystem type.

    intMajor = OSystem.dwMajorVersion   ' Store the Major version in intMajor
    intMinor = OSystem.dwMinorVersion   ' Store the Minor version in intMinor
    
    Select Case OSystem.dwPlatformId    ' Set strPlatform
    Case 0
        strPlatform = "Windows " + CStr(intMajor) + "." + CStr(intMinor)
    Case 1
        strPlatform = "Windows 95"
    Case 2
        strPlatform = "Windows NT"
    End Select

Else
' The call failed, set the values to zero
    intMajor = 0
    intMinor = 0
    strPlatform = ""

End If

End Sub