Guidance
指路人
g.yi.org
software / rapidq / Examples / Tools - IDE, Designer, Builder / FreeQ IDE src / inc ide / UpdateVersionInfo.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  

'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 Long
'
'Declare Function BeginUpdateResource Lib "kernel32" _
'Alias "BeginUpdateResourceA" (ByVal pFileName As String, _
'ByVal bDeleteExistingResources As Long) As Long
'
'Declare Function EndUpdateResource Lib "kernel32" _
'Alias "EndUpdateResourceA" (ByVal hUpdate As Long, _
'ByVal fDiscard As Long) As Long


'these are WORD values (lower 16-bit)
     $DEFINE RT_CURSOR           1
     $DEFINE RT_BITMAP           2
     $DEFINE RT_ICON             3
     $DEFINE RT_MENU             4
     $DEFINE RT_DIALOG           5
     $DEFINE RT_STRING           6
     $DEFINE RT_FONTDIR          7
     $DEFINE RT_FONT             8
     $DEFINE RT_ACCELERATOR      9
     $DEFINE RT_RCDATA           10
     $DEFINE RT_MESSAGETABLE     11
     $DEFINE RT_GROUP_CURSOR     12
     $DEFINE RT_GROUP_ICON       14
     $DEFINE RT_VERSION          16
     $DEFINE RT_DLGINCLUDE       17
     $DEFINE RT_PLUGPLAY         19
     $DEFINE RT_VXD              20
     $DEFINE RT_ANICURSOR        21
     $DEFINE RT_ANIICON          22
     $DEFINE RT_HTML             23
     $DEFINE RT_MANIFEST         24
     $DEFINE CREATEPROCESS_MANIFEST_RESOURCE_ID  1
     $DEFINE ISOLATIONAWARE_MANIFEST_RESOURCE_ID 2


     SUB UpdateVersionInfoRes(TheExeName AS STRING, ResText AS STRING)
      DEFSTR s = ResText
'DEFINT resID = 16                 'resource ID, can also be a string ("101","SPLASH", etc)that passes address
      DEFSTR resID = "Version Info"
      DEFINT resLang = &H409  'LangId? English (US)
'CONST exeName = "F:\MathImagicsNT\Tests\UpdateRes\Target.exe"
'CONST bmpFile = "F:\MathImagicsNT\Tests\UpdateRes\testpic1.bmp"
''
'
'DIM PicBMP() AS BYTE  'DIB buffer
''
''Read DIB direct from .BMP file
''
'DIM rSize& , bmpHeader AS BITMAPFILEHEADER
'rSize = FileLen(bmpFile) - LEN(bmpHeader)
'REDIM PicBMP(rSize - 1)
'Open bmpFile FOR Binary AS #1
'Get #1 ,  , bmpHeader  'we just skip the first 14 bytes
'Get #1 ,  , PicBMP  'Here's the DIB bitmap
'Close #1
'

'plug it straight in to UpdateResource
'
      DIM hUpt AS LONG , ret AS LONG
      DEFINT rSize = LEN(ResText)
      hUpt = BeginUpdateResource(TheExeName , 0) 'use 1 to clear all existing!
'ret = UpdateResource(hUpt , VARPTR(resID), 1 , resLang , VARPTR(s) , rSize)
      ret = UpdateResource(hUpt , RT_VERSION, 1 , resLang , VARPTR(s) , rSize)
      ret = EndUpdateResource(hUpt , 0) '0 = change
     END SUB




'
' Private Const RT_VERSION As Long = 16
'
' Private Const LANG_NEUTRAL As Integer = &H0
' Private Const LANG_ENGLISH As Long = &H9
'
' Private Declare Function GetFileVersionInfoSize Lib "Version.dll"
' Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String,
' lpdwHandle As Long) As Long
' Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias
' As Long, ByVal dwlen As Long, lpData As Any) As Long
' Private Declare Function BeginUpdateResource Lib "KERNEL32" Alias
' bDeleteExistingResources As Long) As Long
' Private Declare Function UpdateResource Lib "KERNEL32" Alias
' lpName As Long, ByVal wLanguage As Long, lpData() As Byte, ByVal
' cbData As Long) As Long
' Private Declare Function EndUpdateResource Lib "KERNEL32" Alias
' As Long
'
' Private Sub UpdateFileVersion(ByVal vstrFilePath As String)
'
' Dim llngHandle As Long
' Dim llngVersionInfoLength As Long
' Dim llngResult As Long
' Dim lbytBuffer() As Byte
' Dim llngResourceHandle As Long
' Dim llngReturnValue As Long
'
' llngVersionInfoLength = GetFileVersionInfoSize(vstrFilePath,
' llngHandle)
'
' If llngVersionInfoLength <> 0 Then
' ReDim lbytBuffer(llngVersionInfoLength - 1)
'
' llngResult = GetFileVersionInfo(vstrFilePath, 0,
' llngVersionInfoLength, lbytBuffer(0))
'
' If llngResult <> 0 Then
' 'QUICK AND DIRTY UPDATING OF VERSION NUMBER, JUST TO CHECK
' IT WORKS
'
' 'UPDATE FILE VERSION NUMBER
' lbytBuffer(50) = 5
' lbytBuffer(48) = 6
' lbytBuffer(54) = 7
' lbytBuffer(52) = 8
'
' 'UPDATE PRODUCT VERSION NUMBER
' lbytBuffer(58) = 5
' lbytBuffer(56) = 6
' lbytBuffer(62) = 7
' lbytBuffer(60) = 8
'
' llngResourceHandle = BeginUpdateResource(vstrFilePath, 0)
'
' If llngResourceHandle <> 0 Then
' llngReturnValue = UpdateResource(llngResourceHandle,
' RT_VERSION, 1, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), lbytBuffer,
' llngVersionInfoLength)
'
' If llngReturnValue = 0 Then
' MsgBox "Unable to update resource (" &
' Err.LastDllError & ")", vbExclamation, Me.Caption
' End If
'
' llngReturnValue =
' EndUpdateResource(llngResourceHandle, 0)
'
' If llngReturnValue <> 0 Then
' MsgBox "Version number updated", vbInformation,
' Me.Caption
' Else
' MsgBox "Unable to write updated resource (" &
' Err.LastDllError & ")", vbExclamation, Me.Caption
' End If
' Else
' MsgBox "Unable to retrieve resource update handle",
' vbExclamation, Me.Caption
' End If
' Else
' MsgBox "Unable to get file version info (" &
' Err.LastDllError & ")", vbExclamation, Me.Caption
' End If
' Else
' MsgBox "Unable to get file version info size (" &
' Err.LastDllError & ")", vbExclamation, Me.Caption
' End If
'
' End Sub
'
' Public Function MAKELANGID(ByVal vintPrimaryLanguage As Integer, ByVal
' vintSubLanguage As Integer) As Long
'
' MAKELANGID = (vintSubLanguage * 1024) Or vintPrimaryLanguage
'
' End Function

掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Fri 2024-4-19  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2010-12-07 21:18:03