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

玩慈利网 · 发表于 3 天前

　　由于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[I]);
// 精确匹配开始标签（考虑标签边界）
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;