Code-Beispiel

XP-Style-Manifest nachträglich in ein Winprog einfügen

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	Volta	14.05.2013

Dieser Quellcode AddManifest ist sozusagen ein Machbarkeitstest, ich wollte einfach nur wissen ob es machbar ist ein XP-Style-Manifest nachträglich in ein Winprog einzusetzen.
Mir ist klar das es einfacher ist bei einer Programmerstellung ein Manifest über eine Ressource Datei einzufügen.
Dieses Prog läuft auf Windows7. Unter anderen Versionen konnte ich es nicht testen.

'

' Add the XP style manifest to a specified application

'

#Include Once "windows.bi"

#Define CrLf Chr(13, 10)

#Define E_ICON MB_OK Or MB_ICONERROR

#Define WTitel "AddManifest " + filename



Function AddManifest(filename As String, Beschreibung As String) As Integer

  ' This is the formatting string used to create the manifest

  Dim As String szFormat="<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & CrLf & _

  "<assembly xmlns=""urn:schemas-microsoft-com:asm.v1"" manifestVersion=""1.0"">" & CrLf & _

  "<assemblyIdentity " & CrLf & _

  "version=""1.0.0.1"" "& CrLf & _

  "processorArchitecture=""x86"" "& CrLf & _

  "name=" & Chr(34) & filename & Chr(34) & CrLf & _

  "type=""win32""/>" & CrLf & _

  "<description>" & Beschreibung & "</description>" & CrLf & _

  _  '"<!-- Compatibility section for Program Compatibility Assistant (PCA) -->" & CrLf & _

  "<compatibility xmlns=""urn:schemas-microsoft-com:compatibility.v1"" " & ">" & CrLf & _

  "<application>" & CrLf & _

  _  '"<!-- Windows Vista -->" & CrLf & _

  "<supportedOS Id=""{e2011457-1546-43c5-a5fe-008deee3d3f0}""/>" & CrLf & _

  _  '"<!-- Windows 7 -->" & CrLf & _

  "<supportedOS Id=""{35138b9a-5d96-4fbd-8e2d-a2440225f93a}""/>" & CrLf & _

  _  '"<!-- Windows 8 -->" & CrLf & _

  "<supportedOS Id=""{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}""/>" & CrLf & _

  "</application>" & CrLf & _

  "</compatibility>" & CrLf & _

  _  '"<!-- Trustinfo section for User Account Control (UAC) -->" & CrLf & _

  "<trustInfo xmlns=""urn:schemas-microsoft-com:asm.v2"">" & CrLf & _

  "<security>" & CrLf & _

  "<requestedPrivileges>" & CrLf & _

  _  '"<!-- level   = ""asInvoker""            -->" & CrLf & _

  _  '"<!-- level   = ""highestAvailable""     -->" & CrLf & _

  _  '"<!-- level   = ""requireAdministrator"" -->" & CrLf & _

  "<requestedExecutionLevel "& CrLf & _

  "level    = ""asInvoker"" " & CrLf & _

  "uiAccess = ""false""/>" & CrLf & _

  "</requestedPrivileges>" & CrLf & _

  "</security>" & CrLf & _

  "</trustInfo>" & CrLf & _

  _  '"<!-- Dependency section -->" & CrLf & _

  "<dependency>" & CrLf & _

  "<dependentAssembly>" & CrLf & _

  "<assemblyIdentity" & CrLf & _

  "type=""win32"" " & CrLf & _

  "name=""Microsoft.Windows.Common-Controls"" " & CrLf & _

  "version=""6.0.0.0"" " & CrLf & _

  "processorArchitecture=""x86"" " & CrLf & _

  "publicKeyToken=""6595b64144ccf1df"" " & CrLf & _

  "language=""*""/>" & CrLf & _

  "</dependentAssembly>" & CrLf & _

  "</dependency>" & CrLf &_

  "</assembly>"



  ' Load the EXE so we can check if the resource already exists

  Dim As HMODULE hMod = LoadLibrary(filename)

  If hMod = 0 Then

    MessageBox (0, "Fehler, " & filename & " nicht gefunden!", WTitel, E_ICON)

    Return GetLastError

  EndIf



  ' Attempt to find the manifest (resource id 1, type 24)

  Dim As HRSRC hRes = FindResource(hMod, MAKEINTRESOURCE(1), MAKEINTRESOURCE(24))



  ' The EXE must be released before we can update the resources

  FreeLibrary(hMod)



  ' If the manifest resource is not already present in the EXE

  If hRes = 0 Then

    ' Load the program ready for updating

    Dim As HANDLE hUpdate = BeginUpdateResource(filename,0)

    If hUpdate = 0 Then Return GetLastError



    ' Add the manifest resource to the list

    ' of updates to be made (resource type 24, id 1)

    Dim As Integer erg = UpdateResource( hUpdate, _

    MAKEINTRESOURCE(24), MAKEINTRESOURCE(1), _

    MAKELANGID(LANG_GERMAN, SUBLANG_GERMAN), _

    StrPtr(szFormat), Len(szFormat))



     ' If the update was rejected

    If erg = 0 Then

      ' Save the last error code

      Dim As Integer dwLastError = GetLastError



      ' Abandon the resource changes and exit

      EndUpdateResource(hUpdate, 1)

      Return(dwLastError)

    EndIf



    ' Apply the change to the specified EXE file

    If EndUpdateResource(hUpdate,0) = 0 Then Return GetLastError



    ' Resource modified successfully

  Else

    MessageBox (0, "Fehler, " & filename & " hat Manifest!", WTitel, E_ICON)

  EndIf

  Return 0

End Function



Function DelManifest(Filename As String) As Integer

    Dim As HANDLE handle = BeginUpdateResource(Filename, 0)

    If handle = 0 Then Return 0

    UpdateResource (handle,MAKEINTRESOURCE(24),MakeIntResource(1),_

    MAKELANGID(LANG_GERMAN, SUBLANG_GERMAN),NULL,0)

    Function = EndUpdateResource(handle, 0)

End Function



'? DelManifest("WinVers.exe")

? AddManifest("WinVers.exe", "© Volta " & Date)

Sleep

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 14.05.2013 von Volta angelegt.
Die aktuellste Version wurde am 14.05.2013 von Volta gespeichert.

Bearbeiten

Versionen