自动修改Delphi工程文件(dpr)的编译版本号

软件截图：



Delphi工程的版本修改只能通过Project/Options/Version Info来手动修改，当我们有几十个项目需要同时修改版本时，就会被折腾的累死。本人就是因为要维护一个项目，而这个项目有50多个不同的版本，需要更新版本的时候，几乎所有的工程都得手动改一遍，费时费力费神。于是，我就产生了编写一个批处理修改项目版本的工具的想法，并立即付诸实现。

首先我用源代码管理工具SVN, 比较了我修改版本好前后的文件的差异，发现仅仅就有两个文件不同，一个是 *.Dproj, 另外一个是*.Res。于是我就开始分析两个文件的格式，*.Dproj是一个XML文件，UTF8存储。*.Res是标准的资源文件。知道了文件格式就好办了，后边就不多说了，贴上代码(代码中用到了第三方控件ResourceUtils)：

unit MainFrm;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, ButtonGroup;

type

TMainForm = class(TForm)

lvwProjectList: TListView;

btnAddProject: TButton;

btnDeleteProject: TButton;

btnSingleModify: TButton;

btnMultiModify: TButton;

edMajor: TEdit;

Label1: TLabel;

edMinor: TEdit;

Label2: TLabel;

edRelease: TEdit;

Label3: TLabel;

edBuild: TEdit;

Label4: TLabel;

UpMajor: TUpDown;

UpMinor: TUpDown;

UpRelease: TUpDown;

UpBuild: TUpDown;

btnRefreshProjects: TButton;

btnSaveProjectList: TButton;

btnLoadProjectList: TButton;

procedure btnAddProjectClick(Sender: TObject);

procedure lvwProjectListDeletion(Sender: TObject; Item: TListItem);

procedure btnDeleteProjectClick(Sender: TObject);

procedure lvwProjectListCustomDrawItem(Sender: TCustomListView;

Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

procedure lvwProjectListClick(Sender: TObject);

procedure btnSingleModifyClick(Sender: TObject);

procedure btnRefreshProjectsClick(Sender: TObject);

procedure btnMultiModifyClick(Sender: TObject);

procedure btnSaveProjectListClick(Sender: TObject);

procedure btnLoadProjectListClick(Sender: TObject);

private

function GetProjectResFileName(const FileName: string): string;

procedure AddProjectToList(const FileName: string);

function ExistsProject(const FileName: string): Boolean;

function ModifySingle(Item: TListItem; var ErrStr: string): Boolean;

public

end;

TRecordObject = class

Major, Minor, Release, Build: Word;

FileName: string;

end;

var

MainForm: TMainForm;

implementation

uses MiscFuncsUnit;

{$R *.dfm}

procedure TMainForm.AddProjectToList(const FileName: string);

var

ListItem: TListItem;

LFileName: string;

VerObj: TRecordObject;

begin

LFileName := GetProjectResFileName(FileName);

VerObj := TRecordObject.Create;

VerObj.FileName := FileName;

ListItem := lvwProjectList.Items.Add;

ListItem.Caption := '';

ListItem.Data := Pointer(VerObj);

ListItem.SubItems.Add(FileName);

if ReadResVer(LFileName, VerObj.Major, VerObj.Minor, VerObj.Release, VerObj.Build) then

begin

ListItem.SubItems.Add(Format('%d.%d.%d.%d',

[VerObj.Major, VerObj.Minor, VerObj.Release, VerObj.Build]));

end else

ListItem.SubItems.Add('-');

ListItem.SubItems.Add('');

end;

procedure TMainForm.btnAddProjectClick(Sender: TObject);

begin

with TOpenDialog.Create(nil) do

try

Filter := '*.dproj|*.dproj';

if Execute then

begin

if ExistsProject(FileName) then

MessageBox(0, '您选择的工程已经添加了!', '提示信息', MB_ICONINFORMATION)

else

AddProjectToList(FileName);

end;

finally

Free;

end;

end;

procedure TMainForm.btnDeleteProjectClick(Sender: TObject);

begin

lvwProjectList.DeleteSelected;

end;

procedure TMainForm.btnLoadProjectListClick(Sender: TObject);

var

StrList: TStringList;

I: Integer;

OpenFileName: string;

begin

OpenFileName := '';

with TOpenDialog.Create(nil) do

try

Filter := '*.dlist|*.dlist';

if Execute then

OpenFileName := FileName;

finally

Free;

end;

if OpenFileName = '' then

Exit;

StrList := TStringList.Create;

try

StrList.LoadFromFile(OpenFileName);

for I := 0 to StrList.Count - 1 do

begin

AddProjectToList(StrList[I]);

end;

finally

StrList.Free;

end;

end;

procedure TMainForm.btnMultiModifyClick(Sender: TObject);

var

I: Integer;

ErrStr: string;

begin

for I := 0 to lvwProjectList.Items.Count - 1 do

begin

with TRecordObject(lvwProjectList.Items[I].Data) do

begin

lvwProjectList.Selected := lvwProjectList.Items[I];

ModifySingle(lvwProjectList.Items[I], ErrStr);

lvwProjectList.Items[I].SubItems[1] := Format('%d.%d.%d.%d',

[Major, Minor, Release, Build]);

end;

end;

end;

procedure TMainForm.btnRefreshProjectsClick(Sender: TObject);

var

I: Integer;

begin

for I := 0 to lvwProjectList.Items.Count - 1 do

begin

with TRecordObject(lvwProjectList.Items[I].Data) do

begin

ReadResVer(GetProjectResFileName(FileName), Major, Minor, Release, Build);

lvwProjectList.Items[I].SubItems[1] := Format('%d.%d.%d.%d',

[Major, Minor, Release, Build]);

end;

end;

end;

procedure TMainForm.btnSaveProjectListClick(Sender: TObject);

var

StrList: TStringList;

I: Integer;

SaveFileName: string;

begin

SaveFileName := '';

with TSaveDialog.Create(nil) do

try

Filter := '*.dlist|*.dlist';

if Execute then

SaveFileName := FileName;

finally

Free;

end;

if SaveFileName = '' then

Exit;

if Pos('.dlist', SaveFileName) <= 0 then

SaveFileName := SaveFileName + '.dlist';

StrList := TStringList.Create;

try

for I := 0 to lvwProjectList.Items.Count - 1 do

begin

StrList.Add(lvwProjectList.Items[I].SubItems[0]);

end;

StrList.SaveToFile(SaveFileName);

finally

StrList.Free;

end;

end;

procedure TMainForm.btnSingleModifyClick(Sender: TObject);

var

ErrStr: string;

begin

if lvwProjectList.Selected = nil then

Exit;

with TRecordObject(lvwProjectList.Selected.Data) do

begin

if ModifySingle(lvwProjectList.Selected, ErrStr) then

begin

lvwProjectList.Selected.SubItems[2] :=

Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);

