发信人: jiangsheng()
整理人: mrcloud(2000-08-24 02:28:40), 站内信件
|
I have tens of projects in my workspace. It is so boring to update ver
sion info(mainly,the version number) and I wrote this macro to replace
version info for every project.
Usage:
Input version information,include following:
1.company name.
2.Trademark.
3.Copyright.
4.File Version.
5.Product Version.
Note:if you input an empty string,then no changes are made on correspo
nd version information.
The macro will prompt you if you want the changes applies to all proje
ct. If you select NO, the macro will prompt for every project just bef
ore apply changes.You can stop the macro by clicking "Cancel".
Note: hide wizard bar to skip reloading RC file for better performance
.
Sub SetProjectVersionInfo()
'DESCRIPTION: Set version information in rc script for one or more pro
ject(s) in current workspace .Company Name,Trademark,LegalCopyright,an
d version number.If some information is empty, then no changes are mad
e on correspond version information.
'Created by Jiang Sheng at 2000-6-21 16:48
DIM strCompanyName
DIM strTrademark
DIM strLegalCopyright
DIM strFileVersion
DIM strProductVersion
DIM bAllProject
DIM bApply
DIM nResult
bAllProject=1
Dim oneProject
if Application.Projects.Count =0 then
MsgBox("No project available.")
Exit Sub
end if
strCompanyName= InputBox ("Please input company name:"& Chr(13) & Chr
(10)&"Empty means no changes.","Input Company Name")
strTrademark= InputBox ("Please input legal trademarks:"& Chr(13) & C
hr(10)&"Empty means no changes.","Input Legal Trademarks")
strLegalCopyright= InputBox ("Please input legal copyright:"& Chr(13)
& Chr(10)&"Empty means no changes.","Input Legal Copyright")
strFileVersion= InputBox ("Please input file version:"& Chr(13) & Chr
(10)&"Empty means no changes."& Chr(13) & Chr(10)& "Version must in x,
x,x,x format.","Input File Version")
strProductVersion= InputBox ("Please input product version:"& Chr(13)
& Chr(10)&"Empty means no changes."& Chr(13) & Chr(10)& "Version must
in x,x,x,x format.","Input Product Version")
nResult=MsgBox("Apply changes for all projects？",VbYesNoCancel)
SELECT CASE nResult
case vbYes
bAllProject=1
case vbNo
bAllProject=0
case vbCancel
Exit Sub
End SELECT
For Each oneProject in Application.Projects
if bAllProject=0 then
nResult=MsgBox("Apply changes for project "+oneProject.Name+"?",VbY
esNo)
else
bApply=1
end if
SELECT CASE nResult
case vbYes
bApply=1
case vbNo
bApply=0
case vbCancel
Exit Sub
End SELECT
if bApply then
set ActiveProject=Projects(oneProject.Name)
Dim strTemp
Dim documentObject
' open the project's resource script:
strTemp = ActiveProject.FullName
Wnd = Left(strTemp, Len(strTemp) - 3) + "rc"
Documents.Open (Wnd), "Text"
For Each documentObject in Application.Documents
if documentObject.FullName = Wnd then
documentObject.Active = True
exit for
end if
Next
' SAVE BACK-UP OF FILE >>>>
ActiveDocument.Save (Wnd+"~")
ActiveDocument.Close()
Documents.Open Wnd, "Text"
if strCompanyName<>"" then
ActiveDocument.Selection.FindText "VALUE ""CompanyName"", """, dsM
atchForward + dsMatchFromStart + dsMatchCase
ActiveDocument.Selection.CharRight
ActiveDocument.Selection.EndOfLine dsExtend
ActiveDocument.Selection.CharLeft dsExtend, 3
ActiveDocument.Selection.Text=strCompanyName
end if
if strTrademark<>"" then
ActiveDocument.Selection.FindText "VALUE ""LegalTrademarks"", """,
dsMatchForward + dsMatchFromStart + dsMatchCase
ActiveDocument.Selection.CharRight
ActiveDocument.Selection.EndOfLine dsExtend
ActiveDocument.Selection.CharLeft dsExtend, 3
ActiveDocument.Selection.Text=strTrademark
end if
if strLegalCopyright<>"" then
ActiveDocument.Selection.FindText "VALUE ""LegalCopyright"", """,
dsMatchForward + dsMatchFromStart + dsMatchCase
ActiveDocument.Selection.CharRight
ActiveDocument.Selection.EndOfLine dsExtend
ActiveDocument.Selection.CharLeft dsExtend, 3
ActiveDocument.Selection.Text=strLegalCopyright
end if
if strFileVersion<>"" then
ActiveDocument.Selection.FindText "FILEVERSION", dsMatchForward +
dsMatchFromStart + dsMatchCase + dsMatchWord
ActiveDocument.Selection.WordRight
ActiveDocument.Selection.EndOfLine dsExtend
ActiveDocument.Selection.Text=strFileVersion
ActiveDocument.Selection.FindText "VALUE ""FileVersion"",", dsMatc
hForward + dsMatchFromStart + dsMatchCase
ActiveDocument.Selection.WordRight dsMove,2
ActiveDocument.Selection.EndOfLine dsExtend
ActiveDocument.Selection.CharLeft dsExtend, 3
ActiveDocument.Selection.Text=strFileVersion
end if
if strProductVersion<>"" then
ActiveDocument.Selection.FindText "PRODUCTVERSION", dsMatchForward
+ dsMatchFromStart + dsMatchCase + dsMatchWord
ActiveDocument.Selection.WordRight
ActiveDocument.Selection.EndOfLine dsExtend
ActiveDocument.Selection.Text=strFileVersion
ActiveDocument.Selection.FindText "VALUE ""ProductVersion"",", dsM
atchForward + dsMatchFromStart + dsMatchCase
ActiveDocument.Selection.WordRight dsMove,2
ActiveDocument.Selection.EndOfLine dsExtend
ActiveDocument.Selection.CharLeft dsExtend, 3
ActiveDocument.Selection.Text=strProductVersion
end if
ActiveDocument.Save()
ActiveDocument.Close()
End if
Next
End Sub
--
HE WHO CONTROLS THE PAST, COMMANDS THE FUTURE.
HE WHO CONTROLS THE FUTURE CONQUERS THE PAST.
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.96.44.196]
|
|