如何解析一个复杂的串

unit EarTagParser;

interface

uses
  System.SysUtils,
  System.Types,
  System.Generics.Collections;

type
  TEarTagList = TList<string>;

  TEarTagParser = class
  private
    FAllTags: TDictionary<string, Boolean>;
    FRawInput: string;
    procedure ParseAll;
    function SplitText(const Source, Sep: string): TStringDynArray;
    type
      TTagCache = record
        PreFix: string;
        SerialLen: Integer;
      end;
    procedure BuildCache(const FullTag, SerialTail: string; var Cache: TTagCache);
    procedure MakeAllTags(StartSerial, EndSerial: Int64; const Cache: TTagCache);
    procedure ParseSingleSeg(const Seg: string; var Cache: TTagCache);
  public
    constructor Create(const AInput: string);
    destructor Destroy; override;
    function ContainsTag(const ATagNo: string): Boolean;
    function GetAllTags: TEarTagList;
  end;

implementation

{ TEarTagParser }

constructor TEarTagParser.Create(const AInput: string);
begin
  inherited Create;
  FRawInput := AInput;
  FAllTags := TDictionary<string, Boolean>.Create;
  ParseAll;
end;

destructor TEarTagParser.Destroy;
begin
  FAllTags.Free;
  inherited;
end;

function TEarTagParser.SplitText(const Source, Sep: string): TStringDynArray;
var
  I, PosS, SepLen: Integer;
  Temp: string;
begin
  SetLength(Result, 0);
  SepLen := Length(Sep);
  if (Source = '') or (SepLen = 0) then Exit;
  Temp := Source;
  I := 0;
  while True do
  begin
    PosS := Pos(Sep, Temp);
    if PosS = 0 then
    begin
      SetLength(Result, I + 1);
      Result[I] := Temp;
      Break;
    end;
    SetLength(Result, I + 1);
    Result[I] := Copy(Temp, 1, PosS - 1);
    Temp := Copy(Temp, PosS + SepLen, MaxInt);
    Inc(I);
  end;
end;

procedure TEarTagParser.BuildCache(const FullTag, SerialTail: string; var Cache: TTagCache);
var
  L: Integer;
begin
  L := Length(SerialTail);
  Cache.SerialLen := L;
  Cache.PreFix := Copy(FullTag, 1, Length(FullTag) - L);
end;

procedure TEarTagParser.MakeAllTags(StartSerial, EndSerial: Int64; const Cache: TTagCache);
var
  I: Int64;
  SerialStr, FullTag: string;
begin
  for I := StartSerial to EndSerial do
  begin
    // 生成时按缓存位数补齐，保证15位，原始数据里的0不会丢失
    SerialStr := Format('%.*d', [Cache.SerialLen, I]);
    FullTag := Cache.PreFix + SerialStr;
    if Length(FullTag) = 15 then
      FAllTags.AddOrSetValue(FullTag, True);
  end;
end;

procedure TEarTagParser.ParseSingleSeg(const Seg: string; var Cache: TTagCache);
var
  BarPos: Integer;
  LeftPart, RightPart: string;
  SStart, SEnd: Int64;
  StartSerialStr: string;
begin
  BarPos := Pos('-', Seg);
  if BarPos = 0 then Exit;

  LeftPart := Trim(Copy(Seg, 1, BarPos - 1));
  RightPart := Trim(Copy(Seg, BarPos + 1, MaxInt));

  if Length(LeftPart) = 15 then
  begin
    BuildCache(LeftPart, RightPart, Cache);
    // 从完整15位耳标截取尾部原始流水文本（保留前导0）
    StartSerialStr := Copy(LeftPart, Length(LeftPart) - Cache.SerialLen + 1, Cache.SerialLen);
    if not TryStrToInt64(StartSerialStr, SStart) then Exit;
    if not TryStrToInt64(RightPart, SEnd) then Exit;
  end
  else
  begin
    if Cache.PreFix = '' then Exit;
    StartSerialStr := LeftPart;
    if not TryStrToInt64(StartSerialStr, SStart) then Exit;
    if not TryStrToInt64(RightPart, SEnd) then Exit;
  end;

  MakeAllTags(SStart, SEnd, Cache);
end;

procedure TEarTagParser.ParseAll;
var
  Temp, OneSeg: string;
  SegArr: TStringDynArray;
  I: Integer;
  Cache: TTagCache;
begin
  FAllTags.Clear;
  Cache.PreFix := '';
  Cache.SerialLen := 0;

  Temp := StringReplace(FRawInput, '、', ',', [rfReplaceAll]);
  Temp := StringReplace(Temp, ' ', '', [rfReplaceAll]);
  if Temp.IsEmpty then Exit;

  SegArr := SplitText(Temp, ',');
  for I := Low(SegArr) to High(SegArr) do
  begin
    OneSeg := Trim(SegArr[I]);
    if OneSeg.IsEmpty then Continue;
    ParseSingleSeg(OneSeg, Cache);
  end;
end;

function TEarTagParser.ContainsTag(const ATagNo: string): Boolean;
begin
  Result := FAllTags.ContainsKey(ATagNo);
end;

function TEarTagParser.GetAllTags: TEarTagList;
var
  KV: TPair<string, Boolean>;
begin
  Result := TEarTagList.Create;

  for KV in FAllTags do
    Result.Add(KV.Key);

  // 新增：字符串升序排序
  Result.Sort;
end;

end.

上面的解析代码，下面串测试通过：

procedure TForm8.Button1Click(Sender: TObject);
const
  TEST_INPUT = '115052310127936-945、115052310600459-502,' +
               '115052104994412-541、115052105407695-704,' +
               '115052310127926-935、115052310600390-458,' +
               '115052104949572-576、115052105169066-091、093-099、101-109、111-118,' +
               '141142503607630-03607749,' +
               '141142500000001-0010,' +
               '115040403656101-250,' +
               '115052104949490-496、115052105168322-388,' +
               '123022704999757-852,123022705000045-088';
var
  Parser: TEarTagParser;
  TagList: TEarTagList;
  SearchTag: string;
begin
  Parser := TEarTagParser.Create(TEST_INPUT);
  try

    Memo1.Lines.Clear;

    // 1. 查询单个耳标是否存在
    SearchTag :=Edit1.Text;// '115052105169093';
    if Parser.ContainsTag(SearchTag) then
      Memo1.Lines.Add('存在耳标：' + SearchTag)
    else
      Memo1.Lines.Add('不存在耳标：' + SearchTag);

    // 2. 获取全部解析出来的耳标
    TagList := Parser.GetAllTags;
    try
      Memo1.Lines.Add('====全部耳标列表===='+TagList.Count.ToString);
      for var s in TagList do
        Memo1.Lines.Add(s);
    finally
      TagList.Free;
    end;
  finally
    Parser.Free; // 释放解析器
  end;
end;