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

最新推荐文章于 2023-03-21 11:13:53 发布

missmecn

最新推荐文章于 2023-03-21 11:13:53 发布

阅读量6.6k

点赞数

分类专栏： Delphi 相关技术文章标签： delphi build string forms 工具 class

本文链接：https://blog.csdn.net/missmecn/article/details/3007660

版权

Delphi 相关技术专栏收录该内容

24 篇文章 0 订阅

订阅专栏

软件截图：

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.
 