用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]