modxp.bas

本医疗点数据管理系统适用于乡镇卫生所

    Open ManifestFileName For Output As NewFreeFile
        Print #NewFreeFile, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & " standalone=" & Chr(34) & "yes" & Chr(34) & "?>"
        Print #NewFreeFile, "<assembly xmlns=" & Chr(34) & "urn:schemas-microsoft-com:asm.v1" & Chr(34) & " manifestVersion=" & Chr(34) & "1.0" & Chr(34) & ">"
        Print #NewFreeFile, "<assemblyIdentity version=" & Chr(34) & "1.0.0.0" & Chr(34) & " processorArchitecture=" & Chr(34) & "x86" & Chr(34) & " name=" & Chr(34) & "prjThemed" & Chr(34) & " type=" & Chr(34) & "Win32" & Chr(34) & " />"
        Print #NewFreeFile, "<dependency>"
        Print #NewFreeFile, "<dependentAssembly>"
        Print #NewFreeFile, "<assemblyIdentity type=" & Chr(34) & "Win32" & Chr(34) & " name=" & Chr(34) & "Microsoft.Windows.Common-Controls" & Chr(34) & " version=" & Chr(34) & "6.0.0.0" & Chr(34) & " processorArchitecture=" & Chr(34) & "x86" & Chr(34) & " publicKeyToken=" & Chr(34) & "6595b64144ccf1df" & Chr(34) & " language=" & Chr(34) & "*" & Chr(34) & " />"
        Print #NewFreeFile, "</dependentAssembly>"
        Print #NewFreeFile, "</dependency>"
        Print #NewFreeFile, "</assembly>"
    Close NewFreeFile
    
    MakeMANIFESTfile = True 'FILE CREATED OK
    
    Exit Property
MakeMANIFESTfile_Err:
    MakeMANIFESTfile = False 'ERROR CREATING FILE
End Property
'#################################################################################




'#################################################################################
'THE BELOW CODE CHECK THE EXISTANCE OF THE MANIFEST FILE:
'IF FILE EXISTS THEN IsManifestFile returns True

'THIS CODE SIMPLY TRIES TO OPEN THE FILE - IF THERE IS AN ERROR THEN THE FILE DOESN'T
'EXIST

Public Property Get IsManifestFile() As Boolean
    
    IsManifestFile = False
    
    On Local Error GoTo IsManifestFile_Err
    
    Dim ManifestFileName As String
    Dim NewFreeFile As Integer
    
    ManifestFileName = App.Path & "\" & App.EXEName & ".exe.MANIFEST"
    NewFreeFile = FreeFile
    
    Open ManifestFileName For Input Access Read As NewFreeFile
    Close NewFreeFile
    
    IsManifestFile = True 'FILE DOES EXIST
    
    Exit Property
    
IsManifestFile_Err:
    IsManifestFile = False 'FILE DOESN'T EXIST

End Property
'#################################################################################




'#################################################################################
'THIS CODE IS TO RUN AN EXTERNAL APPLICATION / DOCUMENT:

'SHELLDOCUMENT will return a True if the file was run
'Else False if not

Public Function ShellDocument(sDocName As String, _
                    Optional ByVal Action As String = "Open", _
                    Optional ByVal Parameters As String = vbNullString, _
                    Optional ByVal Directory As String = vbNullString, _
                    Optional ByVal WindowState As StartWindowState) As Boolean
    Dim Response
    Response = ShellExecute(&O0, Action, sDocName, Parameters, Directory, WindowState)
    Select Case Response
        Case Is < 33
            ShellDocument = False
        Case Else
            ShellDocument = True
    End Select
End Function
'#################################################################################






'#################################################################################
'THE BELOW CODE IS TO DETECT OPERATING SYSTEM
'WE USE THIS TO SEE IF THE USER IS RUNNING WIN XP

'# Public subs/functions
'# Returns the asso. cnWin32Ver eNum value of the current Win32 OS

