Código: Seleccionar todo

'mAddResource By Slek Thx to Cobein
'Indetectables.net
'15/12/2011
'Ex: bRet = AddResource("C:\1.exe", RT_RCDATA, 101, Buff())

Option Explicit

Public Enum RT
    RT_CURSOR = 1&
    RT_BITMAP = 2&
    RT_ICON = 3&
    RT_MENU = 4&
    RT_DIALOG = 5&
    RT_STRING = 6&
    RT_FONTDIR = 7&
    RT_FONT = 8&
    RT_ACCELERATOR = 9&
    RT_RCDATA = 10&
    RT_MESSAGETABLE = 11&
    RT_GROUP_CURSOR = 12&
    RT_GROUP_ICON = 14&
    RT_VERSION = 16&
    RT_DLGINCLUDE = 17&
    RT_PLUGPLAY = 19&
    RT_VXD = 20&
    RT_ANICURSOR = 21&
    RT_ANIICON = 22&
    RT_HTML = 23&
    RT_MANIFEST = 24&
End Enum

Private Const PADDING As String = "PADDINGXXPADDING"

'Kernel32.Dll

Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Boolean
Private Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Boolean

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'Version.Dll

Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long

Public Function AddResource(ByVal sFileName As String, ByVal lType As RT, ByVal lID As Long, ByRef Buff() As Byte, Optional bRepalcePadd As Boolean = True) As Boolean
    Dim lUpdate     As Long
    Dim lLangId     As Long

    lLangId = GetLangID(sFileName)
    'If Not lLangId = 0 Then
        lUpdate = BeginUpdateResource(sFileName, False)
        If Not lUpdate = 0 Then
            If UpdateResource(lUpdate, lType, lID, lLangId, Buff(0), UBound(Buff) + 1) Then
                If EndUpdateResource(lUpdate, False) Then
                    
                    If bRepalcePadd Then Call ReplacePadd(sFileName)
                    
                    AddResource = True
                    Exit Function
                End If
            End If
            Call EndUpdateResource(lUpdate, True)
        End If
    'End If
End Function

Private Function GetLangID(ByVal sFileName As String) As Long 'By Cobein
    Dim lLen        As Long
    Dim lHandle     As Long
    Dim bvBuffer()  As Byte
    Dim lVerPointer As Long
    Dim iVal        As Integer

    lLen = GetFileVersionInfoSize(sFileName, lHandle)

    If Not lLen = 0 Then
        ReDim bvBuffer(lLen)
        If Not GetFileVersionInfo(sFileName, 0&, lLen, bvBuffer(0)) = 0 Then

            If Not VerQueryValue(bvBuffer(0), "\VarFileInfo\Translation", lVerPointer, lLen) = 0 Then

                CopyMemory iVal, ByVal lVerPointer, 2
                GetLangID = iVal

            End If
        End If
    End If

End Function

Public Sub ReplacePadd(ByVal sFileName As String) 'By Cobein
    Dim iFile       As Integer
    Dim sBuff       As String
    Dim sReplace    As String
    
    sReplace = String$(Len(PADDING), vbNullChar)
    iFile = FreeFile
    
    Open sFileName For Binary Access Read Write As iFile
        sBuff = Space$(LOF(iFile))
        Get iFile, , sBuff
        sBuff = Replace$(sBuff, PADDING, sReplace)
        Put iFile, 1, sBuff
    Close iFile
End Sub