From d7036bb0009f384c86e895b1385a2e1cb46c5db0 Mon Sep 17 00:00:00 2001 From: Juha Date: Wed, 13 Oct 2021 12:41:41 +0300 Subject: [PATCH] =?UTF-8?q?LazUtils:=20Restore=20the=20Jos=C3=A9=20Mejuto'?= =?UTF-8?q?s=20version=20of=20TMask.=20Faster=20and=20better.=20Can=20be?= =?UTF-8?q?=20tested=20now=20without=20hurry.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- components/lazutils/fileutil.inc | 15 +- components/lazutils/lazutilsstrconsts.pas | 10 +- components/lazutils/masks.pas | 1444 ++++++++++++++------- lcl/shellctrls.pas | 20 +- 4 files changed, 982 insertions(+), 507 deletions(-) diff --git a/components/lazutils/fileutil.inc b/components/lazutils/fileutil.inc index 135e1aad07..db170d381c 100644 --- a/components/lazutils/fileutil.inc +++ b/components/lazutils/fileutil.inc @@ -795,12 +795,8 @@ var // Deal with both files and directories if (PathInfo.Attr and faDirectory) = 0 then begin // File - {$IFDEF Windows} - if (MaskList = nil) or MaskList.MatchesWindowsMask(PathInfo.Name) - {$ELSE} - if (MaskList = nil) or MaskList.Matches(PathInfo.Name) - {$ENDIF} - then begin + if (MaskList = nil) or MaskList.Matches(PathInfo.Name) then + begin FPath := APath; FLevel := ALevel; FFileInfo := PathInfo; @@ -848,14 +844,9 @@ var i: Integer; Dir: String; OtherDir: String; - MaskOptions: TMaskOptions; begin if FSearching then RaiseSearchingError; - if CaseSensitive then - MaskOptions := [moCaseSensitive] - else - MaskOptions := []; - MaskList := TMaskList.Create(ASearchMask, FMaskSeparator, MaskOptions); + MaskList := TMaskList.CreateSysNative(ASearchMask, FMaskSeparator, CaseSensitive); // empty mask = all files mask if MaskList.Count = 0 then FreeAndNil(MaskList); diff --git a/components/lazutils/lazutilsstrconsts.pas b/components/lazutils/lazutilsstrconsts.pas index 703c7df278..0ad4e50110 100644 --- a/components/lazutils/lazutilsstrconsts.pas +++ b/components/lazutils/lazutilsstrconsts.pas @@ -16,7 +16,6 @@ interface resourceString lrsModified = ' modified '; - lrsInvalidCharSet = 'The char set in mask "%s" is not valid!'; lrsSize = ' size '; lrsFileDoesNotExist = 'file "%s" does not exist'; lrsFileIsADirectoryAndNotAnExecutable = 'file "%s" is a directory and not an' @@ -42,6 +41,15 @@ resourceString lrsERRORInCode = 'ERROR in code: '; lrsCreatingGdbCatchableError = 'Creating gdb catchable error:'; + // Masks + rsInvalidCharMaskAt = 'Invalid char mask "%s" at %d'; + rsInvalidCharMask = 'Invalid char mask "%s"'; + rsMissingCloseCharMaskAt = 'Missing close char mask "%s" at %d'; + rsMissingCloseCharMask = 'Missing close char mask "%s"'; + rsIncompleteMask = 'Reached end of mask, but missing close/escape sequence.'; + rsInvalidEscapeChar = 'Escape character must be ASCII <= 127'; + rsInternalError = 'Internal %s error.'; + // XPath lrsNodeSet = 'node set'; lrsBoolean = 'boolean'; diff --git a/components/lazutils/masks.pas b/components/lazutils/masks.pas index 2c8b71399f..42327050ce 100644 --- a/components/lazutils/masks.pas +++ b/components/lazutils/masks.pas @@ -10,54 +10,226 @@ unit Masks; {$mode objfpc}{$H+} +// RANGES_AUTOREVERSE +// If reverse ranges if needed, so range "[z-a]" is interpreted as "[a-z]" +{$DEFINE RANGES_AUTOREVERSE} + interface uses - Classes, SysUtils, Contnrs, LazUtilsStrConsts, LazUTF8; + Classes, SysUtils, Contnrs, + // LazUtils + LazUtilsStrConsts, LazUTF8; type - TMaskCharType = (mcChar, mcCharSet, mcAnyChar, mcAnyText); - TMaskOption = (moCaseSensitive, moDisableSets); - TMaskOptions = set of TMaskOption; + { EMaskError } - TCharSet = set of Char; - PCharSet = ^TCharSet; - - TUtf8Char = String[7]; - - EMaskError=class(EConvertError); - - TMaskChar = record - case CharType: TMaskCharType of - mcChar: (CharValue: TUtf8Char); - mcCharSet: (Negative: Boolean; SetValue: PCharSet); - mcAnyChar, mcAnyText: (); - end; - - TMaskString = record - MinLength: Integer; - MaxLength: Integer; - Chars: Array of TMaskChar; - end; - - { TMask } - - TMask = class - private - FMask: TMaskString; - fInitialMask: String; - fOptions: TMaskOptions; - procedure InitMaskString(const AValue: String); - procedure ClearMaskString; + EMaskError=class(EConvertError) public - constructor Create(const AValue: String; const CaseSensitive: Boolean); deprecated 'use overload with Options parameter'; - constructor Create(const AValue: String; const AOptions: TMaskOptions = []); - destructor Destroy; override; - - function Matches(const AFileName: String): Boolean; - function MatchesWindowsMask(const AFileName: String): Boolean; + type + TMaskExceptionCode=(eMaskException_InternalError, + eMaskException_InvalidCharMask, + eMaskException_MissingClose, + eMaskException_IncompleteMask, + eMaskException_InvalidEscapeChar, + eMaskException_InvalidUTF8Sequence + ); + protected + cCode: TMaskExceptionCode; + public + constructor Create(const msg: string; aCode: TMaskExceptionCode); + constructor CreateFmt(const msg: string; args: array of const; aCode: TMaskExceptionCode); + property Code: TMaskExceptionCode read cCode; end; + // Literal = It must match + // Range = Match any char in the range + // Negate = Negate match in a group + // AnyChar = It matches any char, but one must match + // AnyCharOrNone = Matches one or none char (only in a group) + // AnyCharToNext = Matches any chars amount, if fail, restart in the + // next position up to finish the mask or the matched string + // OptionalChar = Optional char + // CharsGroupBegin = Begin optional chars or ranges "[" + // CharsGroupEnd = End optional chars or ranges "]" + TMaskOpCode = ( + Literal=0, + Range=1, + Negate=2, + AnyChar=3, + AnyCharOrNone=4, + AnyCharToNext=5, + OptionalChar=6, + CharsGroupBegin=10, + CharsGroupEnd=11 + ); + TMaskOpcodesEnum=(eMaskOpcodeAnyChar, + eMaskOpcodeAnyCharOrNone, + eMaskOpcodeAnyText, + eMaskOpcodeRange, + eMaskOpcodeOptionalChar, + eMaskOpcodeNegateGroup, + eMaskOpcodeEscapeChar); + TMaskOpcodesSet=set of TMaskOpcodesEnum; + + TMaskFailCause = ( + Success = 0, + MatchStringExhausted = 1, + MaskExhausted = 2, + MaskNotMatch = 3, + UnexpectedEnd = 4 + ); + (* + Windows mask works in a different mode than regular mask, it has too many + quirks and corner cases inherited from CP/M, then adapted to DOS (8.3) file + names and adapted again for long file names. + + Anyth?ng.abc = "?" matches exactly 1 char + Anyth*ng.abc = "*" matches 0 or more of chars + + ------- Quirks ------- + + --eWindowsQuirk_AnyExtension + Anything*.* = ".*" is removed. + + --eWindowsQuirk_FilenameEnd + Anything??.abc = "?" matches 1 or 0 chars (except '.') + (Not the same as "Anything*.abc", but the same + as regex "Anything.{0,2}\.abc") + Internally converted to "Anything[??].abc" + + --eWindowsQuirk_Extension3More + Anything.abc = Matches "Anything.abc" but also "Anything.abc*" (3 char extension) + Anything.ab = Matches "Anything.ab" and never "anything.abcd" + + --eWindowsQuirk_EmptyIsAny + "" = Empty string matches anything "*" + + --eWindowsQuirk_AllByExtension (Not in use anymore) + .abc = Runs as "*.abc" + + --eWindowsQuirk_NoExtension + Anything*. = Matches "Anything*" without extension + *) + TWindowsQuirks=(eWindowsQuirk_AnyExtension, eWindowsQuirk_FilenameEnd, + eWindowsQuirk_Extension3More, eWindowsQuirk_EmptyIsAny, + eWindowsQuirk_AllByExtension, eWindowsQuirk_NoExtension); + TWindowsQuirkSet=set of TWindowsQuirks; + +const + WindowsQuirksAllAllowed=[eWindowsQuirk_AnyExtension, + eWindowsQuirk_FilenameEnd, + eWindowsQuirk_Extension3More, + eWindowsQuirk_EmptyIsAny, + eWindowsQuirk_AllByExtension, + eWindowsQuirk_NoExtension]; + WindowsQuirksDefaultAllowed=[eWindowsQuirk_AnyExtension, + eWindowsQuirk_FilenameEnd, + eWindowsQuirk_Extension3More, + eWindowsQuirk_EmptyIsAny, + {eWindowsQuirk_AllByExtension,} // Not in use anymore + eWindowsQuirk_NoExtension]; + MaskOpCodesAllAllowed=[eMaskOpcodeAnyChar, + eMaskOpcodeAnyCharOrNone, + eMaskOpcodeAnyText, + eMaskOpcodeRange, + eMaskOpcodeOptionalChar, + eMaskOpcodeNegateGroup, + eMaskOpcodeEscapeChar]; + + MaskOpCodesDefaultAllowed=MaskOpCodesAllAllowed; + + // Leave out eMaskOpcodeAnyCharOrNone, eMaskOpcodeRange and eMaskOpcodeOptionalChar. + MaskOpCodesDisableRange=[eMaskOpcodeAnyChar, + eMaskOpcodeAnyText, + eMaskOpcodeNegateGroup, + eMaskOpcodeEscapeChar]; + +type + + { TMaskBase } + + TMaskBase = class + private + procedure SetMaskEscapeChar(AValue: Char); + protected + const GROW_BY=100; + procedure Add(const aLength: integer; const aData: PBYTE); + procedure Add(const aValue: integer); + procedure Add(const aValue: TMaskOpCode); + procedure IncrementLastCounterBy(const aOpcode: TMaskOpCode; const aValue: integer); + protected + cCaseSensitive: Boolean; + cMaskIsCompiled: Boolean; + cMaskCompiled: TBytes; + cMaskCompiledIndex: integer; + cMaskCompiledAllocated: integer; + cMaskCompiledLimit: integer; + cMaskLimit: integer; + cMatchStringLimit: integer; + cMatchMinimumLiteralBytes: SizeInt; + cMatchMaximumLiteralBytes: SizeInt; + cMaskOpcodesAllowed: TMaskOpcodesSet; + // EscapeChar forces next char to be a literal one, not a wildcard. + cMaskEscapeChar: Char; + procedure Compile; virtual; + class procedure Exception_InvalidCharMask(const aMaskChar: string; const aOffset: integer=-1); static; + class procedure Exception_MissingCloseChar(const aMaskChar: string; const aOffset: integer=-1); static; + class procedure Exception_IncompleteMask(); static; + class procedure Exception_InvalidEscapeChar(); static; + procedure Exception_InternalError(); + //function intfMatches(aMatchOffset: integer; aMaskIndex: integer): TMaskFailCause; virtual; abstract; + public + constructor Create(aCaseSensitive: Boolean=False); + constructor CreateAdvanced(aCaseSensitive: Boolean=False; aOpcodesAllowed: TMaskOpcodesSet=MaskOpCodesAllAllowed); + public + property CaseSensitive: Boolean read cCaseSensitive; + property EscapeChar: Char read cMaskEscapeChar write SetMaskEscapeChar; + end; + + { TMaskUTF8 } + + TMaskUTF8 = class (TMaskBase) + private + cMatchString: RawByteString; + protected + cOriginalMask: RawByteString; + class function CompareUTF8Sequences(const P1,P2: PChar): integer; static; + function intfMatches(aMatchOffset: integer; aMaskIndex: integer): TMaskFailCause; //override; + public + constructor Create(const aMask: RawByteString; aCaseSensitive: Boolean=False); + constructor CreateAdvanced(const aMask: RawByteString; aCaseSensitive: Boolean=False; + aOpcodesAllowed: TMaskOpcodesSet=MaskOpCodesAllAllowed); + procedure Compile; override; + function Matches(const aStringToMatch: RawByteString): Boolean; virtual; + public + property Mask: RawByteString read cOriginalMask write cOriginalMask; + property OPCodesAllowed: TMaskOpcodesSet read cMaskOpcodesAllowed;// write cMaskOpcodesAllowed; + end; + + TMask = class(TMaskUTF8); + + { TMaskUTF8Windows } + + TMaskUTF8Windows=class(TMask) + protected + cMaskWindowsQuirkAllowed: TWindowsQuirkSet; + cMaskWindowsQuirkInUse: TWindowsQuirkSet; + cWindowsMask: RawByteString; + class procedure SplitFileNameExtension(const aSourceFileName: RawByteString; + out aFileName: RawByteString; out aExtension: RawByteString; aIsMask: Boolean=False); static; + public + constructor Create(const aMask: RawByteString; aCaseSensitive: Boolean=False); + constructor CreateAdvanced(const aMask: RawByteString; aCaseSensitive: Boolean=False; + aWindowsQuirksAllowed: TWindowsQuirkSet=WindowsQuirksAllAllowed); + procedure Compile; override; + function Matches(const aFileName: RawByteString): Boolean; override; + property Mask: RawByteString read cWindowsMask write cWindowsMask; + property Quirks: TWindowsQuirkSet read cMaskWindowsQuirkAllowed write cMaskWindowsQuirkAllowed; + end; + + TMaskWindows = class(TMaskUTF8Windows); + { TParseStringList } TParseStringList = class(TStringList) @@ -73,66 +245,39 @@ type function GetCount: Integer; function GetItem(Index: Integer): TMask; public - constructor Create(const AValue: String; ASeparator: Char; const CaseSensitive: Boolean); deprecated 'use overload with Options parameter'; - constructor Create(const AValue: String; ASeparator: Char = ';'; const AOptions: TMaskOptions = []); + constructor Create(const AValue: String; ASeparator: Char=';'; CaseSensitive: Boolean=False; + aOpcodesAllowed: TMaskOpcodesSet=MaskOpCodesDefaultAllowed); + constructor CreateWindows(const AValue: String; ASeparator: Char; CaseSensitive: Boolean); + constructor CreateSysNative(const AValue: String; ASeparator: Char; CaseSensitive: Boolean); destructor Destroy; override; function Matches(const AFileName: String): Boolean; + // Don't call this. Create with TMaskList.CreateWindows, then call Matches. function MatchesWindowsMask(const AFileName: String): Boolean; property Count: Integer read GetCount; property Items[Index: Integer]: TMask read GetItem; end; -function MatchesMask(const FileName, Mask: String; const CaseSensitive: Boolean): Boolean; deprecated 'use overload with Options parameter'; -function MatchesMask(const FileName, Mask: String; const Options: TMaskOptions = []): Boolean; -function MatchesWindowsMask(const FileName, Mask: String; const CaseSensitive: Boolean): Boolean; deprecated 'use overload with Options parameter'; -function MatchesWindowsMask(const FileName, Mask: String; const Options: TMaskOptions = []): Boolean; +function MatchesMask(const FileName, Mask: String; CaseSensitive: Boolean=False; + aOpcodesAllowed: TMaskOpcodesSet=MaskOpCodesDefaultAllowed): Boolean; +function MatchesWindowsMask(const FileName, Mask: String; CaseSensitive: Boolean=False): Boolean; + +function MatchesMaskList(const FileName, Mask: String; Separator: Char=';'; + CaseSensitive: Boolean=False; + aOpcodesAllowed: TMaskOpcodesSet=MaskOpCodesDefaultAllowed): Boolean; +function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char=';'; + CaseSensitive: Boolean=False): Boolean; -function MatchesMaskList(const FileName, Mask: String): Boolean; -function MatchesMaskList(const FileName, Mask: String; Separator: Char): Boolean; -function MatchesMaskList(const FileName, Mask: String; Separator: Char; const CaseSensitive: Boolean): Boolean; deprecated 'use overload with Options parameter'; -function MatchesMaskList(const FileName, Mask: String; Separator: Char; const Options: TMaskOptions): Boolean; -function MatchesWindowsMaskList(const FileName, Mask: String): Boolean; -function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char): Boolean; -function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char; const CaseSensitive: Boolean): Boolean; deprecated 'use overload with Options parameter'; -function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char; const Options: TMaskOptions): Boolean; implementation -//Utf8 helper functions - -function GetCodePoint(const S: String; const Index: PtrInt): TUTF8Char; -//equivalent for Result := S[Index], but for Utf8 encoded strings -var - p: PChar; - PLen: PtrInt; - Res: AnsiString; //intermediate needed for PChar -> String -> ShortString assignement -begin - Result := ''; - p := UTF8CodepointStart(PChar(S), Length(S), Index - 1); //zero-based call - //determine the length in bytes of this UTF-8 character - PLen := UTF8CodepointSize(p); - Res := p; - //Set correct length for Result (otherwise it returns all chars up to the end of the original string) - SetLength(Res,PLen); - Result := Res; -end; - - -function MatchesMask(const FileName, Mask: String; const CaseSensitive: Boolean): Boolean; -begin - if CaseSensitive then - Result := MatchesMask(FileName, Mask, [moCaseSensitive]) - else - Result := MatchesMask(FileName, Mask, []) -end; - -function MatchesMask(const FileName, Mask: String; const Options: TMaskOptions): Boolean; +function MatchesMask(const FileName, Mask: String; CaseSensitive: Boolean; + aOpcodesAllowed: TMaskOpcodesSet): Boolean; var AMask: TMask; begin - AMask := TMask.Create(Mask, Options); + AMask := TMask.CreateAdvanced(Mask, CaseSensitive, aOpcodesAllowed); try Result := AMask.Matches(FileName); finally @@ -140,49 +285,24 @@ begin end; end; -function MatchesWindowsMask(const FileName, Mask: String; const Options: TMaskOptions): Boolean; +function MatchesWindowsMask(const FileName, Mask: String; CaseSensitive: Boolean): Boolean; var - AMask: TMask; + AMask: TMaskWindows; begin - AMask := TMask.Create(Mask, Options); + AMask := TMaskWindows.Create(Mask, CaseSensitive); try - Result := AMask.MatchesWindowsMask(FileName); + Result := AMask.Matches(FileName); finally AMask.Free; end; end; -function MatchesWindowsMask(const FileName, Mask: String; const CaseSensitive: Boolean): Boolean; -begin - if CaseSensitive then - Result := MatchesWindowsMask(FileName, Mask, [moCaseSensitive]) - else - Result := MatchesWindowsMask(FileName, Mask, []) -end; - -function MatchesMaskList(const FileName, Mask: String): Boolean; -begin - Result := MatchesMaskList(FileName, Mask, ';', []); -end; - -function MatchesMaskList(const FileName, Mask: String; Separator: Char): Boolean; -begin - Result := MatchesMaskList(FileName, Mask, Separator, []); -end; - -function MatchesMaskList(const FileName, Mask: String; Separator: Char; const CaseSensitive: Boolean): Boolean; -begin - if CaseSensitive then - Result := MatchesMaskList(FileName, Mask, Separator, [moCaseSensitive]) - else - Result := MatchesMaskList(FileName, Mask, Separator, []); -end; - -function MatchesMaskList(const FileName, Mask: String; Separator: Char; const Options: TMaskOptions): Boolean; +function MatchesMaskList(const FileName, Mask: String; Separator: Char; + CaseSensitive: Boolean; aOpcodesAllowed: TMaskOpcodesSet): Boolean; var AMaskList: TMaskList; begin - AMaskList := TMaskList.Create(Mask, Separator, Options); + AMaskList := TMaskList.Create(Mask, Separator, CaseSensitive, aOpcodesAllowed); try Result := AMaskList.Matches(FileName); finally @@ -190,373 +310,722 @@ begin end; end; - -function MatchesWindowsMaskList(const FileName, Mask: String): Boolean; -begin - Result := MatchesWindowsMaskList(FileName, Mask, ';', []); -end; - -function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char): Boolean; -begin - Result := MatchesWindowsMaskList(FileName, Mask, Separator, []); -end; - -function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char; const CaseSensitive: Boolean): Boolean; -begin - if CaseSensitive then - Result := MatchesWindowsMaskList(FileName, Mask, Separator, [moCaseSensitive]) - else - Result := MatchesWindowsMaskList(FileName, Mask, Separator, []); -end; - -function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char; const Options: TMaskOptions): Boolean; +function MatchesWindowsMaskList(const FileName, Mask: String; Separator: Char; + CaseSensitive: Boolean): Boolean; var AMaskList: TMaskList; begin - AMaskList := TMaskList.Create(Mask, Separator, Options); + AMaskList := TMaskList.CreateWindows(Mask, Separator, CaseSensitive); try - Result := AMaskList.MatchesWindowsMask(FileName); + Result := AMaskList.Matches(FileName); finally AMaskList.Free; end; end; +{ EMaskError } + +constructor EMaskError.Create(const msg: string; aCode: TMaskExceptionCode); +begin + CreateFmt(msg,[],aCode); +end; + +constructor EMaskError.CreateFmt(const msg: string; args: array of const; + aCode: TMaskExceptionCode); +begin + cCode:=aCode; + Inherited CreateFmt(msg,args); +end; + +{ TMaskBase } + +procedure TMaskBase.SetMaskEscapeChar(AValue: Char); +begin + if cMaskEscapeChar=AValue then Exit; + if cMaskEscapeChar>#127 then begin + Exception_InvalidEscapeChar(); + end; + cMaskEscapeChar:=AValue; +end; + +procedure TMaskBase.Add(const aLength: integer; const aData: PBYTE); +var + lCounter: integer; +begin + if cMaskCompiledIndex+aLength>=cMaskCompiledAllocated then begin + cMaskCompiledAllocated:=cMaskCompiledAllocated+aLength+GROW_BY; + SetLength(cMaskCompiled,cMaskCompiledAllocated); + end; + for lCounter := 0 to Pred(aLength) do begin + cMaskCompiled[cMaskCompiledIndex]:=(aData+lCounter)^; + inc(cMaskCompiledIndex); + end; +end; + +procedure TMaskBase.Add(const aValue: integer); +begin + Add(sizeof(aValue),@aValue); +end; + +procedure TMaskBase.Add(const aValue: TMaskOpCode); +var + v: BYTE; +begin + v:=BYTE(aValue); + Add(1,@v); +end; + +procedure TMaskBase.IncrementLastCounterBy(const aOpcode: TMaskOpCode; + const aValue: integer); +var + p: PInteger; +begin + cMaskCompiledIndex:=cMaskCompiledIndex-sizeof(aValue); + if TMaskOpCode(cMaskCompiled[cMaskCompiledIndex-1])<>aOpcode then begin + Exception_InternalError(); + end; + P:=@cMaskCompiled[cMaskCompiledIndex]; + Add(P^+aValue); +end; + +procedure TMaskBase.Compile; +begin + cMaskIsCompiled:=true; +end; + +class procedure TMaskBase.Exception_InvalidCharMask(const aMaskChar: string; + const aOffset: integer); +begin + if aOffset>=0 then begin + raise EMaskError.CreateFmt(rsInvalidCharMaskAt, [aMaskChar, aOffset], eMaskException_InvalidCharMask); + end else begin + raise EMaskError.CreateFmt(rsInvalidCharMask, [aMaskChar], eMaskException_InvalidCharMask); + end; +end; + +class procedure TMaskBase.Exception_MissingCloseChar(const aMaskChar: string; + const aOffset: integer); +begin + if aOffset>=0 then begin + raise EMaskError.CreateFmt(rsMissingCloseCharMaskAt, [aMaskChar, aOffset], eMaskException_MissingClose); + end else begin + raise EMaskError.CreateFmt(rsMissingCloseCharMask, [aMaskChar], eMaskException_MissingClose); + end; +end; + +class procedure TMaskBase.Exception_IncompleteMask(); +begin + raise EMaskError.CreateFmt(rsIncompleteMask, [], eMaskException_IncompleteMask); +end; + +class procedure TMaskBase.Exception_InvalidEscapeChar(); +begin + raise EMaskError.Create(rsInvalidEscapeChar, eMaskException_InvalidEscapeChar); +end; + +procedure TMaskBase.Exception_InternalError(); +begin + raise EMaskError.CreateFmt(rsInternalError, [self.ClassName], eMaskException_InternalError); +end; + +constructor TMaskBase.CreateAdvanced(aCaseSensitive: Boolean; + aOpcodesAllowed: TMaskOpcodesSet); +begin + cMaskOpcodesAllowed:=aOpcodesAllowed; + cCaseSensitive:=aCaseSensitive; + cMaskEscapeChar:='\'; +end; + +constructor TMaskBase.Create(aCaseSensitive: Boolean); +begin + CreateAdvanced(aCaseSensitive,MaskOpCodesDefaultAllowed); +end; { TMask } -procedure TMask.InitMaskString(const AValue: String); +procedure TMaskUTF8.Compile; var - I: Integer; - SkipAnyText: Boolean; + j: Integer; + lCharsGroupInsertSize: integer; + lCPLength: integer; + lLast: TMaskOpCode; + lMask: RawByteString; - procedure CharSetError; - begin - raise EMaskError.CreateFmt(lrsInvalidCharSet, [AValue]); - end; - - procedure AddAnyText; - begin - if SkipAnyText then - begin - Inc(I); - Exit; - end; - - SetLength(FMask.Chars, Length(FMask.Chars) + 1); - FMask.Chars[High(FMask.Chars)].CharType := mcAnyText; - - FMask.MaxLength := MaxInt; - SkipAnyText := True; - Inc(I); - end; - - procedure AddAnyChar; - begin - SkipAnyText := False; - - SetLength(FMask.Chars, Length(FMask.Chars) + 1); - FMask.Chars[High(FMask.Chars)].CharType := mcAnyChar; - - Inc(FMask.MinLength); - if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength); - - Inc(I); - end; - - procedure AddCharSet; - var - CharSet: TCharSet; - Valid: Boolean; - C, Last: Char; - CP: TUtf8Char; - begin - SkipAnyText := False; - - SetLength(FMask.Chars, Length(FMask.Chars) + 1); - FMask.Chars[High(FMask.Chars)].CharType := mcCharSet; - - Inc(I); - if (I <= Utf8Length(AValue)) and (GetCodePoint(AValue,I) = '!') then - begin - FMask.Chars[High(FMask.Chars)].Negative := True; - Inc(I); - end - else FMask.Chars[High(FMask.Chars)].Negative := False; - - Last := '-'; - CharSet := []; - Valid := False; - while I <= Utf8Length(AValue) do - begin - CP := GetCodePoint(AValue,I); - //CharSets can only contain 1-byte codepoints - if (Length(CP) <> 1) then CharSetError; - case CP of - '-': - begin - if Last = '-' then CharSetError; - Inc(I); - if (I > Utf8Length(AValue)) then CharSetError; - CP := GetCodePoint(AValue, I); - if (Length(CP) <> 1) then CharSetError; - if (moCaseSensitive in fOptions) then +begin + inherited Compile; + if cCaseSensitive then + lMask:=cOriginalMask + else + lMask:=UTF8LowerCase(cOriginalMask); + cMaskLimit:=Length(lMask); + lLast:=TMaskOpCode.Literal; + SetLength(cMaskCompiled,0); + j:=1; + while j<=cMaskLimit do begin + lCPLength:=UTF8CodepointSizeFast(@lMask[j]); + if (eMaskOpcodeEscapeChar in cMaskOpcodesAllowed) and (lMask[j]=cMaskEscapeChar) then begin + // next is Literal + inc(j,lCPLength); + if j<=cMaskLimit then begin + lCPLength:=UTF8CodepointSizeFast(@lMask[j]); + Add(TMaskOpCode.Literal); + Add(lCPLength,@lMask[j]); + inc(cMatchMinimumLiteralBytes,lCPLength); + if cMatchMaximumLiteralBytesTMaskOpCode.AnyCharToNext then begin + Add(TMaskOpCode.AnyCharToNext); + lLast:=TMaskOpCode.AnyCharToNext; + // * = No limit + cMatchMaximumLiteralBytes:=High(cMatchMaximumLiteralBytes); + end; + end else begin + Add(TMaskOpCode.Literal); + Add(lCPLength,@lMask[j]); + inc(cMatchMinimumLiteralBytes,lCPLength); + if cMatchMaximumLiteralBytes']') then begin + //lMask[j] is not '?', but previous mask was '?' and it is an invalid sequence. + // "[??] = Valid" // "[a?] or [?a] = Invalid" + Exception_InvalidCharMask(lMask[j],j); + + end else if ((j+lCPLength+1)<=cMaskLimit) and (lMask[j+lCPLength]='-') and (eMaskOpcodeRange in cMaskOpcodesAllowed) then begin + // j+lCPLength+1 --explained-- + //------------------------------ + // j+lCPLength is next UTF8 after current UTF8 CP + // +1 is at least one byte in UTF8 sequence after "-" + // Check if it is a range + Add(TMaskOpCode.Range); + // Check if reverse range is needed + {$IFDEF RANGES_AUTOREVERSE} + if CompareUTF8Sequences(@lMask[j],@lMask[j+lCPLength+1])<0 then begin + Add(lCPLength,@lMask[j]); + inc(j,lCPLength); + inc(j,1); // The "-" + lCPLength:=UTF8CodepointSizeFast(@lMask[j]); + Add(lCPLength,@lMask[j]); + end else begin + Add(UTF8CodepointSizeFast(@lMask[j+lCPLength+1]),@lMask[j+lCPLength+1]); + Add(lCPLength,@lMask[j]); + inc(j,lCPLength+1); + lCPLength:=UTF8CodepointSizeFast(@lMask[j]); + end; + {$ELSE} + Add(lCPLength,@lMask[j]); + inc(j,lCPLength); + inc(j,1); // The "-" + lCPLength:=UTF8CodepointSizeFast(@lMask[j]); + Add(lCPLength,@lMask[j]); + {$ENDIF} + lLast:=TMaskOpCode.Range; + + end else if lMask[j]=']' then begin + if lLast=TMaskOpCode.CharsGroupBegin then begin + //Error empty match + Exception_InvalidCharMask(lMask[j],j); + end; + // Insert the new offset in case of a positive match in CharsGroup + PInteger(@cMaskCompiled[lCharsGroupInsertSize])^:=cMaskCompiledIndex; + Add(TMaskOpCode.CharsGroupEnd); + lLast:=TMaskOpCode.CharsGroupEnd; + break; + end else begin + Add(TMaskOpCode.OptionalChar); + Add(lCPLength,@lMask[j]); + lLast:=TMaskOpCode.OptionalChar; + end; + inc(j,lCPLength); + end; + if j>cMaskLimit then begin + Exception_MissingCloseChar(']',cMaskLimit); + end; + end else begin + Add(TMaskOpCode.Literal); + Add(lCPLength,@lMask[j]); + inc(cMatchMinimumLiteralBytes,lCPLength); + if cMatchMaximumLiteralBytes0 then exit; + inc(l); + end; + Result:=l1-l2; +end; + +function TMaskUTF8.intfMatches(aMatchOffset: integer; aMaskIndex: integer): TMaskFailCause; +var + c1,c2: PChar; + lFailCause: TMaskFailCause; + lNegateCharGroup: Boolean; + lSkipOnSuccessGroup: integer; + t1: Boolean; + j: integer; + lTryCounter: integer; +begin + lSkipOnSuccessGroup:=0; + Result:=UnexpectedEnd; + lNegateCharGroup:=false; + while aMaskIndex<=cMaskCompiledLimit do begin + case TMaskOpCode(cMaskCompiled[aMaskIndex]) of + TMaskOpCode.Literal: begin - if (moCaseSensitive in fOptions) then - Last := CP[1] - else - Last := LowerCase(CP[1]); - Include(CharSet, Last); - Inc(I); + if aMatchOffset>cMatchStringLimit then begin + // Error, no char to match. + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + inc(aMaskIndex); + if CompareUTF8Sequences(@cMaskCompiled[aMaskIndex],@cMatchString[aMatchOffset])<>0 then begin + Result:=TMaskFailCause.MaskNotMatch; + Exit; + end; + inc(aMaskIndex,UTF8CodepointSizeFast(@cMaskCompiled[aMaskIndex])); + inc(aMatchOffset,UTF8CodepointSizeFast(@cMatchString[aMatchOffset])); + end; + TMaskOpCode.AnyChar: + begin + inc(aMaskIndex); + if aMatchOffset>cMatchStringLimit then begin + // Error, no char to match. + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + inc(aMatchOffset,UTF8CodepointSizeFast(@cMatchString[aMatchOffset])); + end; + TMaskOpCode.Negate: + begin + lNegateCharGroup:=true; + inc(aMaskIndex); + end; + TMaskOpCode.CharsGroupBegin: + begin + lNegateCharGroup:=false; + inc(aMaskIndex); + lSkipOnSuccessGroup:=PInteger(@cMaskCompiled[aMaskIndex])^; + inc(aMaskIndex,sizeof(integer)); + end; + TMaskOpCode.CharsGroupEnd: + begin + if lNegateCharGroup then begin + aMaskIndex:=lSkipOnSuccessGroup+1; + inc(aMatchOffset,UTF8CodepointSizeFast(@cMatchString[aMatchOffset])); + end else begin + Result:=TMaskFailCause.MaskNotMatch; + exit; + end; + end; + TMaskOpCode.OptionalChar: + begin + inc(aMaskIndex); + if aMatchOffset>cMatchStringLimit then begin + // Error, no char to match. + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + if CompareUTF8Sequences(@cMaskCompiled[aMaskIndex],@cMatchString[aMatchOffset])=0 then begin + if lNegateCharGroup then begin + Result:=TMaskFailCause.MaskNotMatch; + exit; + end; + aMaskIndex:=lSkipOnSuccessGroup+1; + inc(aMatchOffset,UTF8CodepointSizeFast(@cMatchString[aMatchOffset])); + end else begin + inc(aMaskIndex,UTF8CodepointSizeFast(@cMaskCompiled[aMaskIndex])); + end; + end; + TMaskOpCode.Range: + begin + if aMatchOffset>cMatchStringLimit then begin + // Error, no char to match. + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + inc(aMaskIndex); + c1:=@cMaskCompiled[aMaskIndex]; + inc(aMaskIndex,UTF8CodepointSizeFast(C1)); + c2:=@cMaskCompiled[aMaskIndex]; + inc(aMaskIndex,UTF8CodepointSizeFast(C2)); + t1:=(CompareUTF8Sequences(@cMatchString[aMatchOffset],c1)>=0) and + (CompareUTF8Sequences(@cMatchString[aMatchOffset],c2)<=0); + if t1 then begin + if not lNegateCharGroup then begin + //Jump to CharsGroupEnd+1 because if CharsGroupEnd is reached + //it means that all optional chars and ranges have not matched the string. + aMaskIndex:=lSkipOnSuccessGroup+1; + inc(aMatchOffset,UTF8CodepointSizeFast(@cMatchString[aMatchOffset])); + end else begin + Result:=TMaskFailCause.MaskNotMatch; + exit; + end; + end + end; + TMaskOpCode.AnyCharToNext: + begin + // if last is "*", everything in remain data matches + if aMaskIndex=cMaskCompiledLimit then begin + Result:=TMaskFailCause.Success; + exit; + end; + if aMatchOffset>cMatchStringLimit then begin + if aMaskIndex=cMaskCompiledLimit then begin + Result:=TMaskFailCause.Success; + exit; + end; + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + inc(aMaskIndex); + while aMatchOffset<=cMatchStringLimit do begin + lFailCause:=intfMatches(aMatchOffset,aMaskIndex); + if lFailCause=TMaskFailCause.Success then begin + Result:=TMaskFailCause.Success; + exit; + end else if lFailCause=TMaskFailCause.MatchStringExhausted then begin + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + inc(aMatchOffset,UTF8CodepointSizeFast(@cMatchString[aMatchOffset])); + end; + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + TMaskOpCode.AnyCharOrNone: + begin + inc(aMaskIndex); + lTryCounter:=PInteger(@cMaskCompiled[aMaskIndex])^; + inc(aMaskIndex,sizeof(integer)); + if TMaskOpCode(cMaskCompiled[aMaskIndex])<>TMaskOpCode.CharsGroupEnd then begin + Exception_InternalError(); + end else begin + aMaskIndex:=lSkipOnSuccessGroup+1; + end; + + // Try to match remain mask eating, 0,1,2,...,lTryCounter chars. + for j := 0 to lTryCounter do begin + if aMatchOffset>cMatchStringLimit then begin + if aMaskIndex=cMaskCompiledLimit+1 then begin + Result:=TMaskFailCause.Success; + exit; + end; + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + lFailCause:=intfMatches(aMatchOffset,aMaskIndex); + if lFailCause=TMaskFailCause.Success then begin + Result:=TMaskFailCause.Success; + exit; + end else if lFailCause=TMaskFailCause.MatchStringExhausted then begin + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + inc(aMatchOffset,UTF8CodepointSizeFast(@cMatchString[aMatchOffset])); + end; + Result:=TMaskFailCause.MatchStringExhausted; + exit; + end; + else + begin + Exception_InternalError(); + end; + end; + end; + if (aMaskIndex>cMaskCompiledLimit) and (aMatchOffset>cMatchStringLimit) then begin + Result:=TMaskFailCause.Success; + end else begin + if aMaskIndex>cMaskCompiledLimit then begin + Result:=TMaskFailCause.MaskExhausted; + end else begin + Result:=TMaskFailCause.MatchStringExhausted; + end; + end; +end; + +constructor TMaskUTF8.Create(const aMask: RawByteString; aCaseSensitive: Boolean); +begin + inherited Create(aCaseSensitive); + cOriginalMask:=aMask; +end; + +constructor TMaskUTF8.CreateAdvanced(const aMask: RawByteString; + aCaseSensitive: Boolean; aOpcodesAllowed: TMaskOpcodesSet); +begin + inherited CreateAdvanced(aCaseSensitive,aOpcodesAllowed); + cOriginalMask:=aMask; +end; + +function TMaskUTF8.Matches(const aStringToMatch: RawByteString): Boolean; +begin + if not cMaskIsCompiled then Compile; + if cCaseSensitive then + cMatchString:=aStringToMatch + else + cMatchString:=UTF8LowerCase(aStringToMatch); + cMatchStringLimit:=length(cMatchString); + if (cMatchStringLimit>=cMatchMinimumLiteralBytes) + and (cMatchStringLimit<=cMatchMaximumLiteralBytes) then + Result:=intfMatches(1,0)=TMaskFailCause.Success + else + Result:=false; // There are too many or not enough bytes to match the string +end; + +{ TMaskWindows } + +class procedure TMaskUTF8Windows.SplitFileNameExtension( + const aSourceFileName: RawByteString; out aFileName: RawByteString; + out aExtension: RawByteString; aIsMask: Boolean); +var + j: Integer; + lLowLimit: integer; +begin + // Default values + aFileName:=aSourceFileName; + aExtension:=''; + + // This is because .foo is considered a file name ".foo" as one. + if aIsMask then begin + lLowLimit:=0; + end else begin + lLowLimit:=1; + end; + + j:=Length(aSourceFileName); + while j>lLowLimit do begin + if aSourceFileName[j]='.' then begin + aFileName:=copy(aSourceFileName,1,j-1); + aExtension:=copy(aSourceFileName,j); + break; + end; + dec(j); + end; +end; + +constructor TMaskUTF8Windows.Create(const aMask: RawByteString; aCaseSensitive: Boolean); +begin + CreateAdvanced(aMask,aCaseSensitive,WindowsQuirksDefaultAllowed); + Compile; +end; + +constructor TMaskUTF8Windows.CreateAdvanced(const aMask: RawByteString; + aCaseSensitive: Boolean; aWindowsQuirksAllowed: TWindowsQuirkSet); +begin + cMaskWindowsQuirkAllowed:=aWindowsQuirksAllowed; + cWindowsMask:=aMask; + inherited CreateAdvanced(aMask,aCaseSensitive,MaskOpCodesAllAllowed); +end; + +procedure TMaskUTF8Windows.Compile; + + function OptionalQMarksAtEnd(aMask: RawByteString): RawByteString; + var + lCounter: integer; + k: integer; + begin + lCounter:=0; + for k := Length(aMask) downto 1 do begin + if aMask[k]='?' then begin + inc(lCounter); + end else begin + break; + end; + end; + if lCounter>0 then begin + aMask:=copy(aMask,1,Length(aMask)-lCounter)+'['+StringOfChar('?',lCounter)+']'; + end; + Result:=aMask; + end; + + function EscapeSpecialChars(const aString: RawByteString): RawByteString; + var + j: integer; + begin + Result:=aString; + for j := Length(Result) downto 1 do begin + if Result[j] in ['[',']',cMaskEscapeChar] then begin + // Escape the []\ chars as in Windows mask mode they are plain chars. + insert(cMaskEscapeChar,Result,j); + end; + end; + end; + +var + lFileNameMask: RawByteString; + lExtensionMask: RawByteString; + lModifiedMask: RawByteString; + +begin + lModifiedMask:=cWindowsMask; + + // Quirk "blah.*" = "blah*" + if eWindowsQuirk_AnyExtension in cMaskWindowsQuirkAllowed then begin + if RightStr(lModifiedMask,3)='*.*' then begin + lModifiedMask:=copy(lModifiedMask,1,Length(lModifiedMask)-2); + cMaskWindowsQuirkInUse:=cMaskWindowsQuirkInUse+[eWindowsQuirk_AnyExtension]; + end; + end; + + SplitFileNameExtension(lModifiedMask,lFileNameMask,lExtensionMask,true); + + // Quirk "blah.abc" = "blah.abc*" + if eWindowsQuirk_Extension3More in cMaskWindowsQuirkAllowed then begin + if (Length(lExtensionMask)=4) and (Length(lFileNameMask)>0) then begin + lExtensionMask:=lExtensionMask+'*'; + cMaskWindowsQuirkInUse:=cMaskWindowsQuirkInUse+[eWindowsQuirk_Extension3More]; + end; + end; + + // Quirk "" = "*" + if (Length(lFileNameMask)=0) and (Length(lExtensionMask)=0) then begin + if eWindowsQuirk_EmptyIsAny in cMaskWindowsQuirkAllowed then begin + lFileNameMask:='*'; + cMaskWindowsQuirkInUse:=cMaskWindowsQuirkInUse+[eWindowsQuirk_EmptyIsAny]; + end; + end else begin + // Quirk ".abc" + if eWindowsQuirk_AllByExtension in cMaskWindowsQuirkAllowed then begin + if (Length(lFileNameMask)=0) and (length(lExtensionMask)>0) then begin + if lExtensionMask[1]='.' then begin + lFileNameMask:='*'; + cMaskWindowsQuirkInUse:=cMaskWindowsQuirkInUse+[eWindowsQuirk_AllByExtension]; end; end; end; - if (not Valid) or (CharSet = []) then CharSetError; - - New(FMask.Chars[High(FMask.Chars)].SetValue); - FMask.Chars[High(FMask.Chars)].SetValue^ := CharSet; - - Inc(FMask.MinLength); - if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength); - - Inc(I); end; - procedure AddChar; - begin - SkipAnyText := False; + lFileNameMask:=EscapeSpecialChars(lFileNameMask); + lExtensionMask:=EscapeSpecialChars(lExtensionMask); - SetLength(FMask.Chars, Length(FMask.Chars) + 1); - with FMask.Chars[High(FMask.Chars)] do - begin - CharType := mcChar; - if (moCaseSensitive in fOptions) then - CharValue := GetCodePoint(AValue,I) - else - CharValue := Utf8LowerCase(GetCodePoint(AValue,I)); - end; - - Inc(FMask.MinLength); - if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength); - - Inc(I); + // Quirk "file???.ab?" matches "file1.ab1" and "file123.ab" + if eWindowsQuirk_FilenameEnd in cMaskWindowsQuirkAllowed then begin + lFileNameMask:=OptionalQMarksAtEnd(lFileNameMask); + lExtensionMask:=OptionalQMarksAtEnd(lExtensionMask); end; -begin - SetLength(FMask.Chars, 0); - FMask.MinLength := 0; - FMask.MaxLength := 0; - SkipAnyText := False; - - I := 1; - while I <= Utf8Length(AValue) do - begin - case GetCodePoint(AValue,I) of - '*': AddAnyText; - '?': AddAnyChar; - '[': begin - if not (moDisableSets in FOptions) then - AddCharSet - else - AddChar; - end - else AddChar; + if eWindowsQuirk_NoExtension in cMaskWindowsQuirkAllowed then begin + if Length(lExtensionMask)=1 then begin + cMaskWindowsQuirkInUse:=[eWindowsQuirk_NoExtension]; + lExtensionMask:=''; end; end; + + inherited Mask:=lFileNameMask+lExtensionMask; + inherited Compile; end; -procedure TMask.ClearMaskString; +function TMaskUTF8Windows.Matches(const aFileName: RawByteString): Boolean; var - I: Integer; + lFileName, lExtension: RawByteString; begin - for I := 0 to High(FMask.Chars) do - if FMask.Chars[I].CharType = mcCharSet then - Dispose(FMask.Chars[I].SetValue); -end; - -constructor TMask.Create(const AValue: String; const AOptions: TMaskOptions); -begin - fInitialMask := AValue; - fOptions := AOptions; - InitMaskString(AValue); -end; - -constructor TMask.Create(const AValue: String; const CaseSensitive: Boolean); - -begin - if CaseSensitive then - Create(AValue, [moCaseSensitive]) - else - Create(AValue, []); -end; - -destructor TMask.Destroy; -begin - ClearMaskString; - inherited Destroy; -end; - -function TMask.Matches(const AFileName: String): Boolean; -var - L: Integer; - S: String; - - function MatchToEnd(MaskIndex, CharIndex: Integer): Boolean; - var - I, J: Integer; - CP: TUtf8Char; - begin - Result := False; - - for I := MaskIndex to High(FMask.Chars) do - begin - case FMask.Chars[I].CharType of - mcChar: - begin - if CharIndex > L then Exit; - //DebugLn('Match ' + S[CharIndex] + '' + FMask.Chars[I].CharValue); - if GetCodePoint(S,CharIndex) <> FMask.Chars[I].CharValue then Exit; - Inc(CharIndex); - end; - mcCharSet: - begin - if CharIndex > L then Exit; - CP := GetCodePoint(S, CharIndex); - //There are only 1-byte codepoints in charsets - if (Length(CP) <> 1) then Exit; - if FMask.Chars[I].Negative xor - (Cp[1] in FMask.Chars[I].SetValue^) then Inc(CharIndex) - else Exit; - end; - mcAnyChar: - begin - //CP := GetCodePoint(S, CharIndex); - //writeln('mcAnyChar: CP = ',UTF8ToConsole(CP),' CharIndex = ',CharIndex); - if CharIndex > L then Exit; - Inc(CharIndex); - end; - mcAnyText: - begin - if I = High(FMask.Chars) then - begin - Result := True; - Exit; - end; - - for J := CharIndex to L do - if MatchToEnd(I + 1, J) then - begin - Result := True; - Exit; - end; - end; - end; - end; - - Result := CharIndex > L; + if eWindowsQuirk_NoExtension in cMaskWindowsQuirkInUse then begin + SplitFileNameExtension(aFileName,lFileName,lExtension,false); + // eWindowsQuirk_NoExtension = Empty extension + if lExtension<>'' then exit(false); end; - -begin - Result := False; - L := Utf8Length(AFileName); - if L = 0 then - begin - if FMask.MinLength = 0 then Result := True; - Exit; - end; - - if (L < FMask.MinLength) or (L > FMask.MaxLength) then Exit; - if (moCaseSensitive in fOptions) then - //if fCaseSensitive then - S := AFileName - else - begin - S := Utf8LowerCase(AFileName); - L := Utf8Length(S); - end; - Result := MatchToEnd(0, 1); + Result:=Inherited Matches(aFileName); end; -function TMask.MatchesWindowsMask(const AFileName: String): Boolean; -var - NewMaskValue, Ext: String; -begin - // treat initial mask differently for special cases: - // foo*.* -> foo* - // foo*. -> match foo*, but muts not have an extension - // *. -> any file without extension ( .foo is a filename without extension according to Windows) - // foo. matches only foo but not foo.txt - // foo.* -> match either foo or foo.* - - if (Utf8Length(fInitialMask) > 2) and (Utf8RightStr(fInitialMask,3) = '*.*') then - // foo*.* - begin - NewMaskValue := Utf8Copy(fInitialMask,1,Utf8Length(fInitialMask)-2); - ClearMaskString; - InitMaskString(NewMaskValue); - Result := Matches(AFileName); - //Restore initial state of FMask - ClearMaskString; - InitMaskString(fInitialMask); - end - //else if (Length(fInitialMask) > 1) and (RightStr(fInitialMask,2) = '*.') then - else if (Utf8Length(fInitialMask) > 1) and (GetCodePoint(fInitialMask,Utf8Length(fInitialMask)) = '.') then - - //foo*. or *. or foo. - begin - //if AFileName has an extension then Result is False, otherwise see if it matches foo*/foo - //a filename like .foo under Windows is considered to be a file without an extension - Ext := ExtractFileExt(AFileName); - if (Ext = '') or (Ext = AFileName) then - begin - NewMaskValue := Utf8Copy(fInitialMask,1,Utf8Length(fInitialMask)-1); - ClearMaskString; - InitMaskString(NewMaskValue); - Result := Matches(AFileName); - //Restore initial state of FMask - ClearMaskString; - InitMaskString(fInitialMask); - end - else - begin - Result := False; - end; - end - else if (Utf8Length(fInitialMask) > 2) and (Utf8RightStr(fInitialMask,2) = '.*') then - //foo.* (but not '.*') - begin - //First see if we have 'foo' - if (moCaseSensitive in fOptions) then - //if fCaseSensitive then - Result := (AFileName = Utf8Copy(fInitialMask,1,Utf8Length(fInitialMask)-2)) - else - Result := (Utf8CompareText(AFileName,Utf8Copy(fInitialMask,1,Utf8Length(fInitialMask)-2)) = 0); - if not Result then Result := Matches(AFileName); - end - else - //all other cases just call Matches() - begin - Result := Matches(AFileName); - end; -end; { TParseStringList } @@ -565,34 +1034,24 @@ var I, S: Integer; begin inherited Create; - S := 1; for I := 1 to Length(AText) do begin if Pos(AText[I], ASeparators) > 0 then begin - if I > S then Add(Copy(AText, S, I - S)); + if I > S then + Add(Copy(AText, S, I - S)); S := I + 1; end; end; - - if Length(AText) >= S then Add(Copy(AText, S, Length(AText) - S + 1)); + if Length(AText) >= S then + Add(Copy(AText, S, Length(AText) - S + 1)); end; { TMaskList } -function TMaskList.GetItem(Index: Integer): TMask; -begin - Result := TMask(FMasks.Items[Index]); -end; - - -function TMaskList.GetCount: Integer; -begin - Result := FMasks.Count; -end; - -constructor TMaskList.Create(const AValue: String; ASeparator: Char; const AOptions: TMaskOptions); +constructor TMaskList.Create(const AValue: String; ASeparator: Char; + CaseSensitive: Boolean; aOpcodesAllowed: TMaskOpcodesSet); var S: TParseStringList; I: Integer; @@ -601,33 +1060,57 @@ begin S := TParseStringList.Create(AValue, ASeparator); try for I := 0 to S.Count - 1 do - FMasks.Add(TMask.Create(S[I], AOptions)); + FMasks.Add(TMask.CreateAdvanced(S[I], CaseSensitive, aOpcodesAllowed)); finally S.Free; end; end; -constructor TMaskList.Create(const AValue: String; ASeparator: Char; const CaseSensitive: Boolean); +constructor TMaskList.CreateWindows(const AValue: String; ASeparator: Char; CaseSensitive: Boolean); +var + S: TParseStringList; + I: Integer; begin - if CaseSensitive then - Create(AValue, ASeparator, [moCaseSensitive]) - else - Create(AValue, ASeparator, []); + FMasks := TObjectList.Create(True); + S := TParseStringList.Create(AValue, ASeparator); + try + for I := 0 to S.Count - 1 do + FMasks.Add(TMaskWindows.Create(S[I], CaseSensitive)); + finally + S.Free; + end; +end; + +constructor TMaskList.CreateSysNative(const AValue: String; ASeparator: Char; CaseSensitive: Boolean); +begin + {$IFDEF Windows} + CreateWindows(AValue, ASeparator, CaseSensitive); + {$ELSE} + Create(AValue, ASeparator, CaseSensitive); + {$ENDIF} end; destructor TMaskList.Destroy; begin FMasks.Free; - inherited Destroy; end; +function TMaskList.GetItem(Index: Integer): TMask; +begin + Result := TMask(FMasks.Items[Index]); +end; + +function TMaskList.GetCount: Integer; +begin + Result := FMasks.Count; +end; + function TMaskList.Matches(const AFileName: String): Boolean; var I: Integer; begin Result := False; - for I := 0 to FMasks.Count - 1 do begin if TMask(FMasks.Items[I]).Matches(AFileName) then @@ -639,19 +1122,16 @@ begin end; function TMaskList.MatchesWindowsMask(const AFileName: String): Boolean; -var - I: Integer; +//var +// mlw: TMaskList; begin - Result := False; - +{ Result := False; Original code for I := 0 to FMasks.Count - 1 do - begin if TMask(FMasks.Items[I]).MatchesWindowsMask(AFileName) then - begin - Result := True; - Exit; - end; - end; + Exit(True); +} + //mlw := TMaskList.CreateWindows(AFileName); + raise Exception.Create('Create with TMaskList.CreateWindows, then call Matches.'); end; end. diff --git a/lcl/shellctrls.pas b/lcl/shellctrls.pas index d9d6ffce12..2a8408216d 100644 --- a/lcl/shellctrls.pas +++ b/lcl/shellctrls.pas @@ -687,12 +687,11 @@ procedure GetFilesInDir(const ABaseDir: string; AMask: string; var DirInfo: TSearchRec; FindResult, i: Integer; - IsDirectory, IsValidDirectory, IsHidden, AddFile, UseMaskList: Boolean; + IsDirectory, IsValidDirectory, IsHidden, AddFile, UseMaskList, CaseSens: Boolean; SearchStr, ShortFilename: string; MaskList: TMaskList = nil; Files: TList; FileItem: TFileItem; - MaskOptions: TMaskOptions; {$if defined(windows) and not defined(wince)} ErrMode : LongWord; {$endif} @@ -718,19 +717,16 @@ begin ; if UseMaskList then begin - //Disable the use of sets in the masklist. - //this behaviour would be incompatible with the situation if no MaskList was used - //and it would break backwards compatibilty and could raise unexpected EConvertError where it did not in the past. - //If you need sets in the MaskList, use the OnAddItem event for that. (BB) - MaskOptions := [moDisableSets]; + // Disable ranges in the MaskList. [...] is interpreted as literal chars. + // Otherwise this would be incompatible with the situation if no MaskList was used + // and would break backwards compatibilty and could raise unexpected EConvertError. + // If you need ranges in the MaskList, use the OnAddItem event for that. (BB) {$ifdef NotLiteralFilenames} - if (ACaseSensitivity = mcsCaseSensitive) then - MaskOptions := [moDisableSets, moCaseSensitive]; + CaseSens := ACaseSensitivity = mcsCaseSensitive; {$else} - if (ACaseSensitivity <> mcsCaseInsensitive) then - MaskOptions := [moDisableSets, moCaseSensitive]; + CaseSens := ACaseSensitivity <> mcsCaseInsensitive; {$endif} - MaskList := TMaskList.Create(AMask, ';', MaskOptions); //False by default + MaskList := TMaskList.Create(AMask, ';', CaseSens, MaskOpCodesDisableRange); end; try