MessageBox(Self.Handle, '修改成功!', '提示信息', MB_ICONINFORMATION);

end else

MessageBox(Self.Handle, PChar('修改失败! 原因：' + ErrStr), '提示信息', MB_ICONWARNING);

end;

end;

function TMainForm.ModifySingle(Item: TListItem; var ErrStr: string): Boolean;

begin

Result := False;

if Item = nil then

Exit;

with TRecordObject(Item.Data) do

begin

try

ModifyDprojVer(FileName, StrToInt(edMajor.Text), StrToInt(edMinor.Text)

, StrToInt(edRelease.Text), StrToInt(edBuild.Text));

ModifyResVer(GetProjectResFileName(FileName),

StrToInt(edMajor.Text), StrToInt(edMinor.Text)

, StrToInt(edRelease.Text), StrToInt(edBuild.Text));

ReadResVer(GetProjectResFileName(FileName), Major, Minor, Release, Build);

Result := True;

except

on E: Exception do

begin

ErrStr := E.Message;

end;

end;

end;

end;

function TMainForm.ExistsProject(const FileName: string): Boolean;

var

I: Integer;

begin

Result := False;

for I := 0 to lvwProjectList.Items.Count - 1 do

begin

if SameText(lvwProjectList.Items[I].SubItems[0], FileName) then

begin

Result := True;

Break;

end;

end;

end;

function TMainForm.GetProjectResFileName(const FileName: string): string;

function ExtractMainFileName(const AFileName: string): string;

begin

Result := ExtractFileName(AFileName);

Result := Copy(Result, 1, Length(Result) - Length(ExtractFileExt(AFileName)));

end;

begin

Result := ExtractMainFileName(FileName) + '.res';

end;

procedure TMainForm.lvwProjectListClick(Sender: TObject);

begin

if lvwProjectList.Selected = nil then

Exit;

with TRecordObject(lvwProjectList.Selected.Data) do

begin

UpMajor.Position := Major;

UpMinor.Position := Minor;

UpRelease.Position := Release;

UpBuild.Position := Build;

end;

end;

procedure TMainForm.lvwProjectListCustomDrawItem(Sender: TCustomListView;

Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);

