by KRYO_11 (20 Submissions)
Category: Windows System Services
Compatability: Visual Basic 5.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(4 Votes)
Automatically changes controls to XP themed style in XP based OS.
API DeclarationsPrivate Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
VBcodersPublic Function CreateManifest() As Boolean
On Error Resume Next
Dim EXEPath As String
'Get The EXE Path
EXEPath = App.Path & IIf(Right(App.Path, 1) = "\", vbNullString, "\")
EXEPath = EXEPath & App.EXEName & IIf(LCase(Right(App.EXEName, 4)) = ".exe", ".manifest", ".exe.manifest")
'Checks if the manifest has already been created
If Dir(EXEPath, vbReadOnly Or vbSystem Or vbHidden) <> vbNullString Then GoTo ErrorHandler
'Makes sure you are using windows xp
If WinVersion = "Windows XP" Then
Dim iFileNumber As Integer
iFileNumber = FreeFile
'Save the .manifest file
Open EXEPath For Output As #iFileNumber
Print #iFileNumber, FormatManifest
CreateManifest = True
Else
Kill EXEPath
End If
'set the file to be hidden
Close #iFileNumber
SetAttr EXEPath, vbHidden Or vbSystem Or vbReadOnly Or vbArchive
ErrorHandler:
Call InitCommonControls
End Function
'get windows version (from Microsoft.com)
Private Function WinVersion() As String
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
With osinfo
Select Case .dwPlatformId
Case 1
If .dwMinorVersion = 0 Then
WinVersion = "Windows 95"
ElseIf .dwMinorVersion = 10 Then
WinVersion = "Windows 98"
End If
Case 2
If .dwMajorVersion = 3 Then
WinVersion = "Windows NT 3.51"
ElseIf .dwMajorVersion = 4 Then
WinVersion = "Windows NT 4.0"
ElseIf .dwMajorVersion >= 5 Then
WinVersion = "Windows XP"
End If
Case Else
WinVersion = "Failed"
End Select
End With
End Function
'Create the string for the manifest file
Private Function FormatManifest() As String
Dim Header As String
Header = ""
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & "
Header = Header & vbCrLf & " processorArchitecture=" & Chr(34) & "X86" & Chr(34)
Header = Header & vbCrLf & " name=" & Chr(34) & "Microsoft.VisualBasic6.IDE" & Chr(34)
Header = Header & vbCrLf & " type=" & Chr(34) & "win32" & Chr(34)
Header = Header & vbCrLf & "/>"
Header = Header & vbCrLf & "Microsoft Visual Basic 6 IDE "
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & " "
Header = Header & vbCrLf & "
Header = Header & vbCrLf & " name=" & Chr(34) & "Microsoft.Windows.Common-Controls" & Chr(34)
Header = Header & vbCrLf & " version=" & Chr(34) & "6.0.0.0" & Chr(34)
Header = Header & vbCrLf & " processorArchitecture=" & Chr(34) & "X86" & Chr(34)
Header = Header & vbCrLf & " publicKeyToken=" & Chr(34) & "6595b64144ccf1df" & Chr(34)
Header = Header & vbCrLf & " language=" & Chr(34) & "*" & Chr(34)
Header = Header & vbCrLf & " />"
Header = Header & vbCrLf & " "
Header = Header & vbCrLf & " "
Header = Header & vbCrLf & ""
FormatManifest = Header
End Function
