Delphi工程版本号修改工具

时间:2023-03-09 00:52:39
Delphi工程版本号修改工具

自动修改某目录下符合条件的Delphi工程(dproj)版本号, 支持命令行调用
支持通配符忽略文件

-p [Path] 在[Path]路径下查询所有dproj文件(可以为空, 默认路径为程序当前路径)
-v [Version] 将查询到的dproj文件中Base节点版本改为[Version]并删除其他节点版本信息(可以为空, 进入程序后输入)
-i [File1,File2...]要忽略的文件, 支持? *的通配符, 忽略大小写, 包含路径, 不要包含扩展名, 如: work\project?
-b 修改时备份原文件到文件所在路径的dproj_bak目录下(默认不备份)
-ac 工作结束自动关闭程序(默认不关闭)

已经编译完的程序放CSDN了, 不过有点坑, 提交的资源不能修改内容, 也不能修改下载积分(当初没看, 直接选了5分...呵呵)

http://download.csdn.net/download/hskill/10120236

下面直接给出源码, 是个控制台程序

PS: 里面用到了QXML, 但是QXML会吧单引号转义, 不过不影响IDE的读取保存

program dproj_Version;

//  ***************************************************************************
//
// 版本: 1.0
// 作者: 刘志林
// 修改日期: 2017-11-15
// QQ: 17948876
// E-mail: lzl_17948876@hotmail.com
// 博客: http://www.cnblogs.com/lzl_17948876/
//
// !!! 若有修改,请通知作者,谢谢合作 !!!
//
// *************************************************************************** {$APPTYPE CONSOLE} {$R *.res} uses
System.SysUtils, System.Classes, System.IOUtils, System.Types, System.Masks,
QXML, QString; function _GetXNode(AXNParent: TQXMLNode; AName: string; out AValue: string): TQXMLNode;
begin
Result := AXNParent.ItemByName(AName);
if Result = nil then
Result := AXNParent.Add(AName);
AValue := Result.Text;
end; type
EInvalidVersion = Class(Exception); TVersion = record
public
procedure Init;
function IsEmpty: Boolean;
procedure FromString(AStr: string);
function ToString(ADelimiter: Char = '.'): string; case Integer of
: (Data: array[..] of UInt32);
: (MajorVer, MinorVer, Release, Build: UInt32);
end; { TVersion } procedure TVersion.FromString(AStr: string);
var
i: Integer;
begin
Init;
with TStringList.Create do
try
Delimiter := '.';
StrictDelimiter := True;
DelimitedText := AStr;
try
if Count <> then
Abort;
for i := to do
Data[i] := StrToInt(Strings[i]);
if IsEmpty then
Abort;
except
Init;
raise EInvalidVersion.Create(AStr + '不是有效的版本号');
end;
finally
Free;
end;
end; procedure TVersion.Init;
begin
MajorVer := ;
MinorVer := ;
Release := ;
Build := ;
end; function TVersion.IsEmpty: Boolean;
begin
Result := Data[] + Data[] + Data[] + Data[] = ;
end; function TVersion.ToString(ADelimiter: Char = '.'): string;
begin
Result := Format('%1:d%0:s%2:d%0:s%3:d%0:s%4:d', [ADelimiter, Data[], Data[], Data[], Data[]])
end; function _Compare(const AStr: string; const AL: array of string): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(AL) to High(AL) do
begin
if CompareText(AStr, AL[i]) <> then
Continue;
Result := True;
Break;
end;
end; function IsIgnored(AName: string; const AIGList: TArray<string>): Boolean;
var
i: Integer;
begin
Result := False;
for i := Low(AIGList) to High(AIGList) do
begin
if not MatchesMask(AName, AIGList[i]) then
Continue;
Result := True;
Break;
end;
end; const
_EXT = '.dproj'; const
Helps: array[..] of string = (
'-p [Path] 在[Path]路径下查询所有dproj文件(可以为空, 默认路径为程序当前路径)',
'-v [Version] 将查询到的dproj文件中Base节点版本改为[Version]并删除其他节点版本信息(可以为空, 进入程序后输入)',
'-i [File1,File2...]要忽略的文件, 支持? *的通配符, 忽略大小写, 包含路径, 不要包含扩展名, 如: work\project?',
'-b 修改时备份原文件到文件所在路径的dproj_bak目录下(默认不备份)',
'-ac 工作结束自动关闭程序(默认不关闭)'
); var
nXDOC: TQXML;
nXNRoot, nXN, nXNV: TQXMLNode;
l, i, nParamIndex, nFileIndex, nXNIndex, nIKIndex: Integer;
nStrs: TStringList;
nName, nVersionStr, nPath, nFile, nStr, nPK: string;
nIgnoredList: TArray<string>;
nVersion, nOldVersion: TVersion;
nFiles: TStringDynArray;
nBackup, nAutoClose: Boolean;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
ChDir(ExtractFilePath(ParamStr())); nPath := '.\';
nVersion.Init;
SetLength(nIgnoredList, );
nBackup := False;
nAutoClose := False; nParamIndex := ;
while nParamIndex <= ParamCount do
begin
nStr := ParamStr(nParamIndex); l := nStr.Length;
if not (nStr[] in ['-', '/']) then
Continue;
nStr := Copy(nStr, , l - ); if _Compare(nStr, ['p']) then {路径}
begin
nPath := ParamStr(nParamIndex + );
Inc(nParamIndex, );
end
else if _Compare(nStr, ['v']) then {版本号}
begin
nVersionStr := ParamStr(nParamIndex + );
Inc(nParamIndex, );
end
else if _Compare(nStr, ['i']) then {忽略的文件}
begin
with TStringList.Create do
try
StrictDelimiter := True;
Delimiter := ',';
DelimitedText := ParamStr(nParamIndex + );
SetLength(nIgnoredList, Count);
for i := to Count - do
nIgnoredList[i] := '*' + ChangeFileExt(Strings[i], '') + _EXT;
finally
Free;
end;
Inc(nParamIndex, );
end
else if _Compare(nStr, ['b']) then {备份}
begin
nBackup := True;
Inc(nParamIndex, );
end
else if _Compare(nStr, ['ac']) then {自动关闭}
begin
nAutoClose := True;
Inc(nParamIndex, );
end
else if _Compare(nStr, ['h', '?', 'help']) then {帮助}
begin
for i := Low(Helps) to High(Helps) do
Writeln(Helps[i]);
Abort;
end
else
Inc(nParamIndex, );
end; if nPath = '' then
raise Exception.Create('无效的路径');
nPath := TPath.GetFullPath(nPath);
if not DirectoryExists(nPath) then
raise Exception.CreateFmt('"%s" 路径不存在', [nPath]); if nVersionStr = '' then
Writeln('清输入版本号:')
else
try
nVersion.FromString(nVersionStr);
except
on E: Exception do
Writeln('错误: ' + E.Message);
end; while nVersion.IsEmpty do
begin
Write('> ');
Readln(nVersionStr);
try
nVersion.FromString(nVersionStr);
except
on E: Exception do
Writeln('错误: ' + E.Message);
end;
end; Writeln('');
Writeln('******** 开始处理 ********');
Writeln(Format('目标目录: %s', [nPath]));
Write('忽略的对象:');
for i := Low(nIgnoredList) to High(nIgnoredList) do
Write(Format(' "%s"', [nIgnoredList[i]]));
Write(#); nFiles := TDirectory.GetFiles(nPath, '*' + _EXT, TSearchOption.soAllDirectories); if Length(nFiles) = then
raise Exception.Create('待处理的文件数量为0'); Writeln(Format('待处理文件数量: %d', [Length(nFiles)]));
Writeln(''); nXDOC := TQXML.Create;
nStrs := TStringList.Create;
try
nStrs.Delimiter := ';';
nStrs.StrictDelimiter := True; for nFileIndex := Low(nFiles) to High(nFiles) do
begin
if IsIgnored(nFiles[nFileIndex], nIgnoredList) then
begin
Writeln('* 忽略 ' + nFiles[nFileIndex]);
Continue;
end; Writeln(nFiles[nFileIndex]);
try
nOldVersion.Init;
nXDOC.LoadFromFile(nFiles[nFileIndex]);
nXNRoot := nXDOC.Items[];
for nXNIndex := to nXNRoot.Count - do
begin
nXN := nXNRoot.Items[nXNIndex];
if nXN.Name <> 'PropertyGroup' then
Continue;
if nXN.Attrs.AsString['Condition'] = '''$(Base)''!=''''' then
begin
_GetXNode(nXN, 'VerInfo_MajorVer', nStr).Text := nVersion.MajorVer.ToString;
nOldVersion.MajorVer := StrToIntDef(nStr, );
_GetXNode(nXN, 'VerInfo_MinorVer', nStr).Text := nVersion.MinorVer.ToString;
nOldVersion.MinorVer := StrToIntDef(nStr, );
_GetXNode(nXN, 'VerInfo_Release', nStr).Text := nVersion.Release.ToString;
nOldVersion.Release := StrToIntDef(nStr, );
_GetXNode(nXN, 'VerInfo_Build', nStr).Text := nVersion.Build.ToString;
nOldVersion.Build := StrToIntDef(nStr, ); with _GetXNode(nXN, 'VerInfo_Keys', nStr) do
begin
nStrs.DelimitedText := Text;
for nIKIndex := to nStrs.Count - do
begin
nName := nStrs.KeyNames[nIKIndex];
if CompareText('FileVersion', nName) = then
nStrs[nIKIndex] := 'FileVersion=' + nVersion.ToString;
end;
Text := nStrs.DelimitedText;
end; _GetXNode(nXN, 'VerInfo_IncludeVerInfo', nStr).Text := True.ToString(TUseBoolStrs.True);
end
else
begin
{删除其他版本信息}
nXN.Delete('VerInfo_MajorVer');
nXN.Delete('VerInfo_MinorVer');
nXN.Delete('VerInfo_Release');
nXN.Delete('VerInfo_Build');
nXN.Delete('VerInfo_Keys');
end;
end;
if nBackup then
begin
nPath := ExtractFilePath(nFiles[nFileIndex]) + '\dproj_bak\';
ForceDirectories(nPath);
nStr := nPath + ExtractFileName(nFiles[nFileIndex]) + '.#' + nOldVersion.ToString + '#.bak';
if FileExists(nStr) then
TFile.Delete(nStr);
TFile.Copy(nFiles[nFileIndex], nStr);
end;
nXDOC.SaveToFile(nFiles[nFileIndex], TTextEncoding.teUTF8, True, False, True);
except
on E: Exception do
Writeln('错误: ' + E.Message);
end;
end;
finally
nStrs.Free;
nXDOC.Free;
end;
Writeln('');
Writeln('******** 处理完毕 ********')
except
on E: EAbort do;
on E: Exception do
begin
Writeln('错误: ', E.Message);
nAutoClose := False;
end;
end;
if not nAutoClose then
begin
Writeln('');
Writeln('按任意键关闭');
Read(nStr);
end;
end.