综合

img missmecn

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

发表于2008/10/1 17:46:00  4958人阅读

分类: Delphi 相关技术

软件截图:

 

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

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

  1. unit MainFrm;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5.   Dialogs, StdCtrls, ComCtrls, ButtonGroup;
  6. type
  7.   TMainForm = class(TForm)
  8.     lvwProjectList: TListView;
  9.     btnAddProject: TButton;
  10.     btnDeleteProject: TButton;
  11.     btnSingleModify: TButton;
  12.     btnMultiModify: TButton;
  13.     edMajor: TEdit;
  14.     Label1: TLabel;
  15.     edMinor: TEdit;
  16.     Label2: TLabel;
  17.     edRelease: TEdit;
  18.     Label3: TLabel;
  19.     edBuild: TEdit;
  20.     Label4: TLabel;
  21.     UpMajor: TUpDown;
  22.     UpMinor: TUpDown;
  23.     UpRelease: TUpDown;
  24.     UpBuild: TUpDown;
  25.     btnRefreshProjects: TButton;
  26.     btnSaveProjectList: TButton;
  27.     btnLoadProjectList: TButton;
  28.     procedure btnAddProjectClick(Sender: TObject);
  29.     procedure lvwProjectListDeletion(Sender: TObject; Item: TListItem);
  30.     procedure btnDeleteProjectClick(Sender: TObject);
  31.     procedure lvwProjectListCustomDrawItem(Sender: TCustomListView;
  32.       Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  33.     procedure lvwProjectListClick(Sender: TObject);
  34.     procedure btnSingleModifyClick(Sender: TObject);
  35.     procedure btnRefreshProjectsClick(Sender: TObject);
  36.     procedure btnMultiModifyClick(Sender: TObject);
  37.     procedure btnSaveProjectListClick(Sender: TObject);
  38.     procedure btnLoadProjectListClick(Sender: TObject);
  39.   private
  40.     function GetProjectResFileName(const FileName: string): string;
  41.     procedure AddProjectToList(const FileName: string);
  42.     function ExistsProject(const FileName: string): Boolean;
  43.     function ModifySingle(Item: TListItem; var ErrStr: string): Boolean;
  44.   public
  45.   end;
  46.   TRecordObject = class
  47.     Major, Minor, Release, Build: Word;
  48.     FileName: string;
  49.   end;
  50. var
  51.   MainForm: TMainForm;
  52. implementation
  53. uses MiscFuncsUnit;
  54. {$R *.dfm}
  55. procedure TMainForm.AddProjectToList(const FileName: string);
  56. var
  57.   ListItem: TListItem;
  58.   LFileName: string;
  59.   VerObj: TRecordObject;
  60. begin
  61.   LFileName := GetProjectResFileName(FileName);
  62.   VerObj := TRecordObject.Create;
  63.   VerObj.FileName := FileName;
  64.   ListItem := lvwProjectList.Items.Add;
  65.   ListItem.Caption := '';
  66.   ListItem.Data := Pointer(VerObj);
  67.   ListItem.SubItems.Add(FileName);
  68.   if ReadResVer(LFileName, VerObj.Major, VerObj.Minor, VerObj.Release, VerObj.Build) then
  69.   begin
  70.     ListItem.SubItems.Add(Format('%d.%d.%d.%d',
  71.       [VerObj.Major, VerObj.Minor, VerObj.Release, VerObj.Build]));
  72.   end else
  73.     ListItem.SubItems.Add('-');
  74.   ListItem.SubItems.Add('');
  75. end;
  76. procedure TMainForm.btnAddProjectClick(Sender: TObject);
  77. begin
  78.   with TOpenDialog.Create(nildo
  79.   try
  80.     Filter := '*.dproj|*.dproj';
  81.     if Execute then
  82.     begin
  83.       if ExistsProject(FileName) then
  84.         MessageBox(0'您选择的工程已经添加了!''提示信息', MB_ICONINFORMATION)
  85.       else
  86.        AddProjectToList(FileName);
  87.     end;
  88.   finally
  89.     Free;
  90.   end;
  91. end;
  92. procedure TMainForm.btnDeleteProjectClick(Sender: TObject);
  93. begin
  94.   lvwProjectList.DeleteSelected;
  95. end;
  96. procedure TMainForm.btnLoadProjectListClick(Sender: TObject);
  97. var
  98.   StrList: TStringList;
  99.   I: Integer;
  100.   OpenFileName: string;
  101. begin
  102.   OpenFileName := '';
  103.   with TOpenDialog.Create(nildo
  104.   try
  105.     Filter := '*.dlist|*.dlist';
  106.     if Execute then
  107.       OpenFileName := FileName;
  108.   finally
  109.     Free;
  110.   end;
  111.   if OpenFileName = '' then
  112.     Exit;
  113.   StrList := TStringList.Create;
  114.   try
  115.     StrList.LoadFromFile(OpenFileName);
  116.     for I := 0 to StrList.Count - 1 do
  117.     begin
  118.       AddProjectToList(StrList[I]);
  119.     end;
  120.   finally
  121.     StrList.Free;
  122.   end;
  123. end;
  124. procedure TMainForm.btnMultiModifyClick(Sender: TObject);
  125. var
  126.   I: Integer;
  127.   ErrStr: string;
  128. begin
  129.   for I := 0 to lvwProjectList.Items.Count - 1 do
  130.   begin
  131.     with TRecordObject(lvwProjectList.Items[I].Data) do
  132.     begin
  133.       lvwProjectList.Selected := lvwProjectList.Items[I];
  134.       ModifySingle(lvwProjectList.Items[I], ErrStr);
  135.       lvwProjectList.Items[I].SubItems[1] := Format('%d.%d.%d.%d',
  136.         [Major, Minor, Release, Build]);
  137.     end;
  138.   end;
  139. end;
  140. procedure TMainForm.btnRefreshProjectsClick(Sender: TObject);
  141. var
  142.   I: Integer;
  143. begin
  144.   for I := 0 to lvwProjectList.Items.Count - 1 do
  145.   begin
  146.     with TRecordObject(lvwProjectList.Items[I].Data) do
  147.     begin
  148.       ReadResVer(GetProjectResFileName(FileName), Major, Minor, Release, Build);
  149.       lvwProjectList.Items[I].SubItems[1] := Format('%d.%d.%d.%d',
  150.         [Major, Minor, Release, Build]);
  151.     end;
  152.   end;
  153. end;
  154. procedure TMainForm.btnSaveProjectListClick(Sender: TObject);
  155. var
  156.   StrList: TStringList;
  157.   I: Integer;
  158.   SaveFileName: string;
  159. begin
  160.   SaveFileName := '';
  161.   with TSaveDialog.Create(nildo
  162.   try
  163.     Filter := '*.dlist|*.dlist';
  164.     if Execute then
  165.       SaveFileName := FileName;
  166.   finally
  167.     Free;
  168.   end;
  169.   if SaveFileName = '' then
  170.     Exit;
  171.   if Pos('.dlist', SaveFileName) <= 0 then
  172.     SaveFileName := SaveFileName + '.dlist';
  173.   StrList := TStringList.Create;
  174.   try
  175.     for I := 0 to lvwProjectList.Items.Count - 1 do
  176.     begin
  177.       StrList.Add(lvwProjectList.Items[I].SubItems[0]);
  178.     end;
  179.     StrList.SaveToFile(SaveFileName);
  180.   finally
  181.     StrList.Free;
  182.   end;
  183. end;
  184. procedure TMainForm.btnSingleModifyClick(Sender: TObject);
  185. var
  186.   ErrStr: string;
  187. begin
  188.   if lvwProjectList.Selected = nil then
  189.     Exit;
  190.   with TRecordObject(lvwProjectList.Selected.Data) do
  191.   begin
  192.     if ModifySingle(lvwProjectList.Selected, ErrStr) then
  193.     begin
  194.       lvwProjectList.Selected.SubItems[2] :=
  195.         Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);
  196.       MessageBox(Self.Handle, '修改成功!''提示信息', MB_ICONINFORMATION);
  197.     end else
  198.       MessageBox(Self.Handle, PChar('修改失败! 原因:' + ErrStr), '提示信息', MB_ICONWARNING);
  199.   end;
  200. end;
  201. function TMainForm.ModifySingle(Item: TListItem; var ErrStr: string): Boolean;
  202. begin
  203.   Result := False;
  204.   
  205.   if Item = nil then
  206.     Exit;
  207.   with TRecordObject(Item.Data) do
  208.   begin
  209.     try
  210.       ModifyDprojVer(FileName, StrToInt(edMajor.Text), StrToInt(edMinor.Text)
  211.         , StrToInt(edRelease.Text), StrToInt(edBuild.Text));
  212.       ModifyResVer(GetProjectResFileName(FileName),
  213.         StrToInt(edMajor.Text), StrToInt(edMinor.Text)
  214.         , StrToInt(edRelease.Text), StrToInt(edBuild.Text));
  215.       ReadResVer(GetProjectResFileName(FileName), Major, Minor, Release, Build);
  216.       Result := True;
  217.     except
  218.       on E: Exception do
  219.       begin
  220.         ErrStr := E.Message;
  221.       end;
  222.     end;
  223.   end;
  224. end;
  225. function TMainForm.ExistsProject(const FileName: string): Boolean;
  226. var
  227.   I: Integer;
  228. begin
  229.   Result := False;
  230.   for I := 0 to lvwProjectList.Items.Count - 1 do
  231.   begin
  232.     if SameText(lvwProjectList.Items[I].SubItems[0], FileName) then
  233.     begin
  234.       Result := True;
  235.       Break;
  236.     end;
  237.   end;
  238. end;
  239. function TMainForm.GetProjectResFileName(const FileName: string): string;
  240.   function ExtractMainFileName(const AFileName: string): string;
  241.   begin
  242.     Result := ExtractFileName(AFileName);
  243.     Result := Copy(Result, 1, Length(Result) - Length(ExtractFileExt(AFileName)));
  244.   end;
  245. begin
  246.   Result := ExtractMainFileName(FileName) + '.res';
  247. end;
  248. procedure TMainForm.lvwProjectListClick(Sender: TObject);
  249. begin
  250.   if lvwProjectList.Selected = nil then
  251.     Exit;
  252.   with TRecordObject(lvwProjectList.Selected.Data) do
  253.   begin
  254.     UpMajor.Position := Major;
  255.     UpMinor.Position := Minor;
  256.     UpRelease.Position := Release;
  257.     UpBuild.Position := Build;
  258.   end;
  259. end;
  260. procedure TMainForm.lvwProjectListCustomDrawItem(Sender: TCustomListView;
  261.   Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  262. begin
  263.   Item.Caption := IntToStr(Item.Index + 1);
  264. end;
  265. procedure TMainForm.lvwProjectListDeletion(Sender: TObject; Item: TListItem);
  266. begin
  267.   TRecordObject(Item.Data).Free;
  268. end;
  269. end.
  1. unit MiscFuncsUnit;
  2. interface
  3. uses
  4.   Windows, SysUtils, unitResFile, unitResourceVersionInfo, xmldom, XMLIntf,
  5.   msxmldom, XMLDoc;
  6. procedure ModifyDprojVer(const FileName: string; Major, Minor, Release, Build: Word);
  7. procedure ModifyResVer(const FileName: string; Major, Minor, Release, Build: Word);
  8. function ReadResVer(const FileName: stringvar Major, Minor, Release, Build: Word): Boolean;
  9. implementation
  10. function FindNodeByAttrName(Node: IXMLNode; const NodeName, AttrName, AttrNameValue: WideString): IXMLNode;
  11. var
  12.   I: Integer;
  13. begin
  14.   Result := nil;
  15.   if (Node.NodeName = NodeName) and Node.HasAttribute(AttrName) and
  16.     (Node.Attributes[AttrName] = AttrNameValue) then
  17.   begin
  18.     Result := Node;
  19.     Exit;
  20.   end;
  21.   if Node.HasChildNodes then
  22.   begin
  23.     for I := 0 to Node.ChildNodes.Count - 1 do
  24.     begin
  25.       Result := FindNodeByAttrName(Node.ChildNodes[I], NodeName, AttrName, AttrNameValue);
  26.       if Result <> nil then
  27.         Break;
  28.     end;
  29.   end;
  30. end;
  31. procedure ModifyDprojVer(const FileName: string; Major, Minor, Release, Build: Word);
  32. var
  33.   XmlDoc: IXMLDocument;  // 注意此处一定要用IXMLDocument,否则会出错
  34.   RootNode, LNode: IXMLNode;
  35. begin
  36.   XmlDoc := TXMLDocument.Create('');
  37.   
  38.   XmlDoc.LoadFromFile(FileName);
  39.   RootNode := XmlDoc.Node;
  40.   LNode := FindNodeByAttrName(RootNode, 'VersionInfo''Name''MajorVer');
  41.   if LNode <> nil then
  42.     LNode.NodeValue := IntToStr(Major);
  43.   LNode := FindNodeByAttrName(RootNode, 'VersionInfo''Name''MinorVer');
  44.   if LNode <> nil then
  45.     LNode.NodeValue := IntToStr(Minor);
  46.   LNode := FindNodeByAttrName(RootNode, 'VersionInfo''Name''Release');
  47.   if LNode <> nil then
  48.     LNode.NodeValue := IntToStr(Release);
  49.   LNode := FindNodeByAttrName(RootNode, 'VersionInfo''Name''Build');
  50.   if LNode <> nil then
  51.     LNode.NodeValue := IntToStr(Build);
  52.   LNode := FindNodeByAttrName(RootNode, 'VersionInfoKeys''Name''FileVersion');
  53.   if LNode <> nil then
  54.     LNode.NodeValue := Format('%d.%d.%d.%d', [Major, Minor, Release, Build]);
  55.   XmlDoc.SaveToFile(FileName);
  56. end;
  57. procedure ModifyResVer(const FileName: string; Major, Minor, Release, Build: Word);
  58. var
  59.   Res: TResModule;
  60.   I: Integer;
  61.   ResVer: TVersionInfoResourceDetails;
  62.   VerData: TULargeInteger;
  63. begin
  64.   ResVer := nil;
  65.   Res := TResModule.Create;
  66.   try
  67.     Res.LoadFromFile(FileName);
  68.     for I := 0 to Res.ResourceCount - 1 do
  69.     begin
  70.       if Res.ResourceDetails[I] is TVersionInfoResourceDetails then
  71.         ResVer := Res.ResourceDetails[I] as TVersionInfoResourceDetails;
  72.     end;
  73.     if ResVer <> nil then
  74.     begin
  75.       VerData.HighPart := MakeLong(Minor, Major);
  76.       VerData.LowPart := MakeLong(Build, Release);
  77.       ResVer.FileVersion := VerData;
  78.       Res.SaveToFile(FileName);
  79.     end;
  80.   finally
  81.     Res.Free;
  82.   end;
  83. end;
  84. function ReadResVer(const FileName: stringvar Major, Minor, Release, Build: Word): Boolean;
  85. var
  86.   Res: TResModule;
  87.   I: Integer;
  88.   ResVer: TVersionInfoResourceDetails;
  89. begin
  90.   Result := False;
  91.   ResVer := nil;
  92.   Res := TResModule.Create;
  93.   try
  94.     try
  95.       Res.LoadFromFile(FileName);
  96.       for I := 0 to Res.ResourceCount - 1 do
  97.       begin
  98.         if Res.ResourceDetails[I] is TVersionInfoResourceDetails then
  99.           ResVer := Res.ResourceDetails[I] as TVersionInfoResourceDetails;
  100.       end;
  101.       if ResVer <> nil then
  102.       begin
  103.         Major := HiWord(ResVer.FileVersion.HighPart);
  104.         Minor := ResVer.FileVersion.HighPart and $0000FFFF;
  105.         Release := HiWord(ResVer.FileVersion.LowPart);
  106.         Build := ResVer.FileVersion.LowPart and $0000FFFF;
  107.         Result := True;
  108.       end;
  109.     except
  110.       Result := False;
  111.     end;
  112.   finally
  113.     Res.Free;
  114.   end;
  115. end;
  116. end.

 

阅读全文
0 0

相关文章推荐

img
取 消
img