Custom Version Info
Publicado: 09 Ago 2013, 02:19
por chequinho
Buenas bros, bueno por ahi tenian la duda de como colocar su Version Info propio (dándole ustedes valores a las strings). En realidad es sencillo:
Necesitaremos el modulo mAddResource (del amigo Slek):
Necesitaremos crearnos algo que sirva como una tabla para poder editar los valores, en este caso yo use un ListView, pero se puede hacer a base de Labels y TextBox (para mayor comodidad)
Una vez que tengamos los valores de cada campo que queramos agregar, vamos a necesitar crear un script de recursos, en donde se deberán colocar todos los valores:
Después, lo que hacemos es finalmente colocar lo que necesitamos en nuestro cliente, para esto vamos a utilizar un archivo que viene con el VB6 (RC.EXE), lo pueden encontrar en X:\Program Files\Microsoft Visual Studio\COMMON\MSDev98\Bin. Este archivo es el que nos permitirá compilar el script de recursos para hacer un .RES y poderlo adjuntar al ejecutable en cuestión.
Y eso es todo, se que hay formas más sutiles de hacerlo, pero es lo primero que me salió xD.
Haber si a alguien le sirve bros.
Saludos.
Necesitaremos el modulo mAddResource (del amigo Slek):
'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 SubUna vez que tengamos los valores de cada campo que queramos agregar, vamos a necesitar crear un script de recursos, en donde se deberán colocar todos los valores:
Public Function getRCFile(FileName As String, ProductVer As String, Company As String, FileDesc As String, FileVer As String, InternalName As String, _
OriginalName As String, Copyright As String, Comments As String) As String
getRCFile = vbNewLine & _
"1 VERSIONINFO" & vbNewLine & _
"FILEVERSION " & FileVer & vbNewLine & _
"PRODUCTVERSION " & ProductVer & vbNewLine & _
"FILEOS 0x4" & vbNewLine & _
"FILETYPE 0x2" & vbNewLine & _
"{" & vbNewLine & _
"BLOCK " & Chr(34) & "StringFileInfo" & Chr(34) & "" & vbNewLine & _
"{" & vbNewLine & _
"BLOCK " & Chr(34) & "040904b0" & Chr(34) & "" & vbNewLine & _
"{" & vbNewLine & _
"VALUE " & Chr(34) & "Comments" & Chr(34) & ", " & Chr(34) & Comments & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "CompanyName" & Chr(34) & ", " & Chr(34) & Company & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "FileDescription" & Chr(34) & ", " & Chr(34) & FileDesc & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "FileVersion" & Chr(34) & ", " & Chr(34) & Replace(FileVer, ",", ", ") & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "InternalName" & Chr(34) & ", " & Chr(34) & InternalName & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "LegalCopyright" & Chr(34) & ", " & Chr(34) & Copyright & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "OriginalFilename" & Chr(34) & ", " & Chr(34) & OriginalName & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "ProductName" & Chr(34) & ", " & Chr(34) & FileName & Chr(34) & "" & vbNewLine & _
"VALUE " & Chr(34) & "ProductVersion" & Chr(34) & ", " & Chr(34) & Replace(ProductVer, ",", ", ") & Chr(34) & "" & vbNewLine
getRCFile = getRCFile & _
"}" & vbNewLine & _
"}" & vbNewLine & _
vbNewLine & _
"BLOCK " & Chr(34) & "VarFileInfo" & Chr(34) & "" & vbNewLine & _
"{" & vbNewLine & _
"VALUE " & Chr(34) & "Translation" & Chr(34) & ", 0x0409 0x04B0" & vbNewLine & _
"}" & vbNewLine & _
"}" & vbNewLine & _
vbNewLine
End FunctionIf bCustomInfo = True Then
If Not FileExist(App.Path & "\stub.original") Then Call CopyFile(App.Path & "\stub.dll", App.Path & "\stub.original") 'Hacemos backup del stub original por si acaso
Dim sFile As String
Dim Src As String
Dim sRES As String
Dim bRES() As Byte
Dim RESData As String
Dim sRCEXE As String
Dim bRCEXE() As Byte
sFile = App.Path & "\stub.dll" 'El archivo a modificar, en este caso el stub
Src = App.Path & "\VersionInfo.rc" 'La ruta donde queremos guardar el script de recursos
sRES = App.Path & "\VersionInfo.RES" 'La ruta donde queramos guardar el archivo de recursos ya compilado
sRCEXE = Environ$("TEMP") & "\RC.EXE" 'La ruta del archivo RC.EXE
bRCEXE = LoadResData(110, "CUSTOM") 'En mi caso, cargaré el archivo desde recursos y lo escribo en la ruta antes mencionada
Open sRCEXE For Binary As #1
Put #1, , bRCEXE
Close #1
'Escribimos en disco el archivo .rc (el script de recursos SIN compilar aun)
Call WriteFile(Src, getRCFile(sCustomInfo(0), sCustomInfo(1), sCustomInfo(2), sCustomInfo(3), sCustomInfo(4), sCustomInfo(5), sCustomInfo(6), sCustomInfo(7), sCustomInfo(8)))
Sleep 1000 'Le damos chance para que lo escriba en disco
Call RunFile(sRCEXE, "-R -FO " & sRES & " " & Src) 'Ejecutamos el RC.EXE con los comandos -R -FO Ruta_RES Ruta_rc para compilar el script de recursos
Sleep 1000 'Le damos chance para que lo escriba en disco
RESData = StringToHex(ReadFile(sRES)) 'Leemos el archivo RES ya compilado y lo transformamos a Hexadecimal (Esto se puede hacer de muchas maneras, a mi me dio pereza y lo hice así xD).
RESData = HexToString(Right$(RESData, Len(RESData) - 128)) 'Le quitamos los primeros 128 caracteres hexadecimales a la cadena, ya que no permiten que el modulo lea bien el buffer al contenet bytes "basura", y lo volvemos a convertir de hexadecimal a cadena
bRES = StrConv(RESData, vbFromUnicode) 'Convertimos los datos nuevos a bytes
Call AddResource(sFile, RT_VERSION, 1, bRES) 'Llamamos al modulo de AddResource y le pasamos como parámetros el archivo al cual queremos cambiarle el recurso, el tipo de recurso que se quiere cambiar o agregar, el ID de recurso y el buffer de bytes mencionado anteriormente
'Una vez acabado el proceso, borramos los archivos que se generaron
Call DeleteFile(Src)
Call DeleteFile(sRES)
Call DeleteFile(sRCEXE)
End IfHaber si a alguien le sirve bros.
Saludos.