Public Function Win32Ver() As cnWin32Ver
    Dim oOSV As OSVERSIONINFO
    oOSV.OSVSize = Len(oOSV)
   
        '#### If the API returned a valid value
    If GetVersionEx(oOSV) = 1 Then
        
            '#### If we're running WinXP
            '####    If VER_PLATFORM_WIN32_NT, dwVerMajor is 5 and dwVerMinor is 1, it's WinXP
        If (oOSV.PlatformID = VER_PLATFORM_WIN32_NT And oOSV.dwVerMajor = 5 And oOSV.dwVerMinor = 1) Then
           Win32Ver = WinXP

            '#### If we're running WinNT2000 (NT5)
            '####    If VER_PLATFORM_WIN32_NT, dwVerMajor is 5 and dwVerMinor is 0, it's Win2k
        ElseIf (oOSV.PlatformID = VER_PLATFORM_WIN32_NT And oOSV.dwVerMajor = 5 And oOSV.dwVerMinor = 0) Then
           Win32Ver = Win2k

            '#### If we're running WinNT4
            '####    If VER_PLATFORM_WIN32_NT and dwVerMajor is 4
        ElseIf (oOSV.PlatformID = VER_PLATFORM_WIN32_NT And oOSV.dwVerMajor = 4) Then
           Win32Ver = WinNT4

            '#### If we're running Windows ME
            '####    If VER_PLATFORM_WIN32_WINDOWS and
            '####    dwVerMajor = 4,  and dwVerMinor > 0, return true
        ElseIf (oOSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS And oOSV.dwVerMajor = 4 And oOSV.dwVerMinor = 90) Then
           Win32Ver = WinME

            '#### If we're running Win98
            '####    If VER_PLATFORM_WIN32_WINDOWS and
            '####    dwVerMajor => 4, or dwVerMajor = 4 and
            '####    dwVerMinor > 0, return true
        ElseIf (oOSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS) And (oOSV.dwVerMajor > 4) Or (oOSV.dwVerMajor = 4 And oOSV.dwVerMinor > 0) Then
           Win32Ver = Win98

            '#### If we're running Win95
            '####    If VER_PLATFORM_WIN32_WINDOWS and
            '####    dwVerMajor = 4, and dwVerMinor = 0,
        ElseIf (oOSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS And oOSV.dwVerMajor = 4 And oOSV.dwVerMinor = 0) Then
           Win32Ver = Win95

            '#### Else the OS is not reconized by this function
        Else
            Win32Ver = UnknownOS
        End If
    
        '#### Else the OS is not reconized by this function
    Else
        Win32Ver = UnknownOS
    End If
End Function


'#########################################################
'# Returns true if the OS is WinNT4, Win2k or WinXP
'#########################################################
Public Function isNT() As Boolean
        '#### Determine the return value of Win32Ver() and set the return value accordingly
    Select Case Win32Ver()
        Case WinNT4, Win2k, WinXP
            isNT = True
        Case Else
            isNT = False
    End Select
End Function


'#########################################################
'# Returns true if the OS is Win95, Win98 or WinME
'#########################################################
Public Function is9x() As Boolean
        '#### Determine the return value of Win32Ver() and set the return value accordingly
    Select Case Win32Ver()
        Case Win95, Win98, WinME
            is9x = True
        Case Else
            is9x = False
    End Select
End Function


'#########################################################
'# Returns true if the OS is WinXP
'#########################################################
Public Function isWinXP() As Boolean
    Dim oOSV As OSVERSIONINFO
    oOSV.OSVSize = Len(oOSV)

        '#### If the API returned a valid value
    If (GetVersionEx(oOSV) = 1) Then
        isWinXP = (oOSV.PlatformID = VER_PLATFORM_WIN32_NT And oOSV.dwVerMajor = 5 And oOSV.dwVerMinor = 1)
    End If
End Function


'#########################################################
'# Returns true if the OS is Win2k
'#########################################################
Public Function isWin2k() As Boolean
    Dim oOSV As OSVERSIONINFO
    oOSV.OSVSize = Len(oOSV)

        '#### If the API returned a valid value
    If (GetVersionEx(oOSV) = 1) Then
        isWin2k = (oOSV.PlatformID = VER_PLATFORM_WIN32_NT And oOSV.dwVerMajor = 5 And oOSV.dwVerMinor = 0)
    End If
End Function


'#########################################################
'# Returns true if the OS is WinNT4
'#########################################################
Public Function isWinNT4() As Boolean
    Dim oOSV As OSVERSIONINFO
    oOSV.OSVSize = Len(oOSV)

        '#### If the API returned a valid value
    If (GetVersionEx(oOSV) = 1) Then
        isWinNT4 = (oOSV.PlatformID = VER_PLATFORM_WIN32_NT And oOSV.dwVerMajor = 4)
    End If
End Function


'#########################################################
'# Returns true if the OS is WinME
'#########################################################
Public Function isWinME() As Boolean
    Dim oOSV As OSVERSIONINFO
    oOSV.OSVSize = Len(oOSV)

        '#### If the API returned a valid value
    If (GetVersionEx(oOSV) = 1) Then
        isWinME = (oOSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS And oOSV.dwVerMajor = 4 And oOSV.dwVerMinor = 90)
    End If
End Function



'# Returns true if the OS is Win98

Public Function isWin98() As Boolean
    Dim oOSV As OSVERSIONINFO
    oOSV.OSVSize = Len(oOSV)

        '#### If the API returned a valid value
    If (GetVersionEx(oOSV) = 1) Then
         isWin98 = (oOSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS) And (oOSV.dwVerMajor > 4) Or (oOSV.dwVerMajor = 4 And oOSV.dwVerMinor > 0)
    End If
End Function



'# Returns true if the OS is Win95

Public Function isWin95() As Boolean
    Dim oOSV As OSVERSIONINFO
    oOSV.OSVSize = Len(oOSV)

        '#### If the API returned a valid value
    If (GetVersionEx(oOSV) = 1) Then
         isWin95 = (oOSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS And oOSV.dwVerMajor = 4 And oOSV.dwVerMinor = 0)
    End If
End Function
'#################################################################################