Die Community zu .NET und Classic VB.
Menü

Tipp-Upload: VB.NET 0465: Test-Upload

 von 

Hinweis zum Tippvorschlag  

Der Download dieses Vorschlags wurde gesperrt. Die Begründung für die Sperrung lautet: Gesperrt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

  • Fenster

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
test

Der Vorschlag wurde erstellt am: 02.12.2019 19:59.
Die letzte Aktualisierung erfolgte am 02.12.2019 19:59.

Zurück zur Übersicht

Beschreibung  

Test-Upload von svenscherners TU

Schwierigkeitsgrad

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

Download:

Download nicht freigeschaltet.
' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ---------- Anfang Projektgruppe Icon_changer.sln  ----------
' --------- Anfang Projektdatei Icon_changer.vbproj  ---------
' ------------- Anfang Datei frm_icon_changer.vb -------------
Imports System.Security.Principal

Public Class frm_icon_changer

    Dim file_path As String = ""
    Dim icon_path As String = ""

    Public Function IsUserAdministrator() As Boolean

        Dim isAdmin As Boolean

        Try

            Dim user As WindowsIdentity = WindowsIdentity.GetCurrent()
            Dim principal As WindowsPrincipal = New WindowsPrincipal(user)

            isAdmin = principal.IsInRole(WindowsBuiltInRole.Administrator)

        Catch ex As UnauthorizedAccessException

            isAdmin = False
            MessageBox.Show(ex.Message)

        Catch ex As Exception

            isAdmin = False
            MessageBox.Show(ex.Message)

        End Try

        Return isAdmin

    End Function

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        If IsUserAdministrator() Then
            OpenFileDialog_exe_path.ShowDialog()

            If OpenFileDialog_exe_path.FileName = "" Then
                MsgBox("Sie müssen eine Datei auswählen!", MsgBoxStyle.Critical)

                Exit Sub

            Else

                file_path = OpenFileDialog_exe_path.FileName
                OpenFileDialog_icon_path.ShowDialog()

                If OpenFileDialog_icon_path.FileName = "" Then
                    MsgBox("Sie müssen ein Icon auswählen!", MsgBoxStyle.Critical)

                    Exit Sub

                Else

                    icon_path = OpenFileDialog_icon_path.FileName

                    IconInjector.InjectIcon(file_path, icon_path)

                End If

            End If

        Else

            MsgBox("Sie müssen die Anwendung als Administrator starten!", MsgBoxStyle.Critical)
        End If

    End Sub

End Class

' -------------- Ende Datei frm_icon_changer.vb --------------
' --------------- Anfang Datei IconInjector.vb ---------------

Imports System.Runtime.InteropServices
Imports System.Security

Public Class IconInjector

    ' Basically, you can change icons with the UpdateResource api call.
    ' When you make the call you say "I'm updating an icon", and you send the icon data.
    ' The main problem is that ICO files store the icons in one set of structures, and
    ' exe/dll files store them in
    ' another set of structures. So you have to translate between the two -- you can't just
    ' load the ICO file as
    ' bytes and send them with the UpdateResource api call.
    <SuppressUnmanagedCodeSecurity()>

    Private Class NativeMethods

        <DllImport("kernel32")>

        Public Shared Function BeginUpdateResource(

            ByVal fileName As String,
            <MarshalAs(UnmanagedType.Bool)> ByVal deleteExistingResources As Boolean) As IntPtr

        End Function

        <DllImport("kernel32")>

        Public Shared Function UpdateResource(

            ByVal hUpdate As IntPtr,
            ByVal type As IntPtr,
            ByVal name As IntPtr,
            ByVal language As Short,
            <MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=5)>
            ByVal data() As Byte,
            ByVal dataSize As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean

        End Function

        <DllImport("kernel32")>

        Public Shared Function EndUpdateResource(

            ByVal hUpdate As IntPtr,

            <MarshalAs(UnmanagedType.Bool)> ByVal discard As Boolean) As <MarshalAs( _
                UnmanagedType.Bool)> Boolean

        End Function

    End Class

    ' The first structure in an ICO file lets us know how many images are in the file.
    <StructLayout(LayoutKind.Sequential)>

    Private Structure ICONDIR

        Public Reserved As UShort  ' Reserved, must be 0
        Public Type As UShort      ' Resource type, 1 for icons.
        Public Count As UShort     ' How many images.

        ' The native structure has an array of ICONDIRENTRYs as a final field.
    End Structure

    ' Each ICONDIRENTRY describes one icon stored in the ico file. The offset says where the
    ' icon image data
    ' starts in the file. The other fields give the information required to turn that image
    ' data into a valid
    ' bitmap.
    <StructLayout(LayoutKind.Sequential)>

    Private Structure ICONDIRENTRY

        Public Width As Byte            ' Width, in pixels, of the image
        Public Height As Byte           ' Height, in pixels, of the image
        Public ColorCount As Byte       ' Number of colors in image (0 if >=8bpp)
        Public Reserved As Byte         ' Reserved ( must be 0)
        Public Planes As UShort         ' Color Planes
        Public BitCount As UShort       ' Bits per pixel
        Public BytesInRes As Integer   ' Length in bytes of the pixel data
        Public ImageOffset As Integer  ' Offset in the file where the pixel data starts.

    End Structure

    ' Each image is stored in the file as an ICONIMAGE structure:
    ' typdef struct
    ' {
    '   BITMAPINFOHEADER   icHeader;      // DIB header
    '   RGBQUAD         icColors[1];   // Color table
    '   BYTE            icXOR[1];      // DIB bits for XOR mask
    '   BYTE            icAND[1];      // DIB bits for AND mask
    ' } ICONIMAGE, *LPICONIMAGE;

    <StructLayout(LayoutKind.Sequential)>

    Private Structure BITMAPINFOHEADER

        Public Size As UInteger
        Public Width As Integer
        Public Height As Integer
        Public Planes As UShort
        Public BitCount As UShort
        Public Compression As UInteger
        Public SizeImage As UInteger
        Public XPelsPerMeter As Integer
        Public YPelsPerMeter As Integer
        Public ClrUsed As UInteger
        Public ClrImportant As UInteger

    End Structure

    ' The icon in an exe/dll file is stored in a very similar structure:
    <StructLayout(LayoutKind.Sequential, Pack:=2)>

    Private Structure GRPICONDIRENTRY

        Public Width As Byte
        Public Height As Byte
        Public ColorCount As Byte
        Public Reserved As Byte
        Public Planes As UShort
        Public BitCount As UShort
        Public BytesInRes As Integer
        Public ID As UShort

    End Structure

    Public Shared Sub InjectIcon(ByVal exeFileName As String, ByVal iconFileName As String)

        InjectIcon(exeFileName, iconFileName, 1, 1)

    End Sub

    Public Shared Sub InjectIcon(ByVal exeFileName As String, ByVal iconFileName As String, _
        ByVal iconGroupID As UInteger, ByVal iconBaseID As UInteger)

        Const RT_ICON As Integer = 3UI
        Const RT_GROUP_ICON As Integer = 14UI

        Dim iconFile As IconFile = IconFile.FromFile(iconFileName)
        Dim hUpdate = NativeMethods.BeginUpdateResource(exeFileName, False)
        Dim data = iconFile.CreateIconGroupData(iconBaseID)

        NativeMethods.UpdateResource(hUpdate, New IntPtr(RT_GROUP_ICON), New IntPtr( _
            iconGroupID), 0, data, data.Length)

        For i = 0 To iconFile.ImageCount - 1

            Dim image = iconFile.ImageData(i)

            NativeMethods.UpdateResource(hUpdate, New IntPtr(RT_ICON), New IntPtr(iconBaseID _
                + i), 0, image, image.Length)

        Next

        NativeMethods.EndUpdateResource(hUpdate, False)

    End Sub

    Private Class IconFile

        Private iconDir As New ICONDIR
        Private iconEntry() As ICONDIRENTRY
        Private iconImage()() As Byte

        Public ReadOnly Property ImageCount() As Integer
            Get
                Return iconDir.Count

            End Get

        End Property

        Public ReadOnly Property ImageData(ByVal index As Integer) As Byte()
            Get
                Return iconImage(index)

            End Get

        End Property

        Private Sub New()

        End Sub

        Public Shared Function FromFile(ByVal filename As String) As IconFile

            Dim instance As New IconFile

            ' Read all the bytes from the file.
            Dim fileBytes() As Byte = IO.File.ReadAllBytes(filename)

            ' First struct is an ICONDIR
            ' Pin the bytes from the file in memory so that we can read them.
            ' If we didn't pin them then they could move around (e.g. when the
            ' garbage collector compacts the heap)
            Dim pinnedBytes = GCHandle.Alloc(fileBytes, GCHandleType.Pinned)

            ' Read the ICONDIR
            instance.iconDir = DirectCast(Marshal.PtrToStructure( _
                pinnedBytes.AddrOfPinnedObject, GetType(ICONDIR)), ICONDIR)

            ' which tells us how many images are in the ico file. For each image, there's a
            ' ICONDIRENTRY, and associated pixel data.
            instance.iconEntry = New ICONDIRENTRY(instance.iconDir.Count - 1) {}
            instance.iconImage = New Byte(instance.iconDir.Count - 1)() {}

            ' The first ICONDIRENTRY will be immediately after the ICONDIR, so the offset to
            ' it is the size of ICONDIR
            Dim offset = Marshal.SizeOf(instance.iconDir)

            ' After reading an ICONDIRENTRY we step forward by the size of an ICONDIRENTRY
            Dim iconDirEntryType = GetType(ICONDIRENTRY)
            Dim size = Marshal.SizeOf(iconDirEntryType)

            For i = 0 To instance.iconDir.Count - 1

                ' Grab the structure.
                Dim entry = DirectCast(Marshal.PtrToStructure(New IntPtr( _
                    pinnedBytes.AddrOfPinnedObject.ToInt64 + offset), iconDirEntryType), _
                    ICONDIRENTRY)

                instance.iconEntry(i) = entry

                ' Grab the associated pixel data.
                instance.iconImage(i) = New Byte(entry.BytesInRes - 1) {}

                Buffer.BlockCopy(fileBytes, entry.ImageOffset, instance.iconImage(i), 0, _
                    entry.BytesInRes)

                offset += size
            Next

            pinnedBytes.Free()
            Return instance

        End Function

        Public Function CreateIconGroupData(ByVal iconBaseID As UInteger) As Byte()

            ' This will store the memory version of the icon.
            Dim sizeOfIconGroupData As Integer = Marshal.SizeOf(GetType(ICONDIR)) + _
                Marshal.SizeOf(GetType(GRPICONDIRENTRY)) * ImageCount

            Dim data(sizeOfIconGroupData - 1) As Byte
            Dim pinnedData = GCHandle.Alloc(data, GCHandleType.Pinned)

            Marshal.StructureToPtr(iconDir, pinnedData.AddrOfPinnedObject, False)

            Dim offset = Marshal.SizeOf(iconDir)

            For i = 0 To ImageCount - 1

                Dim grpEntry As New GRPICONDIRENTRY
                Dim bitmapheader As New BITMAPINFOHEADER
                Dim pinnedBitmapInfoHeader = GCHandle.Alloc(bitmapheader, GCHandleType.Pinned)

                Marshal.Copy(ImageData(i), 0, pinnedBitmapInfoHeader.AddrOfPinnedObject, _
                    Marshal.SizeOf(GetType(BITMAPINFOHEADER)))

                pinnedBitmapInfoHeader.Free()
                grpEntry.Width = iconEntry(i).Width
                grpEntry.Height = iconEntry(i).Height
                grpEntry.ColorCount = iconEntry(i).ColorCount
                grpEntry.Reserved = iconEntry(i).Reserved
                grpEntry.Planes = bitmapheader.Planes
                grpEntry.BitCount = bitmapheader.BitCount
                grpEntry.BytesInRes = iconEntry(i).BytesInRes
                grpEntry.ID = CType(iconBaseID + i, UShort)

                Marshal.StructureToPtr(grpEntry, New IntPtr( _
                    pinnedData.AddrOfPinnedObject.ToInt64 + offset), False)

                offset += Marshal.SizeOf(GetType(GRPICONDIRENTRY))
            Next

            pinnedData.Free()
            Return data

        End Function

    End Class
End Class

' ---------------- Ende Datei IconInjector.vb ----------------
' ---------- Ende Projektdatei Icon_changer.vbproj  ----------
' ----------- Ende Projektgruppe Icon_changer.sln  -----------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.