Søge funktion

Jeg glemte lige at skrive * er hvad som helst, lige om Windows.

sådan som du beskriver din funktion vil den altid virke og vil altid returnere FALSE. Du glemmer at fortælle hvilken tekst der skal gennemsøges:

function find (findtekst, soegitekst : string) : boolean;
begin
  result := (pos(findtekst,soegitekst) > 0);
end;

og den kalder du med

if find(\'Hej\',dintekst) then showmessage(\'Søgeord fundet !\') else showmessage(\'Søgeord ikke fundet !\');

Hvis du lige retter det med hvilken tekst der skal søges igennem, så er der problemet med \'joker\' tegnene.

I tilfældet \"*hej\" er der bare at fjerne stjernen fra søgeteksten og så bruge POS til at lede efter den resterende tekst, sådan som jeg viste i det første eks.

Men hvis du skal kunne benytte forskellige jokertegn samtidig og både før-, midt i, og efter teksten så er det selvfølgeligt vanskligere.

Pos virker fint oog er nem at bruge ... Skal du søge mange gange i den samme tekst skal du bruge andre algoritmer ...
Men mere om det on request.

Jens B

Her har du et eksempel på en \"generel Wildcard søge funktion\":
<SNIP>
Function  WildcardFind(szWildcard, szStr : String;
                      lCaseSensitive, lWildcard : Boolean;
                      cSingle, cMulti : Char) : Boolean;
var
  pWild : PChar;
  pStr  : PChar;

  Function ContainsWild(pWild : PChar) : Boolean;
  begin
    Result := StrScan(pWild, cMulti) <> nil;
    if not Result then
      Result := StrScan(pWild, cSingle) <> nil;
  end;

  Function TrimNonPrintable(StrPtr : PChar) : PChar;
  var
    P : PChar;
  begin
    P := StrPtr + StrLen(StrPtr);
    while Ord(P^) < 32 do begin
      P^ := #0;
      P := P - 1;
    end;
    Result := StrPtr;
  end;

  Function WildMatch(pWild, pStr : PChar) : Boolean;
  var
    pNextWild : PChar;
    pPos      : PChar;
    acSearch  : Array[0..255] of char;
  begin
    if (StrLen(pWild)=0) and (pWild^ = cMulti) then
      Result := True
    else if (pStr^ = #0) and (pWild^ <> #0) then
      Result := False
    else if pStr^ = #0 then
      Result := True
    else if pWild^ = cMulti then begin
      if (not ContainsWild(pWild + 1)) then begin
        pPos := StrPos(pStr, pWild + 1);
        if (Ppos <> nil) and (((StrLen(pPos) = StrLen(pWild+1))
            or (StrLen(TrimNonPrintable(pPos))=StrLen(pWild+1)))) then
          Result := True else Result := False;
      end else begin
        pNextWild := StrScan(pWild + 1, cMulti);
        pPos := StrScan(pWild + 1, cSingle);
        if (pNextWild = nil) then
          pNextWild := pPos
        else if (pPos <> nil) and (pPos < pNextWild) then
          pNextWild := pPos;
          StrLCopy(acSearch,pWild+1,pNextWild-pWild-1);
          pPos := StrPos(pStr, acSearch);
          if (pPos = nil) then Result := False
          else Result := WildMatch(pNextWild, pPos + StrLen(acSearch));
        end;
    end else if pWild^ = cSingle then begin
      repeat
        Inc(pWild);
        Inc(pStr);
      until (pWild^ <> cSingle);
      Result := WildMatch(pWild, pStr);
    end else if pStr^ = pWild^ then begin
      repeat
        Inc(pWild);
        Inc(pStr);
      until (pWild^ = #0) or (pStr^ = #0) or (pStr^ <> pWild^);
      Result := WildMatch(pWild, pStr)
    end else Result := False;
  end;

begin
  pWild := PChar(szWildcard);
  pStr  := PChar(szStr);
  if (not lCaseSensitive) then begin
    StrUpper(pWild);
    StrUpper(pStr);
  end;
  if lWildCard then Result := WildMatch(pWild, pStr)
  else Result := (StrPos(pStr, pWild) <> nil);
end;
</SNIP>

Den kan bruges på flg. måde:
<SNIP>
if WildcardFind(\'hej*\', szMinStrengVar, False, True, \'%\', \'*\') then ....
</SNIP>

I ovenstående angiver \"False\" at den ikke skal være case-sesitive (skelner ikke mellem store/små bogstave) og \"True\" angiver at den skal gøre brug af wildcard\'ene. Parametrene \'%\' og \'*\' angiver henholdvis de wildcards der bruges for et eller flere ukendte tegn (på samme måde som DOS/Windows).

eller en anden ligende :

type
  PathStr = string[128]; { in Delphi 2/3: = string }
  NameStr = string[12];  { in Delphi 2/3: = string }
  ExtStr  = string[3];  { in Delphi 2/3: = string }

{$V-} { in Delphi 2/ 3 to switch off \"strict var-strings\" }

function WildComp(FileWild,FileIs: PathStr): boolean;
var
  NameW,NameI: NameStr;
  ExtW,ExtI: ExtStr;
  c: byte;

  function WComp(var WildS,IstS: NameStr): boolean;
  var
    i, j, l, p : Byte;
  begin
    i := 1;
    j := 1;
    while (i<=length(WildS)) do
    begin
      if WildS[i]=\'*\' then
      begin
        if i = length(WildS) then
        begin
          WComp := true;
          exit
        end
        else
        begin
          { we need to synchronize }
          l := i+1;
          while (l < length(WildS)) and (WildS[l+1] <> \'*\') do
            inc (l);
          p := pos (copy (WildS, i+1, l-i), IstS);
          if p > 0 then
          begin
            j := p-1;
          end
          else
          begin
            WComp := false;
            exit;
          end;
        end;
      end
      else
      if (WildS[i]<>\'?\') and ((length(IstS) < i)
            or (WildS[i]<>IstS[j])) then
      begin
        WComp := false;
    exit
      end;

      inc (i);
      inc (j);
    end;
    WComp := (j > length(IstS));
  end;

begin
  c:=pos(\'.\',FileWild);
  if c=0 then
  begin { automatically append .* }
    NameW := FileWild;
    ExtW  := \'*\';
  end
  else
  begin
    NameW := copy(FileWild,1,c-1);
    ExtW  := copy(FileWild,c+1,255);
  end;

  c:=pos(\'.\',FileIs);
  if c=0 then
    c:=length(FileIs)+1;
  NameI := copy(FileIs,1,c-1);
  ExtI  := copy(FileIs,c+1,255);
  WildComp := WComp(NameW,NameI) and WComp(ExtW,ExtI);
end;

begin
  if    WildComp(\'a*.bmp\',  \'auto.bmp\') then ShowMessage(\'OK 1\');
  if not WildComp(\'a*x.bmp\', \'auto.bmp\') then ShowMessage(\'OK 2\');
  if    WildComp(\'a*o.bmp\', \'auto.bmp\') then ShowMessage(\'OK 3\');
  if not WildComp(\'a*tu.bmp\',\'auto.bmp\') then ShowMessage(\'OK 4\');
end.

Jens B

Til pellelil 

Kan du ikke prøve at ligge det ind i en UNIT fil.
Og så kunne jeg ikke lige for det til at virke med din funktions kald.

Hilsen Dennis.

P.S. Min E-Mail er larsen.dennis@get2net.dk

Pellelil :

jeg har heller ikke få din kode til at virke : Jeg hat testet det følgende :

  if WildcardFind(\'hej*\', \'Mojn for dig og min Hejhest\', False, True, \'%\', \'*\') then
    Caption := \'\';

Det resulterer i en uendelig løkke ... Den, din algorit¨me, er vel ikke allergisk over for voere fire benede venner ?

Jens B

Hmmm!?  Der er vist lige noget jeg skal ha\' kigget på der - takker for oplysningen.

Nu har jeg en der virker, og den er endda pakket ind i en stor forkromet klasse :

type
  TWildMatch = class
  private
    fWildString : char;
    fWildChar  : char;
    fMatchCase  : boolean;
  protected
    { Protected declarations }
  public
    constructor Create;
    function Matching(SearchString, Mask : string) : boolean;
  published
    property WildString : char    read fWildString write fWildString  default \'*\';
    property WildChar  : char    read fWildChar  write fWildChar    default \'?\';
    property MatchCase  : boolean read fMatchCase  write fMatchCase  default false;
  end;

implementation

constructor TWildMatch.Create;
begin
  inherited Create;

  fWildString := \'*\';
  fWildChar  := \'?\';
  fMatchCase  := false;
end;

function TWildMatch.Matching(SearchString, Mask : string) : boolean;
var
  s, m  : string;
  ss    : string[1];
  c      : char;
begin
  s  := SearchString;
  m  := Mask;

  if not fMatchCase then
  begin
    s := Uppercase(s);
    m := Uppercase(m);
  end;

  while (length(s) > 0) and (length(m) > 0) do
  begin
    ss := copy(m,1,1);
    c := ss[1];

    if c = fWildChar then
    begin
      delete(s,1,1);
      delete(m,1,1);
    end
    else if c = fWildString then
    begin
      delete(m,1,1);
      while (not Matching(s,m)) and (length(s) > 0) do
        delete(s,1,1);
    end
    else if copy(s,1,1) = copy(m,1,1)
    then
    begin
      delete(s,1,1);
      delete(m,1,1);
    end
    else
      s := \'\';
  end;
  result := ((length(s) = 0) and (length(m) = 0)) or (m = fWildString);
end;

Også lidt test code :

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TWildMatch.Create do
  try
    MatchCase := false;
    WildString := \'*\';
    WildChar :=\'?\';
    (*Disse 3 er sat for eksemplets skyld idet de er identiske med den sat default i klassen*)
    if Matching(\'Mojn for dig og min Hejhest\',\'*hej*\') then
      ShowMessage(\'Match!\')
    else
      Showmessage(\'No Match\');
  finally
    free;
  end;
end;


Jens B

Til borrisholt

Det har lykkes mig at få din function til at virke, og så har jeg lagt den i en component, som jeg vil smide ud på min hjemmeside, når den bliver færdig.