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
      0: (Data: array[0..3] of UInt32);
      1: (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 <> 4 then
        Abort;
      for i := 0 to 3 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 := 0;
  MinorVer := 0;
  Release := 0;
  Build := 0;
end;

function TVersion.IsEmpty: Boolean;
begin
  Result := Data[0] + Data[1] + Data[2] + Data[3] = 0;
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[0], Data[1], Data[2], Data[3]])
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]) <> 0 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[0..4] 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(0)));

    nPath := '.\';
    nVersion.Init;
    SetLength(nIgnoredList, 0);
    nBackup := False;
    nAutoClose := False;

    nParamIndex := 1;
    while nParamIndex <= ParamCount do
    begin
      nStr := ParamStr(nParamIndex);

      l := nStr.Length;
      if not (nStr[1] in ['-', '/']) then
        Continue;
      nStr := Copy(nStr, 2, l - 1);

      if _Compare(nStr, ['p']) then {路径}
      begin
        nPath := ParamStr(nParamIndex + 1);
        Inc(nParamIndex, 2);
      end
      else if _Compare(nStr, ['v']) then {版本号}
      begin
        nVersionStr := ParamStr(nParamIndex + 1);
        Inc(nParamIndex, 2);
      end
      else if _Compare(nStr, ['i']) then {忽略的文件}
      begin
        with TStringList.Create do
        try
          StrictDelimiter := True;
          Delimiter := ',';
          DelimitedText := ParamStr(nParamIndex + 1);
          SetLength(nIgnoredList, Count);
          for i := 0 to Count - 1 do
            nIgnoredList[i] := '*' + ChangeFileExt(Strings[i], '') + _EXT;
        finally
          Free;
        end;
        Inc(nParamIndex, 2);
      end
      else if _Compare(nStr, ['b']) then {备份}
      begin
        nBackup := True;
        Inc(nParamIndex, 1);
      end
      else if _Compare(nStr, ['ac']) then {自动关闭}
      begin
        nAutoClose := True;
        Inc(nParamIndex, 1);
      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, 1);
    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(#10);

    nFiles := TDirectory.GetFiles(nPath, '*' + _EXT, TSearchOption.soAllDirectories);

    if Length(nFiles) = 0 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[0];
          for nXNIndex := 0 to nXNRoot.Count - 1 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, 0);
              _GetXNode(nXN, 'VerInfo_MinorVer', nStr).Text := nVersion.MinorVer.ToString;
              nOldVersion.MinorVer := StrToIntDef(nStr, 0);
              _GetXNode(nXN, 'VerInfo_Release', nStr).Text := nVersion.Release.ToString;
              nOldVersion.Release := StrToIntDef(nStr, 0);
              _GetXNode(nXN, 'VerInfo_Build', nStr).Text := nVersion.Build.ToString;
              nOldVersion.Build := StrToIntDef(nStr, 0);

              with _GetXNode(nXN, 'VerInfo_Keys', nStr) do
              begin
                nStrs.DelimitedText := Text;
                for nIKIndex := 0  to nStrs.Count - 1 do
                begin
                  nName := nStrs.KeyNames[nIKIndex];
                  if CompareText('FileVersion', nName) = 0 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.