玩慈利网 发表于 2025-5-7 20:22:12

用Delphi写了一个小程序,批量处理Discuz帖子里的bbcode

  由于Discuz系统内使用的标签代码是bbcode,如果你直接复制网站页面到Discuz里面发帖,点击编辑器的“纯文本”选项,你会发现很多的html标签被自动转换成了bbcode,手动处理起来既麻烦又枯燥,于是,我用Delphi写了一个处理工具,一键处理这些标签,现在分享给大家,有需要的朋友们可以自取。
  主要功能代码如下:
function TForm1.RemoveCustomBBcodeTags(const AText: string; const ATags: array of string): string;
var
PStart, PEnd, PCurrent, I, ContentEnd: Integer;
TempStr, CurrentTag, EndTag, FullTag: string;
IsTagToRemove, IsContentToRemove: Boolean;
ContentTags: TStringList;
begin
// 初始化需要删除内容的特殊标签列表
ContentTags := TStringList.Create;
try
    ContentTags.Add('img');
    ContentTags.Add('url');
    ContentTags.Add('flash');
    Result := AText;
    PCurrent := 1;
    while PCurrent <= Length(Result) do
    begin
      // 查找 '['
      PStart := Pos('[', Copy(Result, PCurrent, MaxInt));
      if PStart = 0 then
      Break;
      PStart := PStart + PCurrent - 1;
      // 查找 ']'
      PEnd := Pos(']', Copy(Result, PStart, MaxInt));
      if PEnd = 0 then
      Break;
      PEnd := PEnd + PStart - 1;
      // 提取完整标签(保留原始大小写)
      FullTag := Copy(Result, PStart, PEnd - PStart + 1);
      TempStr := LowerCase(FullTag);
      // 重置标志
      IsTagToRemove := False;
      IsContentToRemove := False;
      CurrentTag := '';
      // 检查是否是我们要删除的标签
      for I := Low(ATags) to High(ATags) do
      begin
      CurrentTag := LowerCase(ATags);
      // 精确匹配开始标签(考虑标签边界)
      if (TempStr = '[' + CurrentTag + ']') or (Pos('[' + CurrentTag + ' ', TempStr) = 1) or (Pos('[' + CurrentTag + '=', TempStr) = 1) then
      begin
          IsTagToRemove := True;
          // 检查是否是需删除内容的特殊标签
          if ContentTags.IndexOf(CurrentTag) >= 0 then
            IsContentToRemove := True;
          Break;
      end
      // 精确匹配结束标签
      else if (TempStr = '[/' + CurrentTag + ']') then
      begin
          IsTagToRemove := True;
          Break;
      end;
      end;
      if IsTagToRemove then
      begin
      // 处理需要删除内容的特殊标签
      if IsContentToRemove and (Pos('[/', TempStr) <> 1) then
      begin
          // 查找对应的结束标签
          EndTag := '[/' + CurrentTag + ']';
          ContentEnd := PosEx(EndTag, Result, PEnd + 1);
          if ContentEnd > 0 then
          begin
            // 删除整个标签及其内容(从开始标签到结束标签末尾)
            Delete(Result, PStart, ContentEnd + Length(EndTag) - PStart);
            PCurrent := PStart; // 重置位置重新扫描
            Continue;
          end;
      end;
      // 普通标签或未找到结束标签的特殊标签,只删除标签本身
      Delete(Result, PStart, PEnd - PStart + 1);
      PCurrent := PStart; // 重置位置重新扫描
      end
      else
      begin
      PCurrent := PEnd + 1; // 跳过这个不需要删除的标签
      end;
    end;
finally
    ContentTags.Free;
end;
end;
  程序放在下面了,有需要的朋友们可自取。双击上面的待处理文本框,将自动复制剪贴板内容到里面。双击下面的已处理文本框,将自动复制文本框内容到剪贴板。


页: [1]
查看完整版本: 用Delphi写了一个小程序,批量处理Discuz帖子里的bbcode