begin

Item.Caption := IntToStr(Item.Index + 1);

end;

procedure TMainForm.lvwProjectListDeletion(Sender: TObject; Item: TListItem);

begin

TRecordObject(Item.Data).Free;

end;

end.

unit MiscFuncsUnit;

interface

uses

Windows, SysUtils, unitResFile, unitResourceVersionInfo, xmldom, XMLIntf,

msxmldom, XMLDoc;

procedure ModifyDprojVer(const FileName: string; Major, Minor, Release, Build: Word);

procedure ModifyResVer(const FileName: string; Major, Minor, Release, Build: Word);

function ReadResVer(const FileName: string; var Major, Minor, Release, Build: Word): Boolean;

implementation

function FindNodeByAttrName(Node: IXMLNode; const NodeName, AttrName, AttrNameValue: WideString): IXMLNode;

var

I: Integer;

begin

Result := nil;

if (Node.NodeName = NodeName) and Node.HasAttribute(AttrName) and

(Node.Attributes[AttrName] = AttrNameValue) then

begin

Result := Node;

Exit;

end;

if Node.HasChildNodes then

begin

for I := 0 to Node.ChildNodes.Count - 1 do

begin

Result := FindNodeByAttrName(Node.ChildNodes[I], NodeName, AttrName, AttrNameValue);

if Result <> nil then

Break;

end;

end;

end;

procedure ModifyDprojVer(const FileName: string; Major, Minor, Release, Build: Word);

var

XmlDoc: IXMLDocument; // 注意此处一定要用IXMLDocument，否则会出错

RootNode, LNode: IXMLNode;

begin

XmlDoc := TXMLDocument.Create('');

XmlDoc.LoadFromFile(FileName);

RootNode := XmlDoc.Node;

LNode := FindNodeByAttrName(RootNode, 'VersionInfo', 'Name', 'MajorVer');

if LNode <> nil then

LNode.NodeValue := IntToStr(Major);

LNode := FindNodeByAttrName(RootNode, 'VersionInfo', 'Name', 'MinorVer');

if LNode <> nil then

LNode.NodeValue := IntToStr(Minor);

LNode := FindNodeByAttrName(RootNode, 'VersionInfo', 'Name', 'Release');

if LNode <> nil then

LNode.NodeValue := IntToStr(Release);

LNode := FindNodeByAttrName(RootNode, 'VersionInfo', 'Name', 'Build');

if LNode <> nil then

LNode.NodeValue := IntToStr(Build);

LNode := FindNodeByAttrName(RootNode, 'VersionInfoKeys', 'Name', 'FileVersion');

if LNode <> nil then

LNode.NodeValue := Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);

XmlDoc.SaveToFile(FileName);

end;

procedure ModifyResVer(const FileName: string; Major, Minor, Release, Build: Word);

var

Res: TResModule;

I: Integer;

ResVer: TVersionInfoResourceDetails;

VerData: TULargeInteger;

begin

ResVer := nil;

Res := TResModule.Create;

try

Res.LoadFromFile(FileName);

for I := 0 to Res.ResourceCount - 1 do

begin

if Res.ResourceDetails[I] is TVersionInfoResourceDetails then

ResVer := Res.ResourceDetails[I] as TVersionInfoResourceDetails;

end;

if ResVer <> nil then

begin

VerData.HighPart := MakeLong(Minor, Major);

VerData.LowPart := MakeLong(Build, Release);

ResVer.FileVersion := VerData;

Res.SaveToFile(FileName);

end;

finally

Res.Free;

end;

end;

function ReadResVer(const FileName: string; var Major, Minor, Release, Build: Word): Boolean;

var

Res: TResModule;

I: Integer;

ResVer: TVersionInfoResourceDetails;

begin

Result := False;

ResVer := nil;

Res := TResModule.Create;

try

try

Res.LoadFromFile(FileName);

for I := 0 to Res.ResourceCount - 1 do

begin

if Res.ResourceDetails[I] is TVersionInfoResourceDetails then

ResVer := Res.ResourceDetails[I] as TVersionInfoResourceDetails;

end;

if ResVer <> nil then

begin

Major := HiWord(ResVer.FileVersion.HighPart);

Minor := ResVer.FileVersion.HighPart and $0000FFFF;

Release := HiWord(ResVer.FileVersion.LowPart);

Build := ResVer.FileVersion.LowPart and $0000FFFF;

Result := True;

end;

except

Result := False;

end;

finally

Res.Free;

end;

end;

end.