Delphi学习:2个不错的通配符比较函数

2016-01-29 14:03 26 1 收藏

Delphi学习:2个不错的通配符比较函数,Delphi学习:2个不错的通配符比较函数

【 tulaoshi.com - Delphi 】

 
近日在和朋友讨论 MaskMatch 时偶得2个不错的算法。
  函数1 只支持'*','?'模糊匹配。速度比采用递归算法的快近2倍,比TMask方法快很多。
  函数2 完全支持正规表达式。速度于之前的相同。(不会正规表达式的朋友慎用)



  // ===========================
  // Function 1
  // ===========================

  // Check if the string can match the wildcard. It can be used for unicode strings as well!
  // C: 2004-07-24 | M: 2004-07-24
  function MaskMatch(const aPattern, aSource: string): Boolean;
  var
  StringPtr, PatternPtr: PChar;
  StringRes, PatternRes: PChar;
  begin
  Result := False;
  StringPtr := PChar(UpperCase(aSource));
  PatternPtr := PChar(UpperCase(aPattern));
  StringRes := nil;
  PatternRes := nil;
  repeat
  repeat // ohne vorangegangenes "*"
  case PatternPtr^ of
  #0 : begin
  Result := StringPtr^ = #0;
  if Result or (StringRes = nil) or (PatternRes = nil) then Exit;
  StringPtr := StringRes;
  PatternPtr := PatternRes;
  Break;
  end;
  '*': begin
  Inc(PatternPtr);
  PatternRes := PatternPtr;
  Break;
  end;
  '?': begin
  if StringPtr^ = #0 then Exit;
  Inc(StringPtr);
  Inc(PatternPtr);
  end;
  else begin
  if StringPtr^ = #0 then Exit;
  if StringPtr^ < PatternPtr^ then
  begin
  if (StringRes = nil) or (PatternRes = nil) then Exit;
  StringPtr := StringRes;
  PatternPtr := PatternRes;

(本文来源于图老师网站,更多请访问http://www.tulaoshi.com/delphi/)

  Break;
  end else
  begin
  Inc(StringPtr);
  Inc(PatternPtr);
  end;
  end;
  end;
  until False;

  repeat // mit vorangegangenem "*"
  case PatternPtr^ of
  #0 : begin
  Result := True;
  Exit;
  end;
  '*': begin
  Inc(PatternPtr);
  PatternRes := PatternPtr;
  end;
  '?': begin
  if StringPtr^ = #0 then Exit;
  Inc(StringPtr);
  Inc(PatternPtr);
  end;
  else begin
  repeat
  if StringPtr^ = #0 then Exit;
  if StringPtr^ = PatternPtr^ then Break;
  Inc(StringPtr);
  until False;
  Inc(StringPtr);
  StringRes := StringPtr;
  Inc(PatternPtr);
  Break;
  end;
  end;
  until False;
  until False;
  end;



  // ===========================
  // Function 2
  // ===========================

(本文来源于图老师网站,更多请访问http://www.tulaoshi.com/delphi/)

  function _MatchPattern(aPattern, aSource: PChar): Boolean;
  begin
  Result := True;
  while (True) do
  begin
  case aPattern[0] of
  #0 : begin
  //End of pattern reached.
  Result := (aSource[0] = #0); //TRUE if end of aSource.
  Exit;
  end;

  '*': begin //Match zero or more occurances of any char.
  if (aPattern[1] = #0) then
  begin
  //Match any number of trailing chars.
  Result := True;
  Exit;
  end else
  Inc(aPattern);

  while (aSource[0] < #0) do
  begin
  //Try to match any substring of aSource.
  if (_MatchPattern(aSource, aPattern)) then
  begin
  Result := True;
  Exit;
  end;

  //Continue testing next char...
  Inc(aSource);
  end;
  end;

  '?': begin //Match any one char.
  if (aSource[0] = #0) then
  begin
  Result := False;
  Exit;
  en

来源:http://www.tulaoshi.com/n/20160129/1492411.html

延伸阅读
procedure TForm1.FTPAnalysis(S:string;var UserName,Password,IP,FileName:String;var DirList:TStringList); var   i,j:integer;   strAuthorization,strAddr,strDirFile:string; //授权信息 begin   UserName:= 'anonymous';   Password:= 'test@test.com';...
标签: Web开发
function JsUBB(str)   {   var re=//[i/](.[^/[]*)/[//i/]/gi;   str=str.replace(re,"i$1/i"); //斜体字   re=//[b/](.[^/[]*)/[//b/]/gi;   str=str.replace(re,"b$1/b"); //粗体字   re=//[u/](.[^/[]*)/[//u/]/gi;   str=str.replace(...
翻译的不好,请见谅。 翻译:鲁小班 文件: ActnList CreateAction 函数 创建一个指定类型的Action,显示在action list editor中。 EnumRegisteredAction 过程 枚举已经注册的Action RegisterAction 过程 注册Action UnRegisterAction 过程 反注册Action 文件: Classes Bounds 函数 输入上...
标签: ASP
  最近迷恋上作网站了,使用asp开发,发现asp有好多的漏洞,而且在一个网站中有好多的代码是重复使用的,所以就查询了一些资料发现在asp中可以使用类的思想,所以就写了这个类,写的不好,但是比较实用。 <meta http-equiv="Content-Type" content="text/html; charset=gb2312" <% Const Btn_First="<font face='webdings'9&l...
标签: Delphi
  在用Delphi 3.0开发软件时,出现了硬件驱动程序(DLL)中的函数和过程不能正常调用的问题,该硬件由英国Schlumberger公司生产,驱动程序用汇编语言编写的。其《编程指南》给出的Microsoft C的示范程序均能正常运行。但运行此软件时现出的错误提示为: Access violation at address ×××××××× in module…… 经仔细分析...

经验教程

623

收藏

29
微博分享 QQ分享 QQ空间 手机页面 收藏网站 回到头部