Autoincrement version number in .rc file
От: cpp Россия http://www.elecard.com
Дата: 19.02.03 05:57
Оценка: 5 (2)
Вот понадобилось автоматом увеличивать версию файла и продукта, написал следующий
VBScript, который ищет в дире проекта .rc файл и увеличивает в нем номер вилда
(третья цифирь в полном номере верии) и ставит текущую дату в четвертую.

Может кому понадобиться.


'------------------------------------------------------------------------------
'FILE DESCRIPTION: Marco for increment build number stored in your .rc file.
'------------------------------------------------------------------------------


'VC++ doesn't provide any method for getting the path of the active project
'See the VB Script reference for more information on the VB Script functions 
'used in this function

Function GetProjectDir(FullName)
'DESCRIPTION: Gets full path to current project.

    Dim proj_name
    proj_name = Split(StrReverse(FullName),"\",-1,1)
    proj_name(0) = ""

    GetProjectDir = StrReverse(Join(proj_name, "\"))

End Function


'Get .rc file name
Function GetResourceFileName(folderspec)
'DESCRIPTION: .
    Dim fso, f, f1, fc
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(folderspec)
    Set fc = f.Files

    For Each f1 in fc
        if (Right(f1.name, 2) = "rc") then
            GetResourceFileName = folderspec & f1.name
            Exit Function
        End If
    Next
    GetResourceFileName = ""
End Function



'This event will be triggered before every build of a project
Sub Application_BeforeBuildStart()
'DESCRIPTION: Increment build number and set date.

    Dim NowDate, FileDate, NewYear, NewMonth, NewDay

    ' Get date
    NowDate  = Date

    ' Get year, month and day
    NewYear  = Right(Year(NowDate),2)

    NewMonth = Month(NowDate)
    if (Len(NewMonth) < 2) then NewMonth  = "0" & NewMonth

    NewDay   = Day(NowDate)
    if (Len(NewDay) < 2) then NewDay  = "0" & NewDay

    ' Now make file date in our format
    FileDate = NewYear & NewMonth & NewDay


    'Obtain the full path of the active project
    Dim full_path
    full_path = GetProjectDir(ActiveProject.FullName)

    'Open the .rc file
    Dim rc_name
    rc_name = GetResourceFileName(full_path)

    ' if .rc file doesn't exist then exit
    if (rc_name = "") Then
        Exit Sub
    End If


    ' Open .rc file
    Documents.Open rc_name, "Text"

    'Obtain the TextSelection object
    Dim selection
    set selection = ActiveDocument.Selection
    selection.StartOfDocument

    ' Check for VERSIONINFO
    if (selection.FindText("VERSIONINFO", dsMatchForward + dsMatchWord + dsMatchCase) = False) Then
        Exit Sub
    End If


    ' Change FILEVERSION value
    selection.FindText "FILEVERSION", dsMatchForward + dsMatchWord + dsMatchCase

    ' Increment buildno
    selection.WordRight dsMove, 5
    selection.WordRight dsExtend, 1
    selection.Text = selection.Text + 1

    ' Fresh date
    selection.WordRight dsMove, 1
    selection.WordRight dsExtend, 1
    selection.Text = FileDate


    ' Change PRODUCTVERSION value
    selection.FindText "PRODUCTVERSION", dsMatchForward + dsMatchWord + dsMatchCase

    ' Increment buildno
    selection.WordRight dsMove, 5
    selection.WordRight dsExtend, 1
    selection.Text = selection.Text + 1

    ' Fresh date
    selection.WordRight dsMove, 1
    selection.WordRight dsExtend, 1
    selection.Text = FileDate


    ' Change FileVersion string
    selection.FindText "FileVersion", dsMatchForward + dsMatchWord + dsMatchCase

    ' Increment buildno
    selection.WordRight dsMove, 7
    selection.WordRight dsExtend, 1
    selection.Text = selection.Text + 1

    ' Fresh date
    selection.WordRight dsMove, 1
    selection.WordRight dsExtend, 1
    selection.Text = FileDate


    ' Change ProductVersion string
    selection.FindText "ProductVersion", dsMatchForward + dsMatchWord + dsMatchCase

    ' Increment buildno
    selection.WordRight dsMove, 7
    selection.WordRight dsExtend, 1
    selection.Text = selection.Text + 1

    ' Fresh date
    selection.WordRight dsMove, 1
    selection.WordRight dsExtend, 1
    selection.Text = FileDate


    ' Close .rc file
    Documents(rc_name).Close

End Sub
Сергей.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.