FreePascal 解析命令行参数

解析命令行参数（Free Pascal）

unit uGetOpt;

{$mode objfpc}{$H+}

{ ============================================================
  【功能介绍】

  解析命令行参数，并调用处理程序处解析结果

  支持 '-' 开头的短选项，和 '--' 开头的长选项。
  不以 '-' 开头的参数被视为 选项值 或 自定义参数。
  单独的 '-'  表示下一个参数被视为 选项值 或 自定义参数。
  单独的 '--' 表示后续参数都被视为 选项值 或 自定义参数。

  【用法演示】

  // 首先创建回调函数
  function OptHandler(Key, Value: String): Boolean;
  begin
    case Key of
      'a', 'aa': WriteLn(Key, ' = ', Value);      // -a --aa 必须指定选项值
      'b', 'bb': WriteLn(Key, ' = ', Value);      // -b --bb 必须指定选项值
      'c', 'cc': WriteLn(Key, ' 没有选项值');     // -c --cc 没有选项值
      ''       : WriteLn('自定义参数：', Value);  // 自定义参数（不以 - 开头）
      // 无效选项（以 - 开头的其它选项）
      else       WriteLn('无效选项：', Key);
    end;

    // 返回 True 表示继续解析，返回 False 表示中止解析
    Result := True;
  end;

  // 然后将上面创建的 OptHandler 传递给 GetOpt
  begin            
    // 这里的 'a b aa bb' 是指 -a、-b、--aa、--bb 必须提供选项值
    // 其它选项不处理选项值
    if not GetOpt(Argc - 1, Argv + 1, 'a b aa bb', @OptHandler) then
      WriteLn(StdErr, '命令行参数解析失败');
  end.

  // 可以使用下面的代码进行测试
  procedure Test();
  var
    Args: array of String;
  begin
    WriteLn(#10'----- 各种参数测试 -----'#10);
    Args := ['-aHello', '--aa', 'World', '-b', '', '--bb', '-', '-c', '--cc', '--', '-d', '--dd', 'hello'];
    GetOpt(Length(Args), PPChar(Args), 'a b aa bb', @OptHandler);

    WriteLn(#10'----- 缺少选项值测试 -----'#10);
    Args := ['-aHello', '--aa', '-b', 'World'];
    GetOpt(Length(Args), PPChar(Args), 'a b aa bb', @OptHandler);

    WriteLn(#10'----- 选项名太短测试 -----'#10);
    Args := ['-aHello', '--a', 'World'];
    GetOpt(Length(Args), PPChar(Args), 'a b aa bb', @OptHandler);
  end;
============================================================ }

interface

type
  // 用来处理解析结果的回调函数
  TOptHandler    = function(Key, Value: String): Boolean;
  TOptHandlerObj = function(Key, Value: String): Boolean of object;

  // 功能：解析命令行参数
  // 参数：
  //   ValueOpts  必须指定选项值的选项列表，以空格分隔
  //   OptHandler 解析结果的处理程序，该程序返回 True 则继续解析，返回 False 则中止解析
  // 返回值：全部解析完毕则返回 True，出错或中止则返回 False
  function GetOpt(
    AArgc      : Integer;
    AArgv      : PPChar;
    ValueOpts  : String;
    OptHandler : TOptHandler
  ): Boolean;

  function GetOpt(
    AArgc      : Integer;
    AArgv      : PPChar;
    ValueOpts  : String;
    OptHandler : TOptHandlerObj
  ): Boolean;



implementation

function DoGetOpt(       
  AArgc         : Integer;
  AArgv         : PPChar;
  ValueOpts     : String;
  OptHandler    : TOptHandler;
  OptHandlerObj : TOptHandlerObj
): Boolean;
var               
  Index  : Integer;    // 当前正在处理的命令行参数索引
  PArg   : PChar;      // 当前正在处理的命令行参数指针
  Key    : String;     // 当前解析出来的选项名
  Value  : String;     // 当前解析出来的选项值或自定义参数
  Raw    : Integer;    // 当前参数是否被视为自定义参数，1 表示仅一次，2 表示后续全部

  // 读取下一个参数
  procedure NextArg();
  begin
    if Index < AArgc then
    begin
      PArg := AArgv[Index]; 
      Index += 1;
    end
    else
      Index := AArgc + 1;
  end;

  // 调用回调函数，处理当前解析出来的选项名和选项值
  function Handle(): Boolean;
  begin
    if OptHandler <> nil then
      Result := OptHandler(Key, Value)
    else
    if OptHandlerObj <> nil then
      Result := OptHandlerObj(Key, Value)
    else
      Result := False;

    Key := '';
    Value := '';
  end;

begin
  Index := 0;
  NextArg();

  // 前后加空格，便于查找选项名
  ValueOpts := ' ' + ValueOpts + ' ';

  Key    := '';
  Value  := '';  
  Raw    := 0;
  Result := True;

  while Index <= AArgc do
  begin
    // 处理 自定义参数 或 需要选项值的参数（允许指定空字符串，选项名由后面的代码解析）
    if (PArg = nil) or (PArg^ <> '-') or (Raw <> 0) then
    begin
      Value := PArg;

      if not Handle() then
        Exit(False);

      NextArg();

      if Raw = 1 then
        Raw := 0;
    end
    else
    // 参数以 - 开头
    begin
      PArg += 1;
           
      // 单独的 -
      if PArg^ = #0 then
      begin
        Raw := 1;
      end
      else
      // - 之后跟随有内容
      begin
        // 需要选项值，但选项值以 - 开头
        if Key <> '' then
        begin
          WriteLn(StdErr, 'Error: Option ''' + Key + ''' need a value.');
          Exit(False);
        end;

        // 以 -- 开头
        if PArg^ = '-' then
        begin
          PArg += 1;
                  
          // 单独的 --
          if PArg^ = #0 then
          begin         
            Raw := 2;
          end
          else

          // --key
          begin
            Key := PArg;

            // 选项名太短
            if Length(Key) < 2 then
            begin
              WriteLn(StdErr, 'Error: Name of option ''--' + Key + ''' is too short.');
              Exit(False);
            end;

            // 不需要选项值
            if Pos(' ' + Key + ' ', ValueOpts) = 0 then
            begin
              // 处理当前选项名
              if not Handle() then
                Exit(False);
            end;
          end;
        end
        else
        // -xxx
        begin
          // 解析连续的短选项名
          while PArg^ <> #0 do
          begin
            // 取一个短选项名
            Key := PArg^;
            PArg += 1;

            // 不需要选项值
            if Pos(' ' + Key + ' ', ValueOpts) = 0 then
            begin
              // 处理当前选项名
              if not Handle() then
                Exit(False);
            end
            // 需要选项值，跳出循环，处理选项值
            else
              Break;
          end; 
          // 后续字符串可以作为选项值，不需要执行后面的 NextArg()
          if PArg^ <> #0 then
            continue;
        end;
      end;
      NextArg();
    end;
  end;

  // 选项名未被处理，表示需要选项值（处理过的选项名会被清空）
  if Key <> '' then
  begin
    WriteLn(StdErr, 'Error: Option ''' + Key + ''' need a value.');
    Result := False;
  end;

end;

function GetOpt(        
  AArgc      : Integer;
  AArgv      : PPChar;
  ValueOpts  : String;
  OptHandler : TOptHandler
): Boolean;
begin
  Result := DoGetOpt(AArgc, AArgv, ValueOpts, OptHandler, nil);
end;

function GetOpt(       
  AArgc      : Integer;
  AArgv      : PPChar;
  ValueOpts  : String;
  OptHandler : TOptHandlerObj
): Boolean;
begin
  Result := DoGetOpt(AArgc, AArgv, ValueOpts, nil, OptHandler);
end;

end.