Генерация запускаемого файла

Imports System.IO
Imports System.Runtime.InteropServices
 
Public Class ResManager_Win32 : Implements IDisposable
 
#Region "    WinAPIs"
    Declare Function LoadLibrary Lib "kernel32.DLL" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As IntPtr
    Declare Function FreeLibrary Lib "kernel32.DLL" (ByVal hLibModule As IntPtr) As IntPtr
    Declare Function FindResource Lib "kernel32.DLL" Alias "FindResourceA" (ByVal hInstance As IntPtr, ByVal lpName As String, ByVal lpType As String) As IntPtr
    Declare Function LoadResource Lib "kernel32.DLL" (ByVal hInstance As IntPtr, ByVal hResInfo As IntPtr) As IntPtr
    Declare Function LockResource Lib "kernel32.DLL" (ByVal hResData As IntPtr) As IntPtr
    Declare Function SizeofResource Lib "kernel32.DLL" (ByVal hInstance As IntPtr, ByVal hResInfo As IntPtr) As Integer
    Declare Function BeginUpdateResource Lib "kernel32.DLL" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Integer) As IntPtr
    Declare Function UpdateResource Lib "kernel32.DLL" Alias "UpdateResourceA" (ByVal hUpdate As IntPtr, ByVal lpType As String, ByVal lpName As String, ByVal wLanguage As Integer, <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.AsAny)> ByVal lpData As Object, ByVal cbData As Integer) As IntPtr
    Declare Function EndUpdateResource Lib "kernel32.DLL" Alias "EndUpdateResourceA" (ByVal hUpdate As IntPtr, ByVal fDiscard As Integer) As IntPtr
    Declare Unicode Function EnumResourceNames Lib "kernel32.DLL" Alias "EnumResourceNamesW" (ByVal hModule As IntPtr, ByVal lpszType As String, ByVal lpEnumFunc As EnumResNameProcDelegate, ByVal lParam As IntPtr) As Boolean
    Delegate Function EnumResNameProcDelegate(ByVal hModule As IntPtr, ByVal lpszType As IntPtr, ByVal lpszName As IntPtr, ByVal lParam As IntPtr) As Boolean
#End Region
#Region "    Dispose methods"
    Protected Overridable Sub Dispose(disposing As Boolean)
        If Not disposedValue Then
            If disposing Then
                fName = Nothing
            End If
 
            GC.Collect()
            disposedValue = True
        End If
    End Sub
 
    Public Sub Dispose() Implements IDisposable.Dispose
        Dispose(disposing:=True)
        GC.SuppressFinalize(Me)
    End Sub
#End Region
#Region "    Private Variables"
    Private disposedValue As Boolean
    Private fName As String
    Private EnumsReturnValues() As String
#End Region
#Region "    Private Methods"
    Private Function EnumResNameProc(hModule As IntPtr, lpszType As IntPtr, lpszName As IntPtr, a As IntPtr) As Boolean
        Dim s As String
 
        If lpszName.ToInt32 > Short.MaxValue Then
            s = Marshal.PtrToStringUni(lpszName)
        Else
            s = lpszName.ToString()
        End If
 
        ReDim Preserve EnumsReturnValues(EnumsReturnValues.Count)
        EnumsReturnValues(EnumsReturnValues.Count - 1) = s
 
        Return True
    End Function
#End Region
#Region "    Class Constructor"
    Sub New(FileName As String)
        If Not IO.File.Exists(FileName) Then Throw New Exception("File not exist.")
        fName = FileName
    End Sub
#End Region
 
#Region "    Public Loading Resources"
    Public Function GetResourceNames(ResType As String) As String()
        Dim hLibrary = LoadLibrary(fName)
        EnumsReturnValues = Nothing
 
        If hLibrary <> IntPtr.Zero Then
            EnumsReturnValues = {}
            EnumResourceNames(hLibrary, ResType, AddressOf EnumResNameProc, IntPtr.Zero)
        End If
 
        FreeLibrary(hLibrary)
        hLibrary = Nothing
        GC.Collect()
 
        Return EnumsReturnValues
    End Function
 
    Public Function Load_Bitmap(ResType As String, ResName As String) As Bitmap
        Dim b = Load_Bytes(ResType, ResName)
        If Not b Is Nothing Then
            Using M = New MemoryStream(b)
                Return New Bitmap(M)
            End Using
        Else
            b = Nothing
        End If
 
        Return Nothing
    End Function
 
    Public Function Load_Bytes(ResType As String, ResName As String) As Byte()
        Dim hLibrary = LoadLibrary(fName)
        Dim hRes = FindResource(hLibrary, ResName, ResType)
        Dim hResLoad = LoadResource(hLibrary, hRes)
        Dim hResLock = LockResource(hResLoad)
        Dim intResSize = SizeofResource(hLibrary, hRes)
 
        Dim isSuccessfull As Boolean = (hLibrary <> IntPtr.Zero And hRes <> IntPtr.Zero And hResLoad <> IntPtr.Zero And hResLock <> IntPtr.Zero And intResSize <> 0)
        hRes = Nothing : hResLoad = Nothing
 
        If Not isSuccessfull Then
            FreeLibrary(hLibrary)
            hLibrary = Nothing
            hResLock = Nothing
            intResSize = Nothing
            GC.Collect()
            Return Nothing
        End If
 
        Dim ResBuffer(intResSize - 1) As Byte
 
        Try
            Marshal.Copy(hResLock, ResBuffer, 0, ResBuffer.Length)
            FreeLibrary(hLibrary)
            hLibrary = Nothing
            hResLock = Nothing
            intResSize = Nothing
            GC.Collect()
            Return ResBuffer
        Catch ex As Exception
            FreeLibrary(hLibrary)
            hLibrary = Nothing
            hResLock = Nothing
            intResSize = Nothing
            ResBuffer = Nothing
            GC.Collect()
            Return Nothing
        End Try
    End Function
#End Region
 
#Region "    Public Saving Resources"
    Public Function Save_Resource(ByteArray() As Byte, ResType As String, ResName As String) As Boolean
        Dim hUpdate = BeginUpdateResource(fName, False)
        Dim RetUpdate = UpdateResource(hUpdate, ResType, ResName.ToUpper, 0, ByteArray, ByteArray.Length)
        Dim EndRetUpdate = EndUpdateResource(hUpdate, False)
 
        If EndRetUpdate = IntPtr.Zero Then MsgBox("Файл занят другим процессом.")
 
        Dim isSuccessfull As Boolean = (hUpdate <> IntPtr.Zero And RetUpdate <> IntPtr.Zero And EndRetUpdate <> IntPtr.Zero)
        hUpdate = Nothing : RetUpdate = Nothing : EndRetUpdate = Nothing : GC.Collect()
 
        Return isSuccessfull
    End Function
#End Region
End Class