├── .github ├── FUNDING.yml ├── ISSUE_TEMPLATE │ ├── bug_report.md │ └── feature_request.md ├── dependabot.yml └── workflows │ ├── make.pas │ └── make.yml ├── .gitignore ├── LICENSE ├── PatternFinder.Console.Tests ├── Delphi.Tests │ └── PatternFinder.Console.dpr ├── FreePascal.Tests │ ├── PatternFinder.Console.lpi │ └── PatternFinder.Console.lpr └── src │ └── PatternFinderConsoleTests.pas ├── PatternFinder └── src │ └── uPatternFinder.pas └── README.md /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: xor_el # Replace with a single Patreon username 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | otechie: # Replace with a single Otechie username 12 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | 5 | --- 6 | 7 | **Describe the bug** 8 | A clear and concise description of what the bug is. 9 | 10 | **To Reproduce** 11 | Steps to reproduce the behavior: 12 | 1. Go to '...' 13 | 2. Click on '....' 14 | 3. Scroll down to '....' 15 | 4. See error 16 | 17 | **Expected behavior** 18 | A clear and concise description of what you expected to happen. 19 | 20 | **Screenshots** 21 | If applicable, add screenshots to help explain your problem. 22 | 23 | **Environment (please complete the following information):** 24 | - OS: [e.g. Windows, Linux, Mac] 25 | - Compiler Version [e.g. FreePascal 3.0.0] 26 | - Package Version [e.g. 1.0] 27 | 28 | **Additional context** 29 | Add any other context about the problem here. 30 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | 5 | --- 6 | 7 | **Is your feature request related to a problem? Please describe.** 8 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 9 | 10 | **Describe the solution you'd like** 11 | A clear and concise description of what you want to happen. 12 | 13 | **Describe alternatives you've considered** 14 | A clear and concise description of any alternative solutions or features you've considered. 15 | 16 | **Additional context** 17 | Add any other context or screenshots about the feature request here. 18 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | --- 2 | version: 2 3 | updates: 4 | - package-ecosystem: "github-actions" 5 | directory: "/" 6 | schedule: 7 | interval: "monthly" 8 | -------------------------------------------------------------------------------- /.github/workflows/make.pas: -------------------------------------------------------------------------------- 1 | program Make; 2 | {$mode objfpc}{$H+} 3 | 4 | uses 5 | Classes, 6 | SysUtils, 7 | StrUtils, 8 | FileUtil, 9 | Zipper, 10 | fphttpclient, 11 | RegExpr, 12 | openssl, 13 | opensslsockets, 14 | Process; 15 | 16 | const 17 | Target: string = 'PatternFinder.Console.Tests'; 18 | Dependencies: array of string = (); 19 | 20 | type 21 | TLog = (audit, info, error); 22 | 23 | Output = record 24 | Success: boolean; 25 | Output: string; 26 | end; 27 | 28 | procedure OutLog(const Knd: TLog; const Msg: string); 29 | begin 30 | case Knd of 31 | error: Writeln(stderr, #27'[31m', Msg, #27'[0m'); 32 | info: Writeln(stderr, #27'[32m', Msg, #27'[0m'); 33 | audit: Writeln(stderr, #27'[33m', Msg, #27'[0m'); 34 | end; 35 | end; 36 | 37 | function CheckModules: string; 38 | begin 39 | if FileExists('.gitmodules') then 40 | if RunCommand('git', ['submodule', 'update', '--init', '--recursive', 41 | '--force', '--remote'], Result) then 42 | OutLog(info, Result) 43 | else 44 | OutLog(error, Result); 45 | end; 46 | 47 | function AddPackage(const Path: string): string; 48 | begin 49 | if RunCommand('lazbuild', ['--add-package-link', Path], Result) then 50 | OutLog(audit, 'Add package:'#9 + Path); 51 | end; 52 | 53 | function SelectString(const Input, Reg: string): string; 54 | var 55 | Line: string; 56 | begin 57 | Result := ' '; 58 | for Line in Input.Split(LineEnding) do 59 | with TRegExpr.Create do 60 | begin 61 | Expression := Reg; 62 | if Exec(Line) then 63 | Result += Line + LineEnding; 64 | Free; 65 | end; 66 | end; 67 | 68 | function RunTest(const Path: String): string; 69 | begin 70 | OutLog(audit, #9'run:'#9 + Path); 71 | if RunCommand(Path, ['--all', '--format=plain'], Result) then 72 | OutLog(info, #9'success!') 73 | else 74 | ExitCode += 1; 75 | OutLog(audit, Result); 76 | end; 77 | 78 | function BuildProject(const Path: string): Output; 79 | begin 80 | OutLog(audit, 'Build from:'#9 + Path); 81 | Result.Success := RunCommand('lazbuild', 82 | ['--build-all', '--recursive', '--no-write-project', Path], Result.Output); 83 | Result.Output := SelectString(Result.Output, '(Fatal:|Error:|Linking)'); 84 | if Result.Success then 85 | begin 86 | Result.Output := Result.Output.Split(' ')[3].Replace(LineEnding, ''); 87 | OutLog(info, #9'to:'#9 + Result.Output); 88 | if ContainsStr(ReadFileToString(Path.Replace('.lpi', '.lpr')), 'consoletestrunner') then 89 | RunTest(Result.Output.Replace(#10, '')); 90 | end 91 | else 92 | begin 93 | ExitCode += 1; 94 | OutLog(error, Result.Output); 95 | end; 96 | end; 97 | 98 | function DownloadFile(const Uri: string): string; 99 | var 100 | OutFile: TStream; 101 | begin 102 | InitSSLInterface; 103 | Result := GetTempFileName; 104 | OutFile := TFileStream.Create(Result, fmCreate or fmOpenWrite); 105 | with TFPHttpClient.Create(nil) do 106 | begin 107 | try 108 | AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)'); 109 | AllowRedirect := True; 110 | Get(Uri, OutFile); 111 | OutLog(audit, 'Download from ' + Uri + ' to ' + Result); 112 | finally 113 | Free; 114 | OutFile.Free; 115 | end; 116 | end; 117 | end; 118 | 119 | procedure UnZip(const ZipFile, ZipPath: string); 120 | begin 121 | with TUnZipper.Create do 122 | begin 123 | try 124 | FileName := ZipFile; 125 | OutputPath := ZipPath; 126 | Examine; 127 | UnZipAllFiles; 128 | OutLog(audit, 'Unzip from'#9 + ZipFile + #9'to'#9 + ZipPath); 129 | DeleteFile(ZipFile); 130 | finally 131 | Free; 132 | end; 133 | end; 134 | end; 135 | 136 | function InstallOPM(const Path: string): string; 137 | begin 138 | Result := 139 | {$IFDEF MSWINDOWS} 140 | GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\' 141 | {$ELSE} 142 | GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/' 143 | {$ENDIF} 144 | + Path; 145 | if not DirectoryExists(Result) then 146 | begin 147 | CreateDir(Result); 148 | UnZip(DownloadFile('https://packages.lazarus-ide.org/' + Path + '.zip'), Result); 149 | end; 150 | end; 151 | 152 | function BuildAll: string; 153 | var 154 | List: TStringList; 155 | begin 156 | CheckModules; 157 | List := FindAllFiles(GetCurrentDir, '*.lpk', True); 158 | try 159 | for Result in Dependencies do 160 | List.AddStrings(FindAllFiles(InstallOPM(Result), '*.lpk', True)); 161 | for Result in List do 162 | AddPackage(Result); 163 | List := FindAllFiles(Target, '*.lpi', True); 164 | for Result in List do 165 | BuildProject(Result); 166 | finally 167 | List.Free; 168 | end; 169 | case ExitCode of 170 | 0: OutLog(info, 'Errors:'#9 + IntToStr(ExitCode)); 171 | else 172 | OutLog(error, 'Errors:'#9 + IntToStr(ExitCode)); 173 | end; 174 | end; 175 | 176 | begin 177 | try 178 | BuildAll 179 | except 180 | on E: Exception do 181 | Writeln(E.ClassName, #9, E.Message); 182 | end; 183 | end. 184 | -------------------------------------------------------------------------------- /.github/workflows/make.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: Make 3 | 4 | on: 5 | schedule: 6 | - cron: '0 0 1 * *' 7 | push: 8 | branches: 9 | - "**" 10 | pull_request: 11 | branches: 12 | - master 13 | - main 14 | 15 | concurrency: 16 | group: ${{ github.workflow }}-${{ github.ref }} 17 | cancel-in-progress: true 18 | 19 | jobs: 20 | build: 21 | runs-on: ${{ matrix.os }} 22 | timeout-minutes: 120 23 | strategy: 24 | matrix: 25 | os: 26 | - ubuntu-latest 27 | - windows-latest 28 | 29 | steps: 30 | - name: Checkout 31 | uses: actions/checkout@v4 32 | with: 33 | submodules: true 34 | 35 | - name: Build on Linux 36 | if: runner.os == 'Linux' 37 | shell: bash 38 | run: | 39 | set -xeuo pipefail 40 | sudo bash -c 'apt-get update; apt-get install -y lazarus' >/dev/null 41 | instantfpc -Fu/usr/lib/lazarus/*/components/lazutils \ 42 | -B '.github/workflows/make.pas' 43 | 44 | - name: Build on Windows 45 | if: runner.os == 'Windows' 46 | shell: powershell 47 | run: | 48 | $ErrorActionPreference = 'stop' 49 | Set-PSDebug -Strict 50 | New-Variable -Option Constant -Name VAR -Value @{ 51 | Uri = 52 | 'https://fossies.org/windows/misc/lazarus-3.8-fpc-3.2.2-win64.exe' 53 | OutFile = (New-TemporaryFile).FullName + '.exe' 54 | } 55 | Invoke-WebRequest @VAR 56 | & $VAR.OutFile.Replace('Temp', 'Temp\.') /SP- /VERYSILENT /NORESTART ` 57 | /SUPPRESSMSGBOXES | Out-Null 58 | $Env:PATH+=';C:\Lazarus' 59 | $Env:PATH+=';C:\Lazarus\fpc\3.2.2\bin\x86_64-win64' 60 | 'lazbuild', 'instantfpc' | % { (Get-Command $_).Source } | Out-Host 61 | instantfpc -FuC:\Lazarus\components\lazutils ` 62 | -B '.github/workflows/make.pas' 63 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Ugochukwu Mmaduekwe 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /PatternFinder.Console.Tests/Delphi.Tests/PatternFinder.Console.dpr: -------------------------------------------------------------------------------- 1 | program PatternFinder.Console; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | SysUtils, 7 | PatternFinderConsoleTests in '..\src\PatternFinderConsoleTests.pas', 8 | uPatternFinder in '..\..\PatternFinder\src\uPatternFinder.pas'; 9 | 10 | begin 11 | try 12 | { TODO -oUser -cConsole Main : Insert code here } 13 | testProgram.Tests; 14 | testProgram.SignatureTest; 15 | ReadLn; 16 | except 17 | on E: Exception do 18 | Writeln(E.ClassName, ': ', E.Message); 19 | end; 20 | 21 | end. 22 | -------------------------------------------------------------------------------- /PatternFinder.Console.Tests/FreePascal.Tests/PatternFinder.Console.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <i18n> 18 | <EnableI18N LFM="False"/> 19 | </i18n> 20 | <VersionInfo> 21 | <StringTable ProductVersion=""/> 22 | </VersionInfo> 23 | <BuildModes Count="2"> 24 | <Item1 Name="Default" Default="True"/> 25 | <Item2 Name="Debug"> 26 | <CompilerOptions> 27 | <Version Value="11"/> 28 | <PathDelim Value="\"/> 29 | <Target> 30 | <Filename Value="PatternFinder.Console"/> 31 | </Target> 32 | <SearchPaths> 33 | <IncludeFiles Value="$(ProjOutDir)"/> 34 | <OtherUnitFiles Value="..\src;..\..\PatternFinder\src"/> 35 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 36 | </SearchPaths> 37 | <Parsing> 38 | <SyntaxOptions> 39 | <IncludeAssertionCode Value="True"/> 40 | </SyntaxOptions> 41 | </Parsing> 42 | <CodeGeneration> 43 | <Checks> 44 | <IOChecks Value="True"/> 45 | <RangeChecks Value="True"/> 46 | <OverflowChecks Value="True"/> 47 | <StackChecks Value="True"/> 48 | </Checks> 49 | </CodeGeneration> 50 | <Linking> 51 | <Debugging> 52 | <DebugInfoType Value="dsDwarf2Set"/> 53 | <UseHeaptrc Value="True"/> 54 | <UseExternalDbgSyms Value="True"/> 55 | </Debugging> 56 | </Linking> 57 | </CompilerOptions> 58 | </Item2> 59 | </BuildModes> 60 | <PublishOptions> 61 | <Version Value="2"/> 62 | </PublishOptions> 63 | <RunParams> 64 | <local> 65 | <FormatVersion Value="1"/> 66 | </local> 67 | </RunParams> 68 | <Units Count="3"> 69 | <Unit0> 70 | <Filename Value="PatternFinder.Console.lpr"/> 71 | <IsPartOfProject Value="True"/> 72 | </Unit0> 73 | <Unit1> 74 | <Filename Value="..\src\PatternFinderConsoleTests.pas"/> 75 | <IsPartOfProject Value="True"/> 76 | </Unit1> 77 | <Unit2> 78 | <Filename Value="..\..\PatternFinder\src\uPatternFinder.pas"/> 79 | <IsPartOfProject Value="True"/> 80 | </Unit2> 81 | </Units> 82 | </ProjectOptions> 83 | <CompilerOptions> 84 | <Version Value="11"/> 85 | <PathDelim Value="\"/> 86 | <Target> 87 | <Filename Value="PatternFinder.Console"/> 88 | </Target> 89 | <SearchPaths> 90 | <IncludeFiles Value="$(ProjOutDir)"/> 91 | <OtherUnitFiles Value="..\src;..\..\PatternFinder\src"/> 92 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 93 | </SearchPaths> 94 | </CompilerOptions> 95 | <Debugging> 96 | <Exceptions Count="3"> 97 | <Item1> 98 | <Name Value="EAbort"/> 99 | </Item1> 100 | <Item2> 101 | <Name Value="ECodetoolError"/> 102 | </Item2> 103 | <Item3> 104 | <Name Value="EFOpenError"/> 105 | </Item3> 106 | </Exceptions> 107 | </Debugging> 108 | </CONFIG> 109 | -------------------------------------------------------------------------------- /PatternFinder.Console.Tests/FreePascal.Tests/PatternFinder.Console.lpr: -------------------------------------------------------------------------------- 1 | program PatternFinder.Console; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | SysUtils, 7 | consoletestrunner, 8 | PatternFinderConsoleTests in '..\src\PatternFinderConsoleTests.pas', 9 | uPatternFinder in '..\..\PatternFinder\src\uPatternFinder.pas'; 10 | 11 | begin 12 | try 13 | { TODO -oUser -cConsole Main : Insert code here } 14 | testProgram.Tests; 15 | testProgram.SignatureTest; 16 | except 17 | on E: Exception do 18 | Writeln(E.ClassName, ': ', E.Message); 19 | end; 20 | end. 21 | 22 | -------------------------------------------------------------------------------- /PatternFinder.Console.Tests/src/PatternFinderConsoleTests.pas: -------------------------------------------------------------------------------- 1 | unit PatternFinderConsoleTests; 2 | 3 | interface 4 | 5 | uses 6 | SysUtils, 7 | uPatternFinder; 8 | 9 | type 10 | testProgram = class(TObject) 11 | 12 | public 13 | class procedure Tests; static; 14 | class procedure SignatureTest; static; 15 | end; 16 | 17 | implementation 18 | 19 | class procedure testProgram.Tests; 20 | var 21 | pattern: TPatternTByteArray; 22 | data1, data2, data3: TBytes; 23 | o1, o2, o3: Int64; 24 | begin 25 | pattern := TPattern.Transform('456?89?B'); 26 | data1 := TBytes.Create($01, $23, $45, $67, $89, $AB, $CD, $EF); 27 | 28 | if (not(TPattern.Find(data1, pattern, o1) and (o1 = 2))) then 29 | WriteLn('Test 1 failed...'); 30 | data2 := TBytes.Create($01, $23, $45, $66, $89, $6B, $CD, $EF); 31 | if (not(TPattern.Find(data2, pattern, o2) and (o2 = 2))) then 32 | WriteLn('Test 2 failed...'); 33 | data3 := TBytes.Create($11, $11, $11, $11, $11, $11, $11, $11); 34 | 35 | if (TPattern.Find(data3, pattern, o3)) then 36 | WriteLn('Test 3 failed...'); 37 | 38 | WriteLn('Done testing!'); 39 | end; 40 | 41 | class procedure testProgram.SignatureTest; 42 | var 43 | data: TBytes; 44 | signatures, result: TISignatureArray; 45 | sig1, sig2, sig3, sig4, signature: ISignature; 46 | 47 | begin 48 | data := TBytes.Create($01, $23, $45, $67, $89, $AB, $CD, $EF, $45, $65, 49 | $67, $89); 50 | sig1 := TSignature.Create('pattern1', '456?89?B'); 51 | sig2 := TSignature.Create('pattern2', '1111111111'); 52 | sig3 := TSignature.Create('pattern3', 'AB??EF'); 53 | sig4 := TSignature.Create('pattern4', '45??67'); 54 | signatures := TISignatureArray.Create(sig1, sig2, sig3, sig4); 55 | 56 | result := TSignatureFinder.Scan(data, signatures); 57 | for signature in result do 58 | begin 59 | WriteLn(Format('found %s at %d', [signature.Name, signature.FoundOffset])); 60 | 61 | end; 62 | 63 | end; 64 | 65 | end. 66 | -------------------------------------------------------------------------------- /PatternFinder/src/uPatternFinder.pas: -------------------------------------------------------------------------------- 1 | unit uPatternFinder; 2 | 3 | {$IFNDEF FPC} 4 | {$IF CompilerVersion >= 24} // XE3 and Above 5 | {$LEGACYIFEND ON} 6 | {$ZEROBASEDSTRINGS OFF} 7 | {$IFEND} 8 | // 9 | {$IF CompilerVersion >= 28} // XE7 and Above 10 | {$DEFINE SUPPORT_PARALLEL_PROGRAMMING} 11 | {$IFEND} 12 | {$ELSE} 13 | {$mode delphi} 14 | {$ZEROBASEDSTRINGS OFF} 15 | {$ENDIF FPC} 16 | 17 | interface 18 | 19 | uses 20 | SysUtils, 21 | {$IFDEF FPC} 22 | fgl 23 | {$ELSE} 24 | Generics.Collections 25 | {$ENDIF FPC} 26 | {$IFDEF SUPPORT_PARALLEL_PROGRAMMING}, 27 | Threading{$ENDIF}; 28 | 29 | // ================================================================== // 30 | 31 | type 32 | 33 | TPattern = class sealed(TObject) 34 | 35 | public 36 | 37 | type 38 | 39 | TByte = record 40 | 41 | strict private 42 | 43 | type 44 | TNibble = record 45 | 46 | private 47 | Wildcard: Boolean; 48 | Data: Byte; 49 | end; 50 | 51 | private 52 | N1, N2: TNibble; 53 | 54 | {$IFDEF FPC} 55 | class operator Equal(val1: TPattern.TByte; val2: TPattern.TByte): Boolean; 56 | 57 | {$ENDIF FPC} 58 | end; 59 | 60 | type 61 | TPatternTByte = TPattern.TByte; 62 | 63 | type 64 | TPatternTByteArray = array of TPatternTByte; 65 | 66 | public 67 | class function Format(const _pattern: String): String; static; 68 | class function Transform(_pattern: String): TPatternTByteArray; 69 | class function Find(Data: TBytes; _pattern: TPatternTByteArray): Boolean; 70 | overload; static; 71 | class function Find(Data: TBytes; _pattern: TPatternTByteArray; 72 | out offsetFound: Int64): Boolean; overload; static; 73 | 74 | strict private 75 | class function hexChToInt(ch: Char): Integer; static; 76 | class function matchByte(b: Byte; var p: TByte): Boolean; static; 77 | 78 | end; 79 | 80 | // ================================================================== // 81 | 82 | type 83 | TPatternTByteArray = TPattern.TPatternTByteArray; 84 | 85 | type 86 | 87 | ISignature = interface(IInterface) 88 | ['{26232742-3742-43C1-8E5C-032BE9B0F91B}'] 89 | 90 | function GetName: String; 91 | property Name: String read GetName; 92 | function GetPattern: TPatternTByteArray; 93 | property Pattern: TPatternTByteArray read GetPattern; 94 | function GetFoundOffset: Int64; 95 | procedure SetFoundOffset(value: Int64); 96 | property FoundOffset: Int64 read GetFoundOffset write SetFoundOffset; 97 | 98 | function ToString(): String; 99 | 100 | end; 101 | 102 | type 103 | 104 | TISignatureArray = array of ISignature; 105 | 106 | type 107 | 108 | TSignature = class sealed(TInterfacedObject, ISignature) 109 | 110 | strict private 111 | 112 | FName: String; 113 | FPattern: TPatternTByteArray; 114 | FFoundOffset: Int64; 115 | 116 | function GetName: String; 117 | property Name: String read GetName; 118 | function GetPattern: TPatternTByteArray; 119 | function GetFoundOffset: Int64; 120 | procedure SetFoundOffset(value: Int64); 121 | 122 | public 123 | constructor Create(const _name: String; 124 | _pattern: TPatternTByteArray); overload; 125 | constructor Create(const _name: String; const _pattern: string); overload; 126 | function ToString(): String; override; 127 | 128 | end; 129 | 130 | // ================================================================== // 131 | 132 | type 133 | TSignatureFinder = class sealed(TObject) 134 | 135 | public 136 | class function Scan(Data: TBytes; signatures: TISignatureArray) 137 | : TISignatureArray; static; 138 | end; 139 | 140 | {$IFDEF SUPPORT_PARALLEL_PROGRAMMING} 141 | 142 | var 143 | tsList: TThreadList<ISignature>; 144 | {$ENDIF} 145 | 146 | implementation 147 | 148 | // ================================================================== // 149 | 150 | class function TPattern.Format(const _pattern: String): String; 151 | var 152 | _length, i: Integer; 153 | tempRes: String; 154 | ch: Char; 155 | 156 | begin 157 | _length := Length(_pattern); 158 | tempRes := ''; 159 | for i := 0 to Pred(_length) do 160 | begin 161 | ch := _pattern[i + 1]; 162 | if (((ch >= '0') and (ch <= '9')) or ((ch >= 'A') and (ch <= 'F')) or 163 | ((ch >= 'a') and (ch <= 'f')) or (ch = '?')) then 164 | begin 165 | tempRes := tempRes + (ch); 166 | end; 167 | end; 168 | result := tempRes; 169 | 170 | end; 171 | 172 | class function TPattern.Transform(_pattern: String): TPatternTByteArray; 173 | var 174 | _length, i, j, k: Integer; 175 | 176 | tempRes: {$IFDEF FPC} TFPGList<TByte> {$ELSE} TList<TByte> {$ENDIF}; 177 | newbyte: TByte; 178 | ch: Char; 179 | b: TByte; 180 | 181 | begin 182 | _pattern := Format(_pattern); 183 | _length := Length(_pattern); 184 | if (_length = 0) then 185 | begin 186 | result := Nil; 187 | Exit; 188 | end; 189 | tempRes := {$IFDEF FPC} TFPGList<TByte> {$ELSE} TList<TByte> 190 | {$ENDIF}.Create(); 191 | tempRes.Capacity := (_length + 1) div 2; 192 | try 193 | 194 | if (_length mod 2 <> 0) then 195 | begin 196 | _pattern := _pattern + '?'; 197 | Inc(_length); 198 | end; 199 | newbyte := Default (TByte); 200 | i := 0; 201 | j := 0; 202 | while i < _length do 203 | 204 | begin 205 | ch := _pattern[i + 1]; 206 | if (ch = '?') then // wildcard 207 | begin 208 | if (j = 0) then 209 | newbyte.N1.Wildcard := true 210 | else 211 | newbyte.N2.Wildcard := true; 212 | end 213 | else // hex 214 | begin 215 | if (j = 0) then 216 | begin 217 | newbyte.N1.Wildcard := false; 218 | newbyte.N1.Data := Byte(hexChToInt(ch) and $F); 219 | end 220 | else 221 | begin 222 | newbyte.N2.Wildcard := false; 223 | newbyte.N2.Data := Byte(hexChToInt(ch) and $F); 224 | end; 225 | end; 226 | 227 | Inc(j); 228 | if (j = 2) then 229 | begin 230 | j := 0; 231 | tempRes.Add(newbyte); 232 | end; 233 | Inc(i); 234 | end; 235 | 236 | k := 0; 237 | SetLength(result, tempRes.Count); 238 | for b in tempRes do 239 | begin 240 | result[k] := b; 241 | Inc(k); 242 | end; 243 | finally 244 | tempRes.Free; 245 | end; 246 | 247 | end; 248 | 249 | class function TPattern.Find(Data: TBytes; 250 | _pattern: TPatternTByteArray): Boolean; 251 | var 252 | temp: Int64; 253 | begin 254 | result := Find(Data, _pattern, temp); 255 | end; 256 | 257 | class function TPattern.matchByte(b: Byte; var p: TByte): Boolean; 258 | var 259 | N1, N2: Integer; 260 | begin 261 | if (not p.N1.Wildcard) then // if not a wildcard we need to compare the data. 262 | begin 263 | N1 := b shr 4; 264 | if (N1 <> p.N1.Data) then // if the data is not equal b doesn't match p. 265 | begin 266 | result := false; 267 | Exit; 268 | end; 269 | end; 270 | if (not p.N2.Wildcard) then // if not a wildcard we need to compare the data. 271 | begin 272 | N2 := b and $F; 273 | if (N2 <> p.N2.Data) then // if the data is not equal b doesn't match p. 274 | begin 275 | result := false; 276 | Exit; 277 | end; 278 | end; 279 | result := true; 280 | end; 281 | 282 | class function TPattern.Find(Data: TBytes; _pattern: TPatternTByteArray; 283 | out offsetFound: Int64): Boolean; 284 | var 285 | patternSize, i, pos: Int64; 286 | begin 287 | offsetFound := -1; 288 | if ((Data = Nil) or (_pattern = Nil)) then 289 | begin 290 | result := false; 291 | Exit; 292 | end; 293 | patternSize := Length(_pattern); 294 | if ((Length(Data) = 0) or (patternSize = 0)) then 295 | begin 296 | result := false; 297 | Exit; 298 | end; 299 | 300 | i := 0; 301 | pos := 0; 302 | while i < Length(Data) do 303 | begin 304 | if (matchByte(Data[i], _pattern[pos])) then 305 | // check if the current data byte matches the current pattern byte 306 | begin 307 | Inc(pos); 308 | if (pos = patternSize) then // everything matched 309 | begin 310 | offsetFound := i - patternSize + 1; 311 | result := true; 312 | Exit; 313 | end 314 | end 315 | else // fix by Computer_Angel 316 | begin 317 | i := i - pos; 318 | pos := 0; // reset current pattern position 319 | end; 320 | 321 | Inc(i); 322 | end; 323 | 324 | result := false; 325 | end; 326 | 327 | class function TPattern.hexChToInt(ch: Char): Integer; 328 | begin 329 | if ((ch >= '0') and (ch <= '9')) then 330 | begin 331 | result := Ord(ch) - Ord('0'); 332 | Exit; 333 | end; 334 | if ((ch >= 'A') and (ch <= 'F')) then 335 | begin 336 | result := Ord(ch) - Ord('A') + 10; 337 | Exit; 338 | end; 339 | if ((ch >= 'a') and (ch <= 'f')) then 340 | begin 341 | result := Ord(ch) - Ord('a') + 10; 342 | Exit; 343 | end; 344 | result := -1; 345 | end; 346 | 347 | 348 | // ================================================================== // 349 | 350 | constructor TSignature.Create(const _name: String; 351 | _pattern: TPatternTByteArray); 352 | begin 353 | Inherited Create(); 354 | FName := _name; 355 | FPattern := _pattern; 356 | FFoundOffset := -1; 357 | end; 358 | 359 | constructor TSignature.Create(const _name: String; const _pattern: string); 360 | begin 361 | Inherited Create(); 362 | FName := _name; 363 | FPattern := TPattern.Transform(_pattern); 364 | FFoundOffset := -1; 365 | end; 366 | 367 | function TSignature.GetName: String; 368 | begin 369 | result := FName; 370 | end; 371 | 372 | function TSignature.GetPattern: TPatternTByteArray; 373 | begin 374 | result := FPattern; 375 | end; 376 | 377 | function TSignature.GetFoundOffset: Int64; 378 | begin 379 | result := FFoundOffset; 380 | end; 381 | 382 | procedure TSignature.SetFoundOffset(value: Int64); 383 | begin 384 | FFoundOffset := value; 385 | end; 386 | 387 | function TSignature.ToString(): String; 388 | begin 389 | result := Name; 390 | end; 391 | 392 | // ================================================================== // 393 | 394 | class function TSignatureFinder.Scan(Data: TBytes; signatures: TISignatureArray) 395 | : TISignatureArray; 396 | var 397 | {$IF NOT DEFINED (SUPPORT_PARALLEL_PROGRAMMING)} 398 | Idx, LengthArray: Int64; 399 | {$IFEND} 400 | found: {$IFDEF FPC} TFPGList<ISignature> {$ELSE} TList<ISignature> {$ENDIF}; 401 | tempOffset: Int64; 402 | sig: ISignature; 403 | j: Integer; 404 | 405 | begin 406 | 407 | {$IFDEF SUPPORT_PARALLEL_PROGRAMMING} 408 | tsList := TThreadList<ISignature>.Create; 409 | found := tsList.LockList; 410 | {$ELSE} 411 | found := {$IFDEF FPC} TFPGList<ISignature> {$ELSE} TList<ISignature> 412 | {$ENDIF}.Create; 413 | {$ENDIF} 414 | try 415 | {$IFDEF SUPPORT_PARALLEL_PROGRAMMING} 416 | TParallel.&For(0, Length(signatures) - 1, 417 | procedure(Idx: Int64) 418 | 419 | begin 420 | 421 | if (TPattern.Find(Data, signatures[Idx].Pattern, tempOffset)) then 422 | begin 423 | signatures[Idx].FoundOffset := tempOffset; 424 | found.Add(signatures[Idx]); 425 | end 426 | end); 427 | {$ELSE} 428 | Idx := 0; 429 | tempOffset := 0; 430 | LengthArray := Int64(Length(signatures)) - 1; 431 | 432 | while Idx <= LengthArray do 433 | 434 | begin 435 | 436 | if (TPattern.Find(Data, signatures[Idx].Pattern, tempOffset)) then 437 | begin 438 | signatures[Idx].FoundOffset := tempOffset; 439 | found.Add(signatures[Idx]); 440 | end; 441 | Inc(Idx); 442 | end; 443 | 444 | {$ENDIF} 445 | j := 0; 446 | SetLength(result, found.Count); 447 | for sig in found do 448 | begin 449 | result[j] := sig; 450 | Inc(j); 451 | end; 452 | 453 | finally 454 | {$IFDEF SUPPORT_PARALLEL_PROGRAMMING} 455 | tsList.UnlockList; 456 | tsList.Free; 457 | {$ELSE} 458 | found.Free; 459 | {$ENDIF} 460 | end; 461 | 462 | end; 463 | 464 | {$IFDEF FPC} 465 | { TPattern.TByte } 466 | 467 | class operator TPattern.TByte.Equal(val1, val2: TPattern.TByte): Boolean; 468 | begin 469 | result := (val1.N1.Wildcard = val2.N1.Wildcard) and 470 | (val1.N1.Data = val2.N1.Data) and (val1.N2.Wildcard = val2.N2.Wildcard) and 471 | (val1.N2.Data = val2.N2.Data); 472 | 473 | end; 474 | 475 | {$ENDIF FPC} 476 | 477 | end. 478 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # PatternFinderPascal 2 | Signature matcher/wildcard pattern finder in Pascal. 3 | 4 | 5 | **Tested Compilers** 6 | 7 | FreePascal 3.0.0 and Above. 8 | 9 | Delphi 2009 and Above. 10 | 11 | 12 | **Examples.** 13 | 14 | 15 | Examples can be found in the Tests Folder. 16 | 17 | ###License 18 | 19 | This "Software" is Licensed Under **`MIT License (MIT)`** . 20 | 21 | #### Tip Jar 22 | * :dollar: **Bitcoin**: `1MhFfW7tDuEHQSgie65uJcAfJgCNchGeKf` 23 | * :euro: **Ethereum**: `0x6c1DC21aeC49A822A4f1E3bf07c623C2C1978a98` 24 | * :pound: **Pascalcoin**: `345367-40` --------------------------------------------------------------------------------