'**************************************
'Windows API/Global Declarations for :_ Automatically Create Manifest File _
'**************************************
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
code: Can't Copy and Paste this? Click here for a copy-and-paste friendly version of this code!
Terms of Agreement:
By using this code, you agree to the following terms...
You may use
this code in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
You MAY NOT redistribute this code (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.
You may link to this code from another website, but ONLY if it is not wrapped in a frame.
You will abide by any additional copyright restrictions which the author may have placed in the code or code's description.
'**************************************
' Name: _ Automatically Create Manifest File _
' Description:Automatically changes controls to XP themed style in XP based OS.
' By: KRYO_11
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=51893&lngWId=1'for details.'**************************************
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 = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & " standalone=" & Chr(34) & "yes" & Chr(34) & "?>"
Header = Header & vbCrLf & "<assembly xmlns=" & Chr(34) & "urn:schemas-microsoft-com:asm.v1" & Chr(34) & " manifestVersion=" & Chr(34) & "1.0" & Chr(34) & ">"
Header = Header & vbCrLf & "<assemblyIdentity"
Header = Header & vbCrLf & "version=" & Chr(34) & "1.0.0.0" & Chr(34)
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 & "<description>Microsoft Visual Basic 6 IDE</description>"
Header = Header & vbCrLf & "<dependency>"
Header = Header & vbCrLf & "<dependentAssembly>"
Header = Header & vbCrLf & "<assemblyIdentity"
Header = Header & vbCrLf & "type=" & Chr(34) & "win32" & Chr(34)
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 & "</dependentAssembly>"
Header = Header & vbCrLf & "</dependency>"
Header = Header & vbCrLf & "</assembly>"
FormatManifest = Header
End Function
It detects Win2k as WinXP. Try replacing '>=' with '=' , and add one more line.
regards, Vlad (If this comment was disrespectful, please report it.)
5/24/2004 3:32:54 PM:
works perfect! thanks. (If this comment was disrespectful, please report it.)
7/10/2004 12:58:49 PM:
Using this code, my app would error on exit. I added: Dim hMod as Long in the dec section LoadLibrary API in the dec section FreeLibrary API in the dec section.
Directly before the InitCommonControls call, added hMod = LoadLibrary("shell32.dll") Added a function to the mod, KillCC, with does FreeLibrary(hMod)
After these mods, no more errors.
Thank's for the great code !! No longer do I need to beat up my PC to get a valid manifest, just add one mod. (If this comment was disrespectful, please report it.)
7/10/2004 12:59:43 PM:
Forgot, called the KillCC on form unload. (If this comment was disrespectful, please report it.)
7/31/2004 4:06:18 PM:
The problem I get is after compiling the exe, I try to run it but only get an hour glass briefly - then nothing. The app doesn't run. Any ideas? (If this comment was disrespectful, please report it.)
8/18/2004 2:32:42 AM:
is a bit little to long and can be made specifically for Windows XP as it is bieng used round the globe. (If this comment was disrespectful, please report it.)
9/28/2004 4:55:44 AM:
I have troubles with OptionButtons : their becomes black when placed in a frame. (If this comment was disrespectful, please report it.)
its great, it has some issues, but the idea is great... keep going, all your code is cool. (If this comment was disrespectful, please report it.)
12/29/2004 12:15:53 PM:
System Error &H80070583(-2147023485). What is that? When a started EXE With .manifest, following message appeared. HELP!!!!!! (If this comment was disrespectful, please report it.)
2/14/2005 7:13:23 AM:
This code is very good! (If this comment was disrespectful, please report it.)
Como puedo generar controles por ejemplo un check y un text para N usuarios, esto puede cambiar con el tiempo y luego contener en un control contenedor o un formulario para poder depurarlos seleccionando, y eso porfis si me ayudan en esto se les agradeceria .. me lo mandan sus respuestas al correo castilloncr@gmail.com (If this comment was disrespectful, please report it.)
I am experiencing the 'black' option buttons as well. Any idea why this is happening? It appears to me that the manifest file may need some tweaking. The code is nice though. Greate Job (If this comment was disrespectful, please report it.)
Here is the answer to the "BLACK OPTION BUTTONS" problem.
http://support.microsoft.com/?id=309366
Apparently, there is very little that can be done about it. It is a result of VB6's lack of support for xp visual styles. (If this comment was disrespectful, please report it.)
i pasted this code in my program but dont know where to call the function. if anyone please let me know how to actually use this code. i called the function at da load event of form but its not working . i want to use this. i m new to programming that's why probably. please help me.
(If this comment was disrespectful, please report it.)
Add Your Feedback
Your feedback will be posted below and an email sent to
the author. Please remember that the author was kind enough to
share this with you, so any criticisms must be stated politely, or they
will be deleted. (For feedback not related to this particular code, please
click here instead.)
3/9/2004 1:47:28 PM: 
