Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Dateien und Laufwerke

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

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.RedakteurVolta 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 RedakteurVolta angelegt.
  • Die aktuellste Version wurde am 14.05.2013 von RedakteurVolta gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen