• Home
 · 
• Windows System Services
 · 
• Automatically Create Manifest File

Automatically Create Manifest File

Automatically changes controls to XP themed style in XP based OS.

API Declarations
Private 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

Rate Automatically Create Manifest File

• 1
• 2
• 3
• 4
• 5

(5(5 Vote))

Public 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 & "Microsoft Visual Basic 6 IDE"
  Header = Header & vbCrLf & ""
  Header = Header & vbCrLf & "  "
  Header = Header & vbCrLf & "    "
  Header = Header & vbCrLf & "  "
  Header = Header & vbCrLf & ""
  Header = Header & vbCrLf & ""
  FormatManifest = Header
End Function