Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Delphi - TTable - filter

Přesně tak. Zde nabízím (moji vlastní) rutinu, na porovnání řetězce s žolíky:

{-------------------------------- Porovná masku se znaky * a ? se stringem ---------------------------------------}
function StrLike (AMaska, AString: string; const ACaseSensitive: boolean = false): boolean;
{	AMaska		:= Porovnávací maska se znaky * a ?. }
{	AString		:= String k porovnání.  }
{	ACaseSensitive	:= true - pak je citlivé k velikosti písmen, false nebo nic není citlivé na velikost písmen. }
{Vrací: true jestli je shoda, false jestli není }

var	iStringu, iMasky, iKonceStringu, iKonceMasky, i, j: integer; TempString, TempMask: string;
{------------------------------------ Aby to bylo co nejrychlejší }
{$IFOPT Q+} {$DEFINE JeOwerflowCheck} {$OVERFLOWCHECKS OFF} {$ENDIF}
{$IFOPT R+} {$DEFINE JeRangeChecks}   {$RANGECHECKS OFF}    {$ENDIF}
begin
	{------------------------------- Jestli to nemá být case sensitive, tak to převést na velký písmena }
	if not ACaseSensitive then begin AString := AnsiUppercase (AString); AMaska := AnsiUppercase (AMaska) end;

	{----------------------------------- Jedeme tak dlouho, dokud není některý řetěz vyčerpán }
	iStringu := 1; iKonceStringu := length (AString); iMasky := 1; iKonceMasky := length (AMaska);
	while (iStringu <= iKonceStringu) and (iMasky <= iKonceMasky) do begin
		{------------------------ Rozskok podle znaků masky }
		case AMaska [iMasky] of
			{-------------------- Při '?' přeskočit znak stringu i masky, protože srovnání je vždy Ok }
			'?': begin inc (iStringu); inc (iMasky) end;

			{-------------------- Při '*' přeskočit '*' a najít shodu }
			'*': begin
						inc (iMasky);
						{------------- Když maska končí *, končíme taky a je to porovnané Ok... }
						if iMasky > iKonceMasky then
							iStringu := iKonceStringu + 1
						{------------- ... jinak hledat shodu }
						else begin
							TempString	:= copy (AString, iStringu, MaxInt); TempMask := copy (AMaska, iMasky, MaxInt);
							i		:= PosChar ('*', TempMask); if i = 0 then i := MaxInt; j := PosChar ('?', TempMask);
							if (j <> 0) and (j < i) then i := j;
							TempMask	:= copy (TempMask, 1, i - 1); i := pos (TempMask, TempString); if (i = 0) and (TempMask <> '') then break;
							if i <> 0 then begin inc (iStringu, i + length (TempMask) - 1); inc (iMasky, length (TempMask)) end;
						end
					 end
		{---------------------- Cokoliv jiného se musí srovnat celé a při prvním rozdílu končíme }
		else
			if AString [iStringu] = AMaska [iMasky] then begin inc (iStringu); inc (iMasky) end else break;
		end { case }
	end; { while }

	{-------------- Ok srovnání je když se to oboje stejně vyčerpalo stejně a nebo v masce zbyla '*'}
	Result := ((iStringu > iKonceStringu) and (iMasky > iKonceMasky)) or (copy (AMaska, iMasky, MaxInt) = '*');
end;
{$IFDEF JeOwerflowCheck} {$OVERFLOWCHECKS ON} {$ENDIF}
{$IFDEF JeRangeChecks}   {$RANGECHECKS ON}    {$ENDIF}

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny