16 | <UseAppBundle Value="False"/> 17 | <ResourceType Value="res"/> 18 | </General> 19 | <BuildModes Count="1"> 20 | <Item1 Name="Default" Default="True"/> 21 | </BuildModes> 22 | <PublishOptions> 23 | <Version Value="2"/> 24 | <UseFileFilters Value="True"/> 25 | </PublishOptions> 26 | <RunParams> 27 | <FormatVersion Value="2"/> 28 | </RunParams> 29 | <RequiredPackages Count="1"> 30 | <Item1> 31 | <PackageName Value="LCL"/> 32 | </Item1> 33 | </RequiredPackages> 34 | <Units Count="3"> 35 | <Unit0> 36 | <Filename Value="BasicDiffDemo1.dpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | <Unit1> 40 | <Filename Value="Unit1.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <ComponentName Value="Form1"/> 43 | <HasResources Value="True"/> 44 | <ResourceBaseClass Value="Form"/> 45 | </Unit1> 46 | <Unit2> 47 | <Filename Value="..\src\Diff.pas"/> 48 | <IsPartOfProject Value="True"/> 49 | </Unit2> 50 | </Units> 51 | </ProjectOptions> 52 | <CompilerOptions> 53 | <Version Value="11"/> 54 | <PathDelim Value="\"/> 55 | <SearchPaths> 56 | <IncludeFiles Value=".."/> 57 | <OtherUnitFiles Value="..\src"/> 58 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 59 | </SearchPaths> 60 | <Parsing> 61 | <SyntaxOptions> 62 | <SyntaxMode Value="delphi"/> 63 | </SyntaxOptions> 64 | </Parsing> 65 | <Linking> 66 | <Debugging> 67 | <DebugInfoType Value="dsDwarf3"/> 68 | </Debugging> 69 | <Options> 70 | <Win32> 71 | <GraphicApplication Value="True"/> 72 | </Win32> 73 | </Options> 74 | </Linking> 75 | <Other> 76 | <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/> 77 | </Other> 78 | </CompilerOptions> 79 | <Debugging> 80 | <Exceptions Count="3"> 81 | <Item1> 82 | <Name Value="EAbort"/> 83 | </Item1> 84 | <Item2> 85 | <Name Value="ECodetoolError"/> 86 | </Item2> 87 | <Item3> 88 | <Name Value="EFOpenError"/> 89 | </Item3> 90 | </Exceptions> 91 | </Debugging> 92 | </CONFIG> 93 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="12"/> 6 | <BuildModes Active="Default"/> 7 | <Units Count="5"> 8 | <Unit0> 9 | <Filename Value="BasicDiffDemo1.dpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <UsageCount Value="20"/> 12 | <Loaded Value="True"/> 13 | </Unit0> 14 | <Unit1> 15 | <Filename Value="Unit1.pas"/> 16 | <IsPartOfProject Value="True"/> 17 | <ComponentName Value="Form1"/> 18 | <HasResources Value="True"/> 19 | <ResourceBaseClass Value="Form"/> 20 | <UsageCount Value="20"/> 21 | </Unit1> 22 | <Unit2> 23 | <Filename Value="..\src\Diff.pas"/> 24 | <IsPartOfProject Value="True"/> 25 | <EditorIndex Value="3"/> 26 | <TopLine Value="93"/> 27 | <CursorPos X="57" Y="73"/> 28 | <UsageCount Value="20"/> 29 | <Loaded Value="True"/> 30 | </Unit2> 31 | <Unit3> 32 | <Filename Value="..\src\Diff_NP.pas"/> 33 | <IsVisibleTab Value="True"/> 34 | <EditorIndex Value="1"/> 35 | <TopLine Value="100"/> 36 | <CursorPos X="22" Y="106"/> 37 | <UsageCount Value="10"/> 38 | <Loaded Value="True"/> 39 | </Unit3> 40 | <Unit4> 41 | <Filename Value="C:\lazarus\components\lazutils\integerlist.pas"/> 42 | <UnitName Value="IntegerList"/> 43 | <EditorIndex Value="2"/> 44 | <TopLine Value="19"/> 45 | <CursorPos X="3" Y="35"/> 46 | <UsageCount Value="10"/> 47 | <Loaded Value="True"/> 48 | </Unit4> 49 | </Units> 50 | <JumpHistory Count="15" HistoryIndex="14"> 51 | <Position1> 52 | <Filename Value="BasicDiffDemo1.dpr"/> 53 | </Position1> 54 | <Position2> 55 | <Filename Value="..\src\Diff_NP.pas"/> 56 | <Caret Line="150" Column="3" TopLine="141"/> 57 | </Position2> 58 | <Position3> 59 | <Filename Value="..\src\Diff.pas"/> 60 | <Caret Line="136" Column="23" TopLine="120"/> 61 | </Position3> 62 | <Position4> 63 | <Filename Value="..\src\Diff.pas"/> 64 | <Caret Line="74" Column="102" TopLine="65"/> 65 | </Position4> 66 | <Position5> 67 | <Filename Value="..\src\Diff_NP.pas"/> 68 | <Caret Line="147" Column="15" TopLine="136"/> 69 | </Position5> 70 | <Position6> 71 | <Filename Value="..\src\Diff.pas"/> 72 | <Caret Line="47" Column="19" TopLine="38"/> 73 | </Position6> 74 | <Position7> 75 | <Filename Value="..\src\Diff.pas"/> 76 | <Caret Line="49" Column="12"/> 77 | </Position7> 78 | <Position8> 79 | <Filename Value="..\src\Diff.pas"/> 80 | <Caret Line="73" Column="56" TopLine="55"/> 81 | </Position8> 82 | <Position9> 83 | <Filename Value="..\src\Diff_NP.pas"/> 84 | <Caret Line="77" Column="37" TopLine="73"/> 85 | </Position9> 86 | <Position10> 87 | <Filename Value="BasicDiffDemo1.dpr"/> 88 | </Position10> 89 | <Position11> 90 | <Filename Value="..\src\Diff.pas"/> 91 | <Caret Line="135" Column="55" TopLine="129"/> 92 | </Position11> 93 | <Position12> 94 | <Filename Value="..\src\Diff.pas"/> 95 | <Caret Line="47" Column="20" TopLine="35"/> 96 | </Position12> 97 | <Position13> 98 | <Filename Value="..\src\Diff.pas"/> 99 | <Caret Line="73" Column="57" TopLine="93"/> 100 | </Position13> 101 | <Position14> 102 | <Filename Value="..\src\Diff_NP.pas"/> 103 | <Caret Line="132" Column="53" TopLine="125"/> 104 | </Position14> 105 | <Position15> 106 | <Filename Value="..\src\Diff_NP.pas"/> 107 | <Caret Line="180" Column="11" TopLine="164"/> 108 | </Position15> 109 | </JumpHistory> 110 | <RunParams> 111 | <FormatVersion Value="2"/> 112 | <Modes ActiveMode=""/> 113 | </RunParams> 114 | </ProjectSession> 115 | </CONFIG> 116 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo1/BasicDiffDemo1.res -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo1/BasicDiffDemo1_Icon.ico -------------------------------------------------------------------------------- /BasicDemo1/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 526 3 | Top = 192 4 | Caption = 'Basic Diff Demo' 5 | ClientHeight = 385 6 | ClientWidth = 367 7 | Color = clBtnFace 8 | Font.Charset = ANSI_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Arial' 12 | Font.Style = [] 13 | Position = poScreenCenter 14 | OnCreate = FormCreate 15 | TextHeight = 15 16 | object Label1: TLabel 17 | Left = 23 18 | Top = 23 19 | Width = 193 20 | Height = 15 21 | Caption = 'Type some text below and compare' 22 | end 23 | object PaintBox1: TPaintBox 24 | Left = 24 25 | Top = 160 26 | Width = 320 27 | Height = 161 28 | Font.Charset = ANSI_CHARSET 29 | Font.Color = clWindowText 30 | Font.Height = -12 31 | Font.Name = 'Courier New' 32 | Font.Style = [] 33 | ParentFont = False 34 | Visible = False 35 | OnPaint = PaintBox1Paint 36 | end 37 | object Edit1: TEdit 38 | Left = 23 39 | Top = 50 40 | Width = 320 41 | Height = 23 42 | TabOrder = 0 43 | Text = 'Lorem ipsum aterium' 44 | end 45 | object Edit2: TEdit 46 | Left = 23 47 | Top = 83 48 | Width = 320 49 | Height = 23 50 | TabOrder = 1 51 | Text = 'Lohames in uto' 52 | end 53 | object Button1: TButton 54 | Left = 23 55 | Top = 121 56 | Width = 320 57 | Height = 25 58 | Caption = 'Co&mpare' 59 | Default = True 60 | TabOrder = 2 61 | OnClick = Button1Click 62 | end 63 | object Button2: TButton 64 | Left = 24 65 | Top = 335 66 | Width = 320 67 | Height = 25 68 | Caption = '&Close' 69 | ModalResult = 1 70 | TabOrder = 3 71 | OnClick = Button2Click 72 | end 73 | end 74 | -------------------------------------------------------------------------------- /BasicDemo1/Unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 526 3 | Height = 385 4 | Top = 192 5 | Width = 396 6 | Caption = 'Basic Diff Demo' 7 | ClientHeight = 385 8 | ClientWidth = 396 9 | Color = clBtnFace 10 | DefaultMonitor = dmDesktop 11 | Font.CharSet = ANSI_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -12 14 | Font.Name = 'Arial' 15 | OnCreate = FormCreate 16 | OnShow = FormShow 17 | Position = poScreenCenter 18 | LCLVersion = '2.0.8.0' 19 | Visible = True 20 | object Label1: TLabel 21 | Left = 23 22 | Height = 15 23 | Top = 23 24 | Width = 222 25 | Caption = ' ' 26 | ParentColor = False 27 | end 28 | object PaintBox1: TPaintBox 29 | Left = 24 30 | Height = 161 31 | Top = 159 32 | Width = 352 33 | Font.CharSet = ANSI_CHARSET 34 | Font.Color = clWindowText 35 | Font.Height = -13 36 | Font.Name = 'Courier New' 37 | ParentFont = False 38 | Visible = False 39 | OnPaint = PaintBox1Paint 40 | end 41 | object Edit1: TEdit 42 | Left = 23 43 | Height = 23 44 | Top = 50 45 | Width = 353 46 | TabOrder = 0 47 | Text = 'Change the text here & then compare' 48 | end 49 | object Edit2: TEdit 50 | Left = 23 51 | Height = 23 52 | Top = 83 53 | Width = 353 54 | TabOrder = 1 55 | Text = 'Change the text here & then compare' 56 | end 57 | object Button1: TButton 58 | Left = 23 59 | Height = 25 60 | Top = 121 61 | Width = 353 62 | Caption = 'Co&mpare' 63 | Default = True 64 | OnClick = Button1Click 65 | TabOrder = 2 66 | end 67 | object Button2: TButton 68 | Left = 24 69 | Height = 25 70 | Top = 335 71 | Width = 352 72 | Caption = '&Close' 73 | ModalResult = 1 74 | OnClick = Button2Click 75 | TabOrder = 3 76 | end 77 | end 78 | -------------------------------------------------------------------------------- /BasicDemo1/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | {$IFDEF FPC} 11 | LCLIntf, LCLType, 12 | {$ENDIF} 13 | SysUtils, 14 | Variants, 15 | Classes, 16 | Graphics, 17 | Controls, 18 | Forms, 19 | Dialogs, 20 | StdCtrls, 21 | DiffTypes, 22 | Diff, 23 | ExtCtrls; 24 | 25 | type 26 | 27 | { TForm1 } 28 | 29 | TForm1 = class(TForm) 30 | Edit1: TEdit; 31 | Edit2: TEdit; 32 | Button1: TButton; 33 | Label1: TLabel; 34 | PaintBox1: TPaintBox; 35 | Button2: TButton; 36 | procedure FormCreate(Sender: TObject); 37 | procedure Button1Click(Sender: TObject); 38 | procedure PaintBox1Paint(Sender: TObject); 39 | procedure Button2Click(Sender: TObject); 40 | private 41 | Diff: TDiff; 42 | FCharHeight: Integer; 43 | FCharWidth: Integer; 44 | public 45 | { Public declarations } 46 | end; 47 | 48 | 49 | var 50 | Form1: TForm1; 51 | 52 | implementation 53 | 54 | {$R *.dfm} 55 | 56 | 57 | { TForm1 } 58 | 59 | procedure TForm1.FormCreate(Sender: TObject); 60 | begin 61 | Diff := TDiff.Create(self); 62 | FCharHeight := 0; 63 | FCharWidth := 0; 64 | end; 65 | 66 | procedure TForm1.Button1Click(Sender: TObject); 67 | begin 68 | //do the 'diff' here ... 69 | Diff.Execute(edit1.text, edit2.text); 70 | 71 | PaintBox1.visible := true; 72 | PaintBox1.Invalidate; 73 | end; 74 | 75 | procedure TForm1.PaintBox1Paint(Sender: TObject); 76 | var 77 | i: Integer; 78 | clBk: TColor; 79 | ch1,ch2: Char; 80 | x,y: Integer; 81 | LCanvas: TCanvas; 82 | begin 83 | x := 1; 84 | y := 1; 85 | LCanvas := PaintBox1.Canvas; 86 | if FCharHeight = 0 then 87 | FCharHeight := LCanvas.TextHeight('W'); 88 | if FCharWidth = 0 then 89 | FCharWidth := LCanvas.TextWidth('W'); 90 | for i := 0 to Diff.count-1 do 91 | begin 92 | with Diff.Compares[i] do 93 | begin 94 | if Kind = ckAdd then 95 | begin 96 | ch1 := #32; 97 | ch2 := chr2; 98 | clBk := $FFAAAA; 99 | end 100 | else if Kind = ckDelete then 101 | begin 102 | ch1 := chr1; 103 | ch2 := #32; 104 | clBk := $AAAAFF; 105 | end 106 | else if Kind = ckModify then 107 | begin 108 | ch1 := chr1; 109 | ch2 := chr2; 110 | clBk := $AAFFAA; 111 | end 112 | else 113 | begin 114 | ch1 := chr1; 115 | ch2 := chr2; 116 | clBk := clBtnFace; 117 | end; 118 | 119 | LCanvas.Brush.Color := clBk; 120 | LCanvas.TextOut(x,y,ch1); 121 | LCanvas.TextOut(x,y+FCharHeight+2,ch2); 122 | Inc(x,FCharWidth); 123 | end; 124 | end; 125 | 126 | y := y+3*FCharHeight; 127 | LCanvas.Brush.Color := clBtnFace; 128 | LCanvas.TextOut(0,y,'Compare Statistics ...'); 129 | with Diff.DiffStats do 130 | begin 131 | y := y+FCharHeight+5; 132 | LCanvas.Brush.Color := clBtnFace; 133 | LCanvas.TextOut(0,y,' Matches : '+inttostr(matches)); 134 | y := y+FCharHeight+2; 135 | LCanvas.Brush.Color := $AAFFAA; 136 | LCanvas.TextOut(0,y,' Modifies: '+inttostr(modifies)); 137 | y := y+FCharHeight+2; 138 | LCanvas.Brush.Color := $FFAAAA; 139 | LCanvas.TextOut(0,y,' Adds : '+inttostr(adds)); 140 | y := y+FCharHeight+2; 141 | LCanvas.Brush.Color := $AAAAFF; 142 | LCanvas.TextOut(0,y,' Deletes : '+inttostr(deletes)); 143 | end; 144 | end; 145 | 146 | procedure TForm1.Button2Click(Sender: TObject); 147 | begin 148 | close; 149 | end; 150 | 151 | end. 152 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.dpr: -------------------------------------------------------------------------------- 1 | // JCL_DEBUG_EXPERT_GENERATEJDBG OFF 2 | program BasicDiffDemo2; 3 | 4 | {$IFDEF FPC} 5 | {$MODE Delphi} 6 | {$ENDIF} 7 | 8 | uses 9 | {$IFnDEF FPC} 10 | {$ELSE} 11 | Interfaces, 12 | {$ENDIF } 13 | Forms, 14 | Unit1 in 'Unit1.pas' {Form1}, 15 | Diff in '..\src\Diff.pas', 16 | Diff_ND in '..\src\Diff_ND.pas', 17 | Diff_NP in '..\src\Diff_NP.pas', 18 | DiffTypes in '..\src\DiffTypes.pas', 19 | HashUnit in '..\src\HashUnit.pas'; 20 | 21 | {$R *.res} 22 | 23 | begin 24 | Application.Initialize; 25 | Application.CreateForm(TForm1, Form1); 26 | Application.Run; 27 | end. 28 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.dproj.local: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="utf-8"?> 2 | <BorlandProject/> 3 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.identcache: -------------------------------------------------------------------------------- 1 | ��\C:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\BasicDemo2\BasicDiffDemo2.dpr��PC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\DiffTypes.pas��NC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\Diff_NP.pas��SC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\BasicDemo2\Unit1.pas��KC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\Diff.pas��OC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\HashUnit.pas��NC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\Diff_ND.pas�� -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="12"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasUsesSectionForAllUnits Value="False"/> 9 | <MainUnitHasCreateFormStatements Value="False"/> 10 | <MainUnitHasTitleStatement Value="False"/> 11 | <MainUnitHasScaledStatement Value="False"/> 12 | <CompatibilityMode Value="True"/> 13 | </Flags> 14 | <SessionStorage Value="InProjectDir"/> 15 | <Title Value="BasicDiffDemo2"/> 16 | <UseAppBundle Value="False"/> 17 | <ResourceType Value="res"/> 18 | </General> 19 | <BuildModes Count="1"> 20 | <Item1 Name="Default" Default="True"/> 21 | </BuildModes> 22 | <PublishOptions> 23 | <Version Value="2"/> 24 | <UseFileFilters Value="True"/> 25 | </PublishOptions> 26 | <RunParams> 27 | <FormatVersion Value="2"/> 28 | </RunParams> 29 | <RequiredPackages Count="1"> 30 | <Item1> 31 | <PackageName Value="LCL"/> 32 | </Item1> 33 | </RequiredPackages> 34 | <Units Count="4"> 35 | <Unit0> 36 | <Filename Value="BasicDiffDemo2.dpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | <Unit1> 40 | <Filename Value="Unit1.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <ComponentName Value="Form1"/> 43 | <HasResources Value="True"/> 44 | <ResourceBaseClass Value="Form"/> 45 | </Unit1> 46 | <Unit2> 47 | <Filename Value="..\src\HashUnit.pas"/> 48 | <IsPartOfProject Value="True"/> 49 | </Unit2> 50 | <Unit3> 51 | <Filename Value="..\src\Diff.pas"/> 52 | <IsPartOfProject Value="True"/> 53 | </Unit3> 54 | </Units> 55 | </ProjectOptions> 56 | <CompilerOptions> 57 | <Version Value="11"/> 58 | <PathDelim Value="\"/> 59 | <SearchPaths> 60 | <IncludeFiles Value=".."/> 61 | <OtherUnitFiles Value="..\src"/> 62 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 63 | </SearchPaths> 64 | <Parsing> 65 | <SyntaxOptions> 66 | <SyntaxMode Value="delphi"/> 67 | </SyntaxOptions> 68 | </Parsing> 69 | <Linking> 70 | <Debugging> 71 | <DebugInfoType Value="dsDwarf3"/> 72 | </Debugging> 73 | <Options> 74 | <Win32> 75 | <GraphicApplication Value="True"/> 76 | </Win32> 77 | </Options> 78 | </Linking> 79 | <Other> 80 | <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/> 81 | </Other> 82 | </CompilerOptions> 83 | <Debugging> 84 | <Exceptions Count="3"> 85 | <Item1> 86 | <Name Value="EAbort"/> 87 | </Item1> 88 | <Item2> 89 | <Name Value="ECodetoolError"/> 90 | </Item2> 91 | <Item3> 92 | <Name Value="EFOpenError"/> 93 | </Item3> 94 | </Exceptions> 95 | </Debugging> 96 | </CONFIG> 97 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="12"/> 6 | <BuildModes Active="Default"/> 7 | <Units Count="4"> 8 | <Unit0> 9 | <Filename Value="BasicDiffDemo2.dpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <UsageCount Value="20"/> 12 | <Loaded Value="True"/> 13 | </Unit0> 14 | <Unit1> 15 | <Filename Value="Unit1.pas"/> 16 | <IsPartOfProject Value="True"/> 17 | <ComponentName Value="Form1"/> 18 | <HasResources Value="True"/> 19 | <ResourceBaseClass Value="Form"/> 20 | <IsVisibleTab Value="True"/> 21 | <EditorIndex Value="1"/> 22 | <TopLine Value="109"/> 23 | <CursorPos X="29" Y="115"/> 24 | <UsageCount Value="20"/> 25 | <Loaded Value="True"/> 26 | <LoadedDesigner Value="True"/> 27 | </Unit1> 28 | <Unit2> 29 | <Filename Value="..\src\HashUnit.pas"/> 30 | <IsPartOfProject Value="True"/> 31 | <UsageCount Value="20"/> 32 | </Unit2> 33 | <Unit3> 34 | <Filename Value="..\src\Diff.pas"/> 35 | <IsPartOfProject Value="True"/> 36 | <UsageCount Value="20"/> 37 | </Unit3> 38 | </Units> 39 | <JumpHistory Count="6" HistoryIndex="5"> 40 | <Position1> 41 | <Filename Value="BasicDiffDemo2.dpr"/> 42 | </Position1> 43 | <Position2> 44 | <Filename Value="Unit1.pas"/> 45 | <Caret Line="15" Column="12" TopLine="45"/> 46 | </Position2> 47 | <Position3> 48 | <Filename Value="Unit1.pas"/> 49 | <Caret Line="293" Column="38" TopLine="277"/> 50 | </Position3> 51 | <Position4> 52 | <Filename Value="Unit1.pas"/> 53 | <Caret Line="85" Column="36" TopLine="78"/> 54 | </Position4> 55 | <Position5> 56 | <Filename Value="Unit1.pas"/> 57 | <Caret Line="34" Column="5" TopLine="26"/> 58 | </Position5> 59 | <Position6> 60 | <Filename Value="Unit1.pas"/> 61 | <Caret Line="14" Column="20" TopLine="8"/> 62 | </Position6> 63 | </JumpHistory> 64 | <RunParams> 65 | <FormatVersion Value="2"/> 66 | <Modes ActiveMode=""/> 67 | </RunParams> 68 | </ProjectSession> 69 | </CONFIG> 70 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo2/BasicDiffDemo2.res -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo2/BasicDiffDemo2_Icon.ico -------------------------------------------------------------------------------- /BasicDemo2/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 190 3 | Top = 219 4 | Caption = 'Basic Diff Demo2' 5 | ClientHeight = 365 6 | ClientWidth = 804 7 | Color = clBtnFace 8 | Font.Charset = ANSI_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Arial' 12 | Font.Style = [] 13 | Menu = MainMenu1 14 | Position = poScreenCenter 15 | OnActivate = FormActivate 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | OnResize = FormResize 19 | TextHeight = 15 20 | object Panel1: TPanel 21 | Left = 0 22 | Top = 0 23 | Width = 804 24 | Height = 23 25 | Align = alTop 26 | BevelOuter = bvNone 27 | TabOrder = 0 28 | ExplicitWidth = 798 29 | object lblFile1: TLabel 30 | Left = 0 31 | Top = 5 32 | Width = 36 33 | Height = 15 34 | Caption = ' File1: ' 35 | end 36 | object lblFile2: TLabel 37 | Left = 381 38 | Top = 5 39 | Width = 36 40 | Height = 15 41 | Caption = ' File2: ' 42 | end 43 | end 44 | object StatusBar1: TStatusBar 45 | Left = 0 46 | Top = 346 47 | Width = 804 48 | Height = 19 49 | Panels = < 50 | item 51 | Width = 100 52 | end 53 | item 54 | Width = 100 55 | end 56 | item 57 | Width = 100 58 | end 59 | item 60 | Width = 100 61 | end> 62 | ExplicitTop = 329 63 | ExplicitWidth = 798 64 | end 65 | object ResultGrid: TStringGrid 66 | Left = 0 67 | Top = 23 68 | Width = 804 69 | Height = 323 70 | Align = alClient 71 | ColCount = 4 72 | DefaultRowHeight = 17 73 | DefaultDrawing = False 74 | FixedCols = 0 75 | RowCount = 1 76 | FixedRows = 0 77 | Font.Charset = ANSI_CHARSET 78 | Font.Color = clWindowText 79 | Font.Height = -12 80 | Font.Name = 'Courier New' 81 | Font.Style = [] 82 | GridLineWidth = 0 83 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goRowSelect] 84 | ParentFont = False 85 | TabOrder = 2 86 | OnDrawCell = ResultGridDrawCell 87 | ExplicitWidth = 798 88 | ExplicitHeight = 306 89 | end 90 | object MainMenu1: TMainMenu 91 | Left = 112 92 | Top = 137 93 | object File1: TMenuItem 94 | Caption = '&File' 95 | object Open11: TMenuItem 96 | Caption = 'Open &1 ...' 97 | ShortCut = 16433 98 | OnClick = Open11Click 99 | end 100 | object Open21: TMenuItem 101 | Caption = 'Open &2 ...' 102 | ShortCut = 16434 103 | OnClick = Open21Click 104 | end 105 | object N1: TMenuItem 106 | Caption = '-' 107 | end 108 | object mnuCompare: TMenuItem 109 | Caption = '&Compare' 110 | Enabled = False 111 | ShortCut = 120 112 | OnClick = mnuCompareClick 113 | end 114 | object mnuCancel: TMenuItem 115 | Caption = 'C&ancel' 116 | Enabled = False 117 | ShortCut = 27 118 | OnClick = mnuCancelClick 119 | end 120 | object N2: TMenuItem 121 | Caption = '-' 122 | end 123 | object Exit1: TMenuItem 124 | Caption = 'E&xit' 125 | OnClick = Exit1Click 126 | end 127 | end 128 | object mnuView: TMenuItem 129 | Caption = '&View' 130 | Enabled = False 131 | object PreviousChanges1: TMenuItem 132 | Caption = '&Previous Changes' 133 | ShortCut = 16464 134 | OnClick = PreviousChanges1Click 135 | end 136 | object NextChanges1: TMenuItem 137 | Caption = '&Next Changes' 138 | ShortCut = 16462 139 | OnClick = NextChanges1Click 140 | end 141 | end 142 | object Options1: TMenuItem 143 | Caption = '&Options' 144 | object mnuIgnoreCase: TMenuItem 145 | Caption = 'Ignore &Case' 146 | OnClick = mnuIgnoreCaseClick 147 | end 148 | object mnuIgnoreWhiteSpace: TMenuItem 149 | Caption = 'Ignore &White Space' 150 | OnClick = mnuIgnoreWhiteSpaceClick 151 | end 152 | object N3: TMenuItem 153 | Caption = '-' 154 | end 155 | object mnuNP: TMenuItem 156 | Caption = 'O(NP) Sequence Comparison Algorithm' 157 | Checked = True 158 | GroupIndex = 10 159 | RadioItem = True 160 | OnClick = mnuNPClick 161 | end 162 | object mnuND: TMenuItem 163 | Caption = 'O(ND) Difference Algorithm' 164 | GroupIndex = 10 165 | RadioItem = True 166 | OnClick = mnuNDClick 167 | end 168 | end 169 | end 170 | object OpenDialog1: TOpenDialog 171 | Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing] 172 | Left = 183 173 | Top = 119 174 | end 175 | end 176 | -------------------------------------------------------------------------------- /BasicDemo2/Unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 353 3 | Height = 548 4 | Top = 239 5 | Width = 1206 6 | Caption = 'Basic Diff Demo2' 7 | ClientHeight = 548 8 | ClientWidth = 1206 9 | Color = clBtnFace 10 | DesignTimePPI = 144 11 | Font.CharSet = ANSI_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -18 14 | Font.Name = 'Arial' 15 | Menu = MainMenu1 16 | OnActivate = FormActivate 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | OnResize = FormResize 20 | Position = poScreenCenter 21 | LCLVersion = '3.6.0.0' 22 | object Panel1: TPanel 23 | Left = 0 24 | Height = 34 25 | Top = 0 26 | Width = 1206 27 | Align = alTop 28 | BevelOuter = bvNone 29 | ClientHeight = 34 30 | ClientWidth = 1206 31 | ParentBackground = False 32 | TabOrder = 0 33 | object lblFile1: TLabel 34 | Left = 0 35 | Height = 21 36 | Top = 8 37 | Width = 54 38 | Caption = ' File1: ' 39 | ParentColor = False 40 | end 41 | object lblFile2: TLabel 42 | Left = 572 43 | Height = 21 44 | Top = 8 45 | Width = 54 46 | Caption = ' File2: ' 47 | ParentColor = False 48 | end 49 | end 50 | object StatusBar1: TStatusBar 51 | Left = 0 52 | Height = 36 53 | Top = 512 54 | Width = 1206 55 | Panels = < 56 | item 57 | Width = 150 58 | end 59 | item 60 | Width = 150 61 | end 62 | item 63 | Width = 150 64 | end 65 | item 66 | Width = 150 67 | end> 68 | end 69 | object ResultGrid: TStringGrid 70 | Left = 0 71 | Height = 478 72 | Top = 34 73 | Width = 1206 74 | Align = alClient 75 | ColCount = 4 76 | DefaultDrawing = False 77 | DefaultRowHeight = 26 78 | DoubleBuffered = True 79 | FixedCols = 0 80 | FixedRows = 0 81 | Flat = True 82 | Font.CharSet = ANSI_CHARSET 83 | Font.Color = clWindowText 84 | Font.Height = -18 85 | Font.Name = 'Courier New' 86 | GridLineWidth = 0 87 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goRowSelect, goRowHighlight] 88 | ParentDoubleBuffered = False 89 | ParentFont = False 90 | RowCount = 1 91 | TabOrder = 2 92 | OnDrawCell = ResultGridDrawCell 93 | ColWidths = ( 94 | 300 95 | 300 96 | 300 97 | 304 98 | ) 99 | end 100 | object MainMenu1: TMainMenu 101 | Left = 168 102 | Top = 206 103 | object File1: TMenuItem 104 | Caption = '&File' 105 | object Open11: TMenuItem 106 | Caption = 'Open &1 ...' 107 | ShortCut = 16433 108 | OnClick = Open11Click 109 | end 110 | object Open21: TMenuItem 111 | Caption = 'Open &2 ...' 112 | ShortCut = 16434 113 | OnClick = Open21Click 114 | end 115 | object N1: TMenuItem 116 | Caption = '-' 117 | end 118 | object mnuCompare: TMenuItem 119 | Caption = '&Compare' 120 | Enabled = False 121 | ShortCut = 120 122 | OnClick = mnuCompareClick 123 | end 124 | object mnuCancel: TMenuItem 125 | Caption = 'C&ancel' 126 | Enabled = False 127 | ShortCut = 27 128 | OnClick = mnuCancelClick 129 | end 130 | object N2: TMenuItem 131 | Caption = '-' 132 | end 133 | object Exit1: TMenuItem 134 | Caption = 'E&xit' 135 | OnClick = Exit1Click 136 | end 137 | end 138 | object mnuView: TMenuItem 139 | Caption = '&View' 140 | Enabled = False 141 | object PreviousChanges1: TMenuItem 142 | Caption = '&Previous Changes' 143 | ShortCut = 16464 144 | OnClick = PreviousChanges1Click 145 | end 146 | object NextChanges1: TMenuItem 147 | Caption = '&Next Changes' 148 | ShortCut = 16462 149 | OnClick = NextChanges1Click 150 | end 151 | end 152 | object Options1: TMenuItem 153 | Caption = '&Options' 154 | object mnuIgnoreCase: TMenuItem 155 | Caption = 'Ignore &Case' 156 | OnClick = mnuIgnoreCaseClick 157 | end 158 | object mnuIgnoreWhiteSpace: TMenuItem 159 | Caption = 'Ignore &White Space' 160 | OnClick = mnuIgnoreWhiteSpaceClick 161 | end 162 | end 163 | end 164 | object OpenDialog1: TOpenDialog 165 | Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing] 166 | Left = 275 167 | Top = 179 168 | end 169 | end 170 | -------------------------------------------------------------------------------- /BasicDemo2/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | {$IFnDEF FPC} 11 | Generics.Collections, 12 | System.Types, 13 | {$ELSE} 14 | FGL, IntegerList, 15 | {$ENDIF} 16 | SysUtils, 17 | Variants, 18 | Classes, 19 | Graphics, 20 | Controls, 21 | Forms, 22 | Dialogs, 23 | StdCtrls, 24 | Math, 25 | DiffTypes, 26 | Diff, 27 | ExtCtrls, 28 | Grids, 29 | Menus, 30 | ComCtrls; 31 | 32 | type 33 | {.$IFDEF FPC} 34 | //TIntegerList = TFPGList<Cardinal>; 35 | {.$ENDIF} 36 | 37 | TForm1 = class(TForm) 38 | MainMenu1: TMainMenu; 39 | File1: TMenuItem; 40 | Open11: TMenuItem; 41 | Open21: TMenuItem; 42 | N1: TMenuItem; 43 | mnuCompare: TMenuItem; 44 | N2: TMenuItem; 45 | Exit1: TMenuItem; 46 | OpenDialog1: TOpenDialog; 47 | mnuCancel: TMenuItem; 48 | Panel1: TPanel; 49 | lblFile1: TLabel; 50 | lblFile2: TLabel; 51 | StatusBar1: TStatusBar; 52 | ResultGrid: TStringGrid; 53 | Options1: TMenuItem; 54 | mnuIgnoreCase: TMenuItem; 55 | mnuIgnoreWhiteSpace: TMenuItem; 56 | mnuView: TMenuItem; 57 | PreviousChanges1: TMenuItem; 58 | NextChanges1: TMenuItem; 59 | N3: TMenuItem; 60 | mnuNP: TMenuItem; 61 | mnuND: TMenuItem; 62 | procedure FormCreate(Sender: TObject); 63 | procedure Open11Click(Sender: TObject); 64 | procedure Open21Click(Sender: TObject); 65 | procedure Exit1Click(Sender: TObject); 66 | procedure FormDestroy(Sender: TObject); 67 | procedure mnuCompareClick(Sender: TObject); 68 | procedure mnuCancelClick(Sender: TObject); 69 | procedure FormResize(Sender: TObject); 70 | procedure ResultGridDrawCell(Sender: TObject; ACol, ARow: Integer; 71 | Rect: TRect; State: TGridDrawState); 72 | procedure mnuIgnoreCaseClick(Sender: TObject); 73 | procedure mnuIgnoreWhiteSpaceClick(Sender: TObject); 74 | procedure PreviousChanges1Click(Sender: TObject); 75 | procedure NextChanges1Click(Sender: TObject); 76 | procedure FormActivate(Sender: TObject); 77 | procedure mnuNDClick(Sender: TObject); 78 | procedure mnuNPClick(Sender: TObject); 79 | private 80 | Diff: TDiff; 81 | FDiffAlgorithm: TDiffAlgorithm; 82 | source1, source2: TStringList; 83 | result1, result2: TStringList; 84 | {$IFDEF FPC} 85 | hashlist1, hashlist2: TCardinalList; 86 | {$ELSE} 87 | hashlist1, hashlist2: TList<Cardinal>; 88 | {$ENDIF} 89 | procedure Clear(aleft,aright: boolean); 90 | procedure BuildHashList(left,right: boolean); 91 | procedure OpenFile1(const filename: string); 92 | procedure OpenFile2(const filename: string); 93 | public 94 | { Public declarations } 95 | end; 96 | 97 | var 98 | Form1: TForm1; 99 | 100 | implementation 101 | 102 | uses HashUnit; 103 | 104 | {$R *.dfm} 105 | 106 | procedure TForm1.FormCreate(Sender: TObject); 107 | begin 108 | Diff := TDiff.Create(self); 109 | source1 := TStringList.Create; 110 | source2 := TStringList.Create; 111 | result1 := TStringList.Create; 112 | result2 := TStringList.Create; 113 | {$IFDEF FPC} 114 | hashlist1 := TCardinalList.Create; 115 | hashlist2 := TCardinalList.Create; 116 | {$ELSE} 117 | hashlist1 := TList<Cardinal>.Create; 118 | hashlist2 := TList<Cardinal>.Create; 119 | {$ENDIF} 120 | 121 | FDiffAlgorithm := algNP; 122 | ResultGrid.ColWidths[0] := 40; 123 | ResultGrid.ColWidths[2] := 40; 124 | ResultGrid.Canvas.Font := ResultGrid.Font; 125 | end; 126 | //------------------------------------------------------------------------------ 127 | 128 | procedure TForm1.FormActivate(Sender: TObject); 129 | begin 130 | if (paramcount > 0) then OpenFile1(paramstr(1)); 131 | if (paramcount > 1) then OpenFile2(paramstr(2)); 132 | mnuCompareClick(nil); 133 | end; 134 | //------------------------------------------------------------------------------ 135 | 136 | procedure TForm1.FormDestroy(Sender: TObject); 137 | begin 138 | source1.Free; 139 | source2.Free; 140 | result1.Free; 141 | result2.Free; 142 | hashlist1.Free; 143 | hashlist2.Free; 144 | end; 145 | //------------------------------------------------------------------------------ 146 | 147 | procedure TForm1.Clear(aleft, aright: boolean); 148 | begin 149 | if aleft then 150 | begin 151 | source1.Clear; 152 | result1.Clear; 153 | hashlist1.Clear; 154 | lblFile1.Caption := ' File1: '; 155 | end; 156 | if aright then 157 | begin 158 | source2.Clear; 159 | result2.Clear; 160 | hashlist2.Clear; 161 | lblFile2.Caption := ' File2: '; 162 | end; 163 | ResultGrid.RowCount := 0; 164 | Diff.Clear; 165 | StatusBar1.Panels[0].Text := ''; 166 | StatusBar1.Panels[1].Text := ''; 167 | StatusBar1.Panels[2].Text := ''; 168 | StatusBar1.Panels[3].Text := ''; 169 | mnuCompare.Enabled := false; 170 | mnuView.Enabled := false; 171 | end; 172 | //------------------------------------------------------------------------------ 173 | 174 | //Because it's SO MUCH EASIER AND FASTER comparing hashes (integers) than 175 | //comparing whole lines of text, we'll build a list of hashes for each line 176 | //in the source files. Each line is represented by a (virtually) unique 177 | //hash that is based on the contents of that line. Also, since the 178 | //likelihood of 2 different lines generating the same hash is so small, 179 | //we can safely ignore that possibility. 180 | 181 | procedure TForm1.BuildHashList(left,right: boolean); 182 | var 183 | i: integer; 184 | begin 185 | if left then 186 | begin 187 | hashlist1.Clear; 188 | for i := 0 to source1.Count -1 do 189 | hashlist1.Add(HashLine(source1[i], 190 | mnuIgnoreCase.Checked, mnuIgnoreWhiteSpace.checked)); 191 | end; 192 | if right then 193 | begin 194 | hashlist2.Clear; 195 | for i := 0 to source2.Count -1 do 196 | hashlist2.Add(HashLine(source2[i], 197 | mnuIgnoreCase.Checked, mnuIgnoreWhiteSpace.checked)); 198 | end; 199 | 200 | mnuCompare.Enabled := (hashlist1.Count > 0) and (hashlist2.Count > 0); 201 | end; 202 | //------------------------------------------------------------------------------ 203 | 204 | procedure TForm1.OpenFile1(const filename: string); 205 | var 206 | i: integer; 207 | begin 208 | if not fileExists(fileName) then exit; 209 | Clear(true,false); 210 | source1.LoadFromFile(fileName); 211 | lblFile1.Caption := ' File1: ' + ExtractFileName(fileName); 212 | 213 | BuildHashList(true,false); 214 | 215 | ResultGrid.RowCount := max(source1.Count, source2.Count); 216 | for i := 0 to 3 do ResultGrid.Cols[i].BeginUpdate; 217 | try 218 | for i := 0 to source1.Count -1 do 219 | begin 220 | ResultGrid.Cells[0,i] := inttostr(i+1); 221 | ResultGrid.Cells[1,i] := source1[i]; 222 | end; 223 | for i := 0 to source2.Count -1 do 224 | begin 225 | ResultGrid.Cells[2,i] := inttostr(i+1); 226 | ResultGrid.Cells[3,i] := source2[i]; 227 | end; 228 | finally 229 | for i := 0 to 3 do ResultGrid.Cols[i].EndUpdate; 230 | end; 231 | end; 232 | //------------------------------------------------------------------------------ 233 | 234 | procedure TForm1.OpenFile2(const filename: string); 235 | var 236 | i: integer; 237 | begin 238 | if not fileExists(fileName) then exit; 239 | Clear(false,true); 240 | source2.LoadFromFile(fileName); 241 | lblFile2.Caption := ' File2: ' + ExtractFileName(fileName); 242 | 243 | BuildHashList(false,true); 244 | 245 | ResultGrid.RowCount := max(source1.Count, source2.Count); 246 | for i := 0 to 3 do ResultGrid.Cols[i].BeginUpdate; 247 | try 248 | for i := 0 to source1.Count -1 do 249 | begin 250 | ResultGrid.Cells[0,i] := inttostr(i+1); 251 | ResultGrid.Cells[1,i] := source1[i]; 252 | end; 253 | for i := 0 to source2.Count -1 do 254 | begin 255 | ResultGrid.Cells[2,i] := inttostr(i+1); 256 | ResultGrid.Cells[3,i] := source2[i]; 257 | end; 258 | finally 259 | for i := 0 to 3 do ResultGrid.Cols[i].EndUpdate; 260 | end; 261 | end; 262 | //------------------------------------------------------------------------------ 263 | 264 | procedure TForm1.Open11Click(Sender: TObject); 265 | begin 266 | if OpenDialog1.Execute then OpenFile1(OpenDialog1.FileName); 267 | end; 268 | //------------------------------------------------------------------------------ 269 | 270 | procedure TForm1.Open21Click(Sender: TObject); 271 | begin 272 | if OpenDialog1.Execute then OpenFile2(OpenDialog1.FileName); 273 | end; 274 | //------------------------------------------------------------------------------ 275 | 276 | procedure TForm1.Exit1Click(Sender: TObject); 277 | begin 278 | close; 279 | end; 280 | //------------------------------------------------------------------------------ 281 | 282 | procedure TForm1.mnuCompareClick(Sender: TObject); 283 | var 284 | i: integer; 285 | begin 286 | if (hashlist1.Count = 0) or (hashlist2.Count = 0) then exit; 287 | mnuCancel.Enabled := true; 288 | screen.Cursor := crHourGlass; 289 | try 290 | //this is where it all happens ... 291 | 292 | //nb: TList.list is a pointer to the bottom of the list's integer array 293 | Diff.Execute(hashlist1, hashlist2, FDiffAlgorithm); 294 | 295 | if Diff.Cancelled then exit; 296 | 297 | //now fill ResultGrid with the differences ... 298 | for i := 0 to 3 do 299 | begin 300 | ResultGrid.Cols[i].BeginUpdate; 301 | ResultGrid.Cols[i].Clear; 302 | end; 303 | try 304 | ResultGrid.RowCount := Diff.Count; 305 | for i := 0 to Diff.Count -1 do 306 | with Diff.Compares[i], ResultGrid do 307 | begin 308 | if Kind <> ckAdd then 309 | begin 310 | Cells[0,i] := inttostr(oldIndex1+1); 311 | Cells[1,i] := source1[oldIndex1]; 312 | end; 313 | if Kind <> ckDelete then 314 | begin 315 | Cells[2,i] := inttostr(oldIndex2+1); 316 | Cells[3,i] := source2[oldIndex2]; 317 | end; 318 | end; 319 | finally 320 | for i := 0 to 3 do ResultGrid.Cols[i].EndUpdate; 321 | end; 322 | 323 | with Diff.DiffStats do 324 | begin 325 | StatusBar1.SimplePanel := False; 326 | StatusBar1.Panels[0].Text := ' Matches: ' + inttostr(matches); 327 | StatusBar1.Panels[1].Text := ' Modifies: ' + inttostr(modifies); 328 | StatusBar1.Panels[2].Text := ' Adds: ' + inttostr(adds); 329 | StatusBar1.Panels[3].Text := ' Deletes: ' + inttostr(deletes); 330 | end; 331 | 332 | finally 333 | screen.Cursor := crDefault; 334 | mnuCancel.Enabled := false; 335 | end; 336 | mnuView.Enabled := true; 337 | end; 338 | //------------------------------------------------------------------------------ 339 | 340 | procedure TForm1.mnuCancelClick(Sender: TObject); 341 | begin 342 | Diff.Cancel; 343 | end; 344 | //------------------------------------------------------------------------------ 345 | 346 | procedure TForm1.FormResize(Sender: TObject); 347 | var 348 | i: integer; 349 | begin 350 | with ResultGrid do 351 | begin 352 | i := (ClientWidth -80) div 2; 353 | ResultGrid.ColWidths[1] := i; 354 | ResultGrid.ColWidths[3] := i; 355 | end; 356 | lblFile2.Left := Panel1.ClientWidth div 2; 357 | end; 358 | //------------------------------------------------------------------------------ 359 | 360 | procedure AddCharToStr(var s: string; c: char; kind, lastkind: TChangeKind); 361 | begin 362 | if (Kind = lastKind) then s := s + c 363 | else 364 | case kind of 365 | ckNone: s := s + '<BC:------>' + c; 366 | else s := s + '<BC:33FFFF>' + c; 367 | end; 368 | end; 369 | //------------------------------------------------------------------------------ 370 | 371 | procedure TForm1.ResultGridDrawCell(Sender: TObject; ACol, ARow: Integer; 372 | Rect: TRect; State: TGridDrawState); 373 | const 374 | PaleGreen: TColor = $AAFFAA; 375 | PaleRed : TColor = $AAAAFF; 376 | PaleBlue : TColor = $FFAAAA; 377 | var 378 | clr,ctxt: Tcolor; 379 | begin 380 | if (gdSelected in State) and (ACol in [0,2]) then 381 | begin 382 | clr := clHighlight; 383 | ctxt := clHighlightText; 384 | end 385 | else if (Diff.Count = 0) then 386 | begin 387 | clr := clWhite; 388 | ctxt := clBlack; 389 | end 390 | else 391 | begin 392 | clr := clBtnFace; 393 | ctxt := clBlack; 394 | end; 395 | 396 | if (ACol in [1,3]) and (ARow < Diff.Count) then 397 | begin 398 | case Diff.Compares[ARow].Kind of 399 | ckNone: clr := clWhite; 400 | ckModify: clr := PaleGreen; 401 | ckDelete: clr := PaleRed; 402 | ckAdd: clr := PaleBlue; 403 | end; 404 | end; 405 | 406 | with ResultGrid.Canvas do 407 | begin 408 | Brush.Color := clr; 409 | Font.Color := ctxt; 410 | FillRect(Rect); 411 | TextRect(Rect, Rect.Left+3,Rect.Top+2, ResultGrid.Cells[ACol,ARow]); 412 | 413 | if (source1.Count = 0) and (source2.Count = 0) then exit; 414 | 415 | //now just some fancy coloring ... 416 | if (ACol in [0,2]) then 417 | begin 418 | Pen.Color := clWhite; 419 | MoveTo(Rect.Right-1,0); 420 | LineTo(Rect.Right-1,Rect.Bottom); 421 | end else 422 | begin 423 | if (ACol = 1) then 424 | begin 425 | Pen.Color := $333333; 426 | MoveTo(Rect.Right-1,0); 427 | LineTo(Rect.Right-1,Rect.Bottom); 428 | end; 429 | Pen.Color := clSilver; 430 | MoveTo(Rect.Left,0); 431 | LineTo(Rect.Left,Rect.Bottom); 432 | end; 433 | //finally, draw the focusRect ... 434 | if (gdSelected in State) and (ACol in [1,3]) then 435 | begin 436 | rect.Left := 0; 437 | DrawFocusRect(Rect); 438 | end; 439 | end; 440 | end; 441 | //------------------------------------------------------------------------------ 442 | 443 | procedure TForm1.mnuIgnoreCaseClick(Sender: TObject); 444 | begin 445 | mnuIgnoreCase.Checked := not mnuIgnoreCase.Checked; 446 | Clear(false,false); 447 | BuildHashList(true,true); 448 | mnuCompareClick(nil); 449 | end; 450 | //------------------------------------------------------------------------------ 451 | 452 | procedure TForm1.mnuIgnoreWhiteSpaceClick(Sender: TObject); 453 | begin 454 | mnuIgnoreWhiteSpace.Checked := not mnuIgnoreWhiteSpace.Checked; 455 | Clear(false,false); 456 | BuildHashList(true,true); 457 | mnuCompareClick(nil); 458 | end; 459 | //------------------------------------------------------------------------------ 460 | 461 | function GridRect(Coord1, Coord2: TGridCoord): TGridRect; 462 | begin 463 | with Result do 464 | begin 465 | Left := Coord2.X; 466 | if Coord1.X < Coord2.X then Left := Coord1.X; 467 | Right := Coord1.X; 468 | if Coord1.X < Coord2.X then Right := Coord2.X; 469 | Top := Coord2.Y; 470 | if Coord1.Y < Coord2.Y then Top := Coord1.Y; 471 | Bottom := Coord1.Y; 472 | if Coord1.Y < Coord2.Y then Bottom := Coord2.Y; 473 | end; 474 | end; 475 | //------------------------------------------------------------------------------ 476 | 477 | procedure TForm1.PreviousChanges1Click(Sender: TObject); 478 | var 479 | row: integer; 480 | Kind: TChangeKind; 481 | begin 482 | row := ResultGrid.Selection.Top; 483 | if row = 0 then exit; 484 | Kind := Diff.Compares[row].Kind; 485 | while (row > 0) and (Diff.Compares[row].Kind = Kind) do dec(row); 486 | if Diff.Compares[row].Kind = ckNone then 487 | begin 488 | Kind := ckNone; 489 | while (row > 0) and 490 | (Diff.Compares[row].Kind = Kind) do dec(row); 491 | end; 492 | ResultGrid.Selection := TGridRect(Rect(0, row, 3, row)); 493 | If row < ResultGrid.TopRow then 494 | ResultGrid.TopRow := Max(0, row - ResultGrid.VisibleRowCount +1); 495 | 496 | ResultGrid.Row := row; 497 | end; 498 | //------------------------------------------------------------------------------ 499 | 500 | procedure TForm1.NextChanges1Click(Sender: TObject); 501 | var 502 | row: integer; 503 | Kind: TChangeKind; 504 | begin 505 | row := ResultGrid.Selection.Top; 506 | if row = ResultGrid.RowCount -1 then exit; 507 | Kind := Diff.Compares[row].Kind; 508 | while (row < ResultGrid.RowCount -1) and 509 | (Diff.Compares[row].Kind = Kind) do inc(row); 510 | if Diff.Compares[row].Kind = ckNone then 511 | begin 512 | Kind := ckNone; 513 | while (row < ResultGrid.RowCount -1) and 514 | (Diff.Compares[row].Kind = Kind) do inc(row); 515 | end; 516 | ResultGrid.Selection := TGridRect(Rect(0, row, 3, row)); 517 | if row > ResultGrid.TopRow + ResultGrid.VisibleRowCount -1 then 518 | ResultGrid.TopRow := max(0,min(row, ResultGrid.RowCount - ResultGrid.VisibleRowCount)); 519 | 520 | ResultGrid.Row := row; 521 | end; 522 | 523 | procedure TForm1.mnuNDClick(Sender: TObject); 524 | begin 525 | mnuND.Checked := not mnuND.Checked; 526 | FDiffAlgorithm := algND; 527 | Clear(false,false); 528 | mnuCompareClick(nil); 529 | end; 530 | 531 | procedure TForm1.mnuNPClick(Sender: TObject); 532 | begin 533 | mnuNP.Checked := not mnuNP.Checked; 534 | FDiffAlgorithm := algNP; 535 | Clear(false,false); 536 | mnuCompareClick(nil); 537 | end; 538 | 539 | //------------------------------------------------------------------------------ 540 | 541 | end. 542 | -------------------------------------------------------------------------------- /docs/O(ND).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/docs/O(ND).pdf -------------------------------------------------------------------------------- /docs/O(NP).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/docs/O(NP).pdf -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Text compare component for Delphi and Free Pascal 2 | 3 | Source code for the freeware component TDiff is written in Delphi. This 4 | component dramatically simplify programming tasks that require calculations 5 | of 'shortest path' or 'longest common sequence' as typically required in file 6 | compare utilities. 7 | 8 | TDiff is used in RJ TextEd to compare text or source files. You need to add 9 | the units "DiffTypes" and "Diff" to the uses section of your application. 10 | 11 | The units "Diff_NP" and "Diff_ND" contains the available algorithms that can 12 | be used from the TDiff class. 13 | 14 | PDF documents fully describing the principle algorithms used in Diff_NP and Diff_ND...\ 15 | The algorithm in the Diff_ND unit is based on: 16 | "An O(ND) Difference Algorithm and its Variations" by E Myers - 17 | Algorithmica Vol. 1 No. 2, 1986, pp. 251-266\ 18 | The algorithm in the Diff_NP unit is based on: "An O(NP) Sequence Comparison Algorithm" 19 | by Sun Wu, Udi Manber & Gene Myers 20 | 21 | ### Getting Started 22 | 23 | Download the files and include the units DiffTypes and Diff in your project. 24 | 25 | ### Demo applications 26 | 27 | Two very simple demo applications (with full source code) are include to 28 | demonstrate how the 'TDiff' component can be used in Delphi and Lazarus programs. 29 | 30 | ### Authors 31 | Author : Angus Johnson - angusj-AT-myrealbox-DOT-com\ 32 | Copyright : © 2001-2008 Angus Johnson\ 33 | Updated by : Rickard Johansson ([RJ TextEd](https://www.rj-texted.se)) 34 | 35 | ### Version history 36 | - **1 May 2025**\ 37 | Added option to ignore case when comparing strings using Execute(s1, s2, ...). 38 | - **16 April 2025**\ 39 | Fixed an issue in Diff_ND when comparing strings. 40 | - **13 July 2023**\ 41 | Rewrote the component and made it easy to select the algorithm to use for comparison.\ 42 | Fixed several issues and updated the demos. 43 | - **23 May 2020**\ 44 | Replaced almost all code in demo 1. It should be much easier to understand now.\ 45 | Fixed a few issues in demo 2. 46 | - **19 May 2020**\ 47 | Added Lazarus support 48 | - **11 November 2018**\ 49 | Added TList<Cardinal> to store hash values.\ 50 | Made some minor code formatting and code changes\ 51 | Fixed Unicode string issues 52 | - **2 June 2008**\ 53 | Minor bugfixes. 54 | - **25 May 2008**\ 55 | Removed recursion to avoid the possibility of running out of stack memory during massive comparisons. 56 | - **24 May 2008**\ 57 | Reimplemented "divide-and-conquer" technique (which was omitted in 21 May release) so memory use is again minimal. 58 | - **21 May 2008**\ 59 | Another complete code rewrite to use Sun Wu et al. O(NP) Sequence Comparison Algorithm which more than halves times of typical comparisons. 60 | - **22 April 2008**\ 61 | Complete rewrite to greatly improve the code and provide a much simpler view of differences through a new 'Compares' property. 62 | - **December 2001**\ 63 | Original release (used Myer O(ND) Difference Algorithm) 64 | 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /src/Diff.pas: -------------------------------------------------------------------------------- 1 | unit Diff; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | (******************************************************************************* 8 | * Component TDiff * 9 | * Version: 1.0 * 10 | * Date: 1 May 2025 * 11 | * Compilers: Delphi 10.x * 12 | * Author: Rickard Johansson * 13 | * Copyright: � 2023 Rickard Johansson * 14 | * * 15 | * Licence to use, terms and conditions: * 16 | * The code in the TDiff component is released as freeware * 17 | * provided you agree to the following terms & conditions: * 18 | * 1. the copyright notice, terms and conditions are * 19 | * left unchanged * 20 | * 2. modifications to the code by other authors must be * 21 | * clearly documented and accompanied by the modifier's name. * 22 | * 3. the TDiff component may be freely compiled into binary * 23 | * format and no acknowledgement is required. However, a * 24 | * discrete acknowledgement would be appreciated (eg. in a * 25 | * program's 'About Box'). * 26 | * * 27 | * Description: Component to list differences between two integer arrays * 28 | * using a "longest common subsequence" algorithm. * 29 | * Typically, this component is used to diff 2 text files * 30 | * once their individuals lines have been hashed. * 31 | * * 32 | * * 33 | *******************************************************************************) 34 | 35 | 36 | (******************************************************************************* 37 | * History: * 38 | * 12 July 2023 - Original Release. * 39 | * 1 May 2025 - Added option to ignore case when comparing strings using * 40 | * Execute(s1, s2, aDiffAlgorithm, bIgnoreCase). * 41 | *******************************************************************************) 42 | 43 | interface 44 | 45 | uses 46 | {$IFnDEF FPC} 47 | Generics.Collections, Windows, 48 | {$ELSE} 49 | LCLIntf, LCLType, IntegerList, 50 | {$ENDIF} 51 | SysUtils, 52 | Forms, 53 | Classes, 54 | DiffTypes, 55 | Diff_ND, 56 | Diff_NP; 57 | 58 | type 59 | TDiff = class(TComponent) 60 | private 61 | FCancelled: boolean; 62 | FExecuting: boolean; 63 | FDiffAlgorithm: TDiffAlgorithm; 64 | FDiff_ND: TNDDiff; 65 | FDiff_NP: TNPDiff; 66 | function GetCompareCount: integer; 67 | function GetCompare(index: integer): TCompareRec; 68 | function GetDiffStats: TDiffStats; 69 | public 70 | constructor Create(aOwner: TComponent); override; 71 | destructor Destroy; override; 72 | 73 | // Compare strings or list of Cardinals ... 74 | {$IFDEF FPC} 75 | function Execute(const alist1, alist2: TCardinalList; const aDiffAlgorithm: TDiffAlgorithm = algND): boolean; overload; 76 | {$ELSE} 77 | function Execute(const alist1, alist2: TList<Cardinal>; const aDiffAlgorithm: TDiffAlgorithm = algND): boolean; 78 | overload; 79 | {$ENDIF} 80 | function Execute(const s1, s2: string; const aDiffAlgorithm: TDiffAlgorithm = algND; const bIgnoreCase: Boolean = 81 | False): boolean; overload; 82 | 83 | // Cancel allows interrupting excessively prolonged comparisons 84 | procedure Cancel; 85 | procedure Clear; 86 | property Cancelled: boolean read FCancelled; 87 | property Count: integer read GetCompareCount; 88 | property Compares[index: integer]: TCompareRec read GetCompare; default; 89 | property DiffAlgorithm: TDiffAlgorithm read FDiffAlgorithm write FDiffAlgorithm; 90 | property DiffStats: TDiffStats read GetDiffStats; 91 | end; 92 | 93 | procedure Register; 94 | 95 | implementation 96 | 97 | procedure Register; 98 | begin 99 | RegisterComponents('Samples', [TDiff]); 100 | end; 101 | 102 | constructor TDiff.Create(aOwner: TComponent); 103 | begin 104 | inherited; 105 | FDiff_ND := TNDDiff.Create(AOwner); 106 | FDiff_NP := TNPDiff.Create(AOwner); 107 | FDiffAlgorithm := algNP; 108 | end; 109 | //------------------------------------------------------------------------------ 110 | 111 | destructor TDiff.Destroy; 112 | begin 113 | // FDiff_ND.Free; 114 | // FDiff_NP.Free; 115 | inherited; 116 | end; 117 | //------------------------------------------------------------------------------ 118 | 119 | function TDiff.Execute(const s1, s2: string; const aDiffAlgorithm: TDiffAlgorithm = algND; const bIgnoreCase: Boolean = 120 | False): boolean; 121 | begin 122 | Result := not FExecuting; 123 | if not Result then exit; 124 | FCancelled := false; 125 | FExecuting := true; 126 | FDiffAlgorithm := aDiffAlgorithm; 127 | try 128 | if aDiffAlgorithm = algND then 129 | FDiff_ND.Execute(s1, s2, bIgnoreCase) 130 | else if aDiffAlgorithm = algNP then 131 | FDiff_NP.Execute(s1, s2, bIgnoreCase); 132 | finally 133 | FExecuting := false; 134 | end; 135 | end; 136 | //------------------------------------------------------------------------------ 137 | 138 | {$IFDEF FPC} 139 | function TDiff.Execute(const alist1, alist2: TCardinalList; const aDiffAlgorithm: TDiffAlgorithm): boolean; 140 | {$ELSE} 141 | function TDiff.Execute(const alist1, alist2: TList<Cardinal>; const aDiffAlgorithm: TDiffAlgorithm = algND): boolean; 142 | {$ENDIF} 143 | begin 144 | Result := not FExecuting; 145 | if not Result then exit; 146 | FCancelled := false; 147 | FExecuting := true; 148 | FDiffAlgorithm := aDiffAlgorithm; 149 | try 150 | if aDiffAlgorithm = algND then 151 | FDiff_ND.Execute(alist1, alist2) 152 | else if aDiffAlgorithm = algNP then 153 | FDiff_NP.Execute(alist1, alist2); 154 | finally 155 | FExecuting := false; 156 | end; 157 | end; 158 | //------------------------------------------------------------------------------ 159 | 160 | function TDiff.GetCompareCount: integer; 161 | begin 162 | if FDiffAlgorithm = algND then 163 | Result := FDiff_ND.CompareList.Count 164 | else 165 | Result := FDiff_NP.CompareList.count; 166 | end; 167 | //------------------------------------------------------------------------------ 168 | 169 | function TDiff.GetCompare(index: integer): TCompareRec; 170 | begin 171 | if FDiffAlgorithm = algND then 172 | Result := PCompareRec(FDiff_ND.CompareList[index])^ 173 | else if FDiffAlgorithm = algNP then 174 | Result := PCompareRec(FDiff_NP.CompareList[index])^; 175 | end; 176 | //------------------------------------------------------------------------------ 177 | 178 | procedure TDiff.Cancel; 179 | begin 180 | FCancelled := True; 181 | if FDiffAlgorithm = algND then 182 | FDiff_ND.Cancel 183 | else if FDiffAlgorithm = algNP then 184 | FDiff_NP.Cancel; 185 | end; 186 | 187 | procedure TDiff.Clear; 188 | begin 189 | if FDiffAlgorithm = algND then 190 | FDiff_ND.Clear 191 | else if FDiffAlgorithm = algNP then 192 | FDiff_NP.Clear; 193 | end; 194 | 195 | function TDiff.GetDiffStats: TDiffStats; 196 | begin 197 | if FDiffAlgorithm = algND then 198 | Result := FDiff_ND.DiffStats 199 | else if FDiffAlgorithm = algNP then 200 | Result := FDiff_NP.DiffStats; 201 | end; 202 | 203 | //------------------------------------------------------------------------------ 204 | 205 | end. 206 | -------------------------------------------------------------------------------- /src/DiffTypes.pas: -------------------------------------------------------------------------------- 1 | unit DiffTypes; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | {$IFnDEF FPC} 11 | Generics.Collections, Windows, 12 | {$ELSE} 13 | LCLIntf, LCLType, FGL, 14 | {$ENDIF} 15 | SysUtils, 16 | Math, 17 | Forms, 18 | Classes; 19 | 20 | const 21 | MAX_DIAGONAL = $FFFFFF; //~16 million 22 | 23 | type 24 | TDiffAlgorithm = (algND,algNP); 25 | 26 | P8Bits = PByte; 27 | 28 | PDiags = ^TDiags; 29 | TDiags = array [-MAX_DIAGONAL .. MAX_DIAGONAL] of integer; 30 | 31 | TChangeKind = (ckNone, ckAdd, ckDelete, ckModify); 32 | 33 | PCompareRec = ^TCompareRec; 34 | TCompareRec = record 35 | Kind : TChangeKind; 36 | oldIndex1, 37 | oldIndex2 : integer; 38 | case boolean of 39 | false : (chr1, chr2 : Char); 40 | true : (int1, int2 : integer); 41 | end; 42 | 43 | PDiffVars = ^TDiffVars; 44 | TDiffVars = record 45 | offset1 : integer; 46 | offset2 : integer; 47 | len1 : integer; 48 | len2 : integer; 49 | end; 50 | 51 | TDiffStats = record 52 | matches : integer; 53 | adds : integer; 54 | deletes : integer; 55 | modifies : integer; 56 | end; 57 | 58 | implementation 59 | 60 | 61 | 62 | end. 63 | -------------------------------------------------------------------------------- /src/Diff_ND.pas: -------------------------------------------------------------------------------- 1 | unit Diff_ND; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | (******************************************************************************* 8 | * Component TNDDiff * 9 | * Version: 5.20 * 10 | * Date: 1 May 2025 * 11 | * Compilers: Delphi 10.x * 12 | * Author: Angus Johnson - angusj-AT-myrealbox-DOT-com * 13 | * Copyright: � 2001-2009 Angus Johnson * 14 | * Updated by: Rickard Johansson (RJ TextEd) * 15 | * * 16 | * Licence to use, terms and conditions: * 17 | * The code in the TNDDiff component is released as freeware * 18 | * provided you agree to the following terms & conditions: * 19 | * 1. the copyright notice, terms and conditions are * 20 | * left unchanged * 21 | * 2. modifications to the code by other authors must be * 22 | * clearly documented and accompanied by the modifier's name. * 23 | * 3. the TNDDiff component may be freely compiled into binary* 24 | * format and no acknowledgement is required. However, a * 25 | * discrete acknowledgement would be appreciated (eg. in a * 26 | * program's 'About Box'). * 27 | * * 28 | * Description: Component to list differences between two integer arrays * 29 | * using a "longest common subsequence" algorithm. * 30 | * Typically, this component is used to diff 2 text files * 31 | * once their individuals lines have been hashed. * 32 | * * 33 | * Acknowledgements: The key algorithm in this component is based on: * 34 | * "An O(ND) Difference Algorithm and its Variations" * 35 | * By E Myers - Algorithmica Vol. 1 No. 2, 1986, pp. 251-266 * 36 | * http://www.cs.arizona.edu/people/gene/ * 37 | * http://www.cs.arizona.edu/people/gene/PAPERS/diff.ps * 38 | * * 39 | *******************************************************************************) 40 | 41 | 42 | (******************************************************************************* 43 | * History: * 44 | * 13 December 2001 - Original Release * 45 | * 22 April 2008 - Complete rewrite to greatly improve the code and * 46 | * provide a much simpler view of differences through a new * 47 | * 'Compares' property. * 48 | * 7 November 2009 - Updated so now compiles in newer versions of Delphi. * 49 | * * 50 | * 11 November 2018 - Added TList<Cardinal> to store hash values * 51 | * Made some minor code formatting and code changes * 52 | * 19 May 2020 Added Lazarus support * 53 | * 12 July 2023 Made some changes to enable switching algorithm between * 54 | * O(ND) and O(NP) and fixed several issues and range * 55 | * errors. * 56 | * * 57 | * 16 Apr 2025 Fixed an issue in Execute(const s1, s2: string) * 58 | * 1 May 2025 - Added option to ignore case when comparing strings using * 59 | * Execute(s1, s2, bIgnoreCase). * 60 | *******************************************************************************) 61 | 62 | interface 63 | 64 | uses 65 | {$IFnDEF FPC} 66 | Generics.Collections, Windows, 67 | {$ELSE} 68 | LCLIntf, LCLType, FGL, 69 | {$ENDIF} 70 | SysUtils, 71 | Math, 72 | Forms, 73 | Classes, 74 | DiffTypes; 75 | 76 | const 77 | //Maximum realistic deviation from centre diagonal vector ... 78 | MAX_DIAGONAL = $FFFFFF; //~16 million 79 | 80 | type 81 | {$IFDEF FPC} 82 | TIntegerList = TFPGList<Cardinal>; 83 | {$ENDIF} 84 | 85 | TNDDiff = class(TComponent) 86 | private 87 | FCompareList: TList; 88 | FCancelled: boolean; 89 | FExecuting: boolean; 90 | FDiagBuffer, bDiagBuffer: pointer; 91 | FStr1: string; 92 | FStr2: string; 93 | {$IFDEF FPC} 94 | FList1: TIntegerList; 95 | FList2: TIntegerList; 96 | {$ELSE} 97 | FList1: TList<Cardinal>; 98 | FList2: TList<Cardinal>; 99 | {$ENDIF} 100 | LastCompareRec: TCompareRec; 101 | fDiag, bDiag: PDiags; 102 | fDiffStats: TDiffStats; 103 | FIgnoreCase: Boolean; 104 | procedure InitDiagArrays(MaxOscill, len1, len2: integer); 105 | //nb: To optimize speed, separate functions are called for either 106 | //integer or character compares ... 107 | procedure RecursiveDiffChr(offset1, offset2, len1, len2: integer); 108 | procedure AddChangeChrs(offset1, range: integer; ChangeKind: TChangeKind); 109 | procedure RecursiveDiffInt(offset1, offset2, len1, len2: integer); 110 | procedure AddChangeInts(offset1, range: integer; ChangeKind: TChangeKind); 111 | function CompareChr(const ch1, ch2: Char): Boolean; 112 | 113 | function GetCompareCount: integer; 114 | function GetCompare(index: integer): TCompareRec; 115 | public 116 | constructor Create(aOwner: TComponent); override; 117 | destructor Destroy; override; 118 | 119 | // Compare strings or list of Cardinals ... 120 | {$IFDEF FPC} 121 | function Execute(const alist1, alist2: TIntegerList): boolean; overload; 122 | {$ELSE} 123 | function Execute(const alist1, alist2: TList<Cardinal>): boolean; overload; 124 | {$ENDIF} 125 | function Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; overload; 126 | 127 | // Cancel allows interrupting excessively prolonged comparisons 128 | procedure Cancel; 129 | procedure Clear; 130 | 131 | property Cancelled: boolean read fCancelled; 132 | property CompareList: TList read FCompareList write FCompareList; 133 | property Count: integer read GetCompareCount; 134 | property Compares[index: integer]: TCompareRec read GetCompare; default; 135 | property DiffStats: TDiffStats read fDiffStats; 136 | end; 137 | 138 | implementation 139 | 140 | uses 141 | System.Character; 142 | 143 | constructor TNDDiff.Create(aOwner: TComponent); 144 | begin 145 | inherited; 146 | fCompareList := TList.create; 147 | FIgnoreCase := False; 148 | end; 149 | //------------------------------------------------------------------------------ 150 | 151 | destructor TNDDiff.Destroy; 152 | begin 153 | Clear; 154 | fCompareList.free; 155 | inherited; 156 | end; 157 | //------------------------------------------------------------------------------ 158 | 159 | function TNDDiff.Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; 160 | var 161 | maxOscill, x1,x2, savedLen: integer; 162 | compareRec: PCompareRec; 163 | len1,len2: Integer; 164 | l1,l2: Integer; 165 | begin 166 | result := not fExecuting; 167 | if not result then exit; 168 | fExecuting := true; 169 | fCancelled := false; 170 | FIgnoreCase := bIgnoreCase; 171 | try 172 | Clear; 173 | len1 := Length(s1); 174 | len2 := Length(s2); 175 | 176 | //save first string length for later (ie for any trailing matches) ... 177 | savedLen := len1; 178 | 179 | //setup the character arrays ... 180 | FStr1 := s1; 181 | FStr2 := s2; 182 | 183 | //ignore top matches ... 184 | x1:= 1; x2 := 1; 185 | while (len1 > 0) and (len2 > 0) and CompareChr(FStr1[len1], FStr2[len2]) do 186 | begin 187 | dec(len1); dec(len2); 188 | end; 189 | 190 | //if something doesn't match ... 191 | if (len1 <> 0) or (len2 <> 0) then 192 | begin 193 | //ignore bottom of matches too ... 194 | l1 := len1; l2 := len2; 195 | while (len1 > 0) and (len2 > 0) and (x1 > 0) and (x2 > 0) and (x1 <= Length(FStr1)) and (x2 <= Length(FStr2)) and CompareChr(FStr1[x1], FStr2[x2]) do 196 | begin 197 | if (x1 < Length(FStr1)) and (x2 < Length(FStr2)) and not CompareChr(FStr1[x1+1], FStr2[x2+1]) and (CompareChr(FStr1[x1], FStr1[x1+1]) or CompareChr(FStr1[x1], FStr2[x2+1])) then 198 | begin 199 | // Reset if we have strings like 200 | // 201 | // aaabc : aabcd 202 | // 203 | // Character 3 is still the same 'a' in string 1 but different 'b' in string 2. The algorithm needs to handle this 204 | // so reset x1 and x2 to 1. 205 | x1:= 1; 206 | x2 := 1; 207 | len1 := l1; 208 | len2 := l2; 209 | Break; 210 | end; 211 | dec(len1); dec(len2); 212 | inc(x1); inc(x2); 213 | end; 214 | 215 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 216 | fCompareList.Capacity := len1 + len2; 217 | 218 | //nb: the Diag arrays are extended by 1 at each end to avoid testing 219 | //for array limits. Hence '+3' because will also includes Diag[0] ... 220 | GetMem(fDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 221 | GetMem(bDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 222 | try 223 | RecursiveDiffChr(x1, x2, len1, len2); 224 | finally 225 | freeMem(fDiagBuffer); 226 | freeMem(bDiagBuffer); 227 | end; 228 | end; 229 | 230 | if fCancelled then 231 | begin 232 | result := false; 233 | Clear; 234 | exit; 235 | end; 236 | 237 | //finally, append any trailing matches onto compareList ... 238 | if LastCompareRec.oldIndex1 < 0 then LastCompareRec.oldIndex1 := 0; 239 | if LastCompareRec.oldIndex2 < 0 then LastCompareRec.oldIndex2 := 0; 240 | while (LastCompareRec.oldIndex1 < savedLen) do 241 | begin 242 | with LastCompareRec do 243 | begin 244 | Kind := ckNone; 245 | inc(oldIndex1); 246 | inc(oldIndex2); 247 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 248 | chr1 := FStr1[oldIndex1]; 249 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 250 | chr2 := FStr2[oldIndex2]; 251 | end; 252 | New(compareRec); 253 | compareRec^ := LastCompareRec; 254 | fCompareList.Add(compareRec); 255 | inc(fDiffStats.matches); 256 | end; 257 | finally 258 | fExecuting := false; 259 | end; 260 | 261 | end; 262 | //------------------------------------------------------------------------------ 263 | 264 | {$IFDEF FPC} 265 | function TNDDiff.Execute(const alist1, alist2: TIntegerList): boolean; 266 | {$ELSE} 267 | function TNDDiff.Execute(const alist1, alist2: TList<Cardinal>): boolean; 268 | {$ENDIF} 269 | var 270 | maxOscill, x1,x2, savedLen: integer; 271 | compareRec: PCompareRec; 272 | len1,len2: Integer; 273 | begin 274 | result := not fExecuting; 275 | if not result then exit; 276 | fExecuting := true; 277 | fCancelled := false; 278 | try 279 | Clear; 280 | 281 | //setup the character arrays ... 282 | FList1 := alist1; 283 | FList2 := alist2; 284 | len1 := FList1.Count; 285 | len2 := FList2.Count; 286 | 287 | //save first string length for later (ie for any trailing matches) ... 288 | savedLen := len1-1; 289 | 290 | //ignore top matches ... 291 | x1:= 0; x2 := 0; 292 | while (len1 > 0) and (len2 > 0) and (FList1[len1-1] = FList2[len2-1]) do 293 | begin 294 | dec(len1); dec(len2); 295 | end; 296 | 297 | //if something doesn't match ... 298 | if (len1 <> 0) or (len2 <> 0) then 299 | begin 300 | 301 | //ignore bottom of matches too ... 302 | while (len1 > 0) and (len2 > 0) and (FList1[x1] = FList2[x2]) do 303 | begin 304 | dec(len1); dec(len2); 305 | inc(x1); inc(x2); 306 | end; 307 | 308 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 309 | fCompareList.Capacity := len1 + len2; 310 | 311 | //nb: the Diag arrays are extended by 1 at each end to avoid testing 312 | //for array limits. Hence '+3' because will also includes Diag[0] ... 313 | GetMem(fDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 314 | GetMem(bDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 315 | try 316 | RecursiveDiffInt(x1, x2, len1, len2); 317 | finally 318 | freeMem(fDiagBuffer); 319 | freeMem(bDiagBuffer); 320 | end; 321 | end; 322 | 323 | if fCancelled then 324 | begin 325 | result := false; 326 | Clear; 327 | exit; 328 | end; 329 | 330 | //finally, append any trailing matches onto compareList ... 331 | while (LastCompareRec.oldIndex1 < savedLen) do 332 | begin 333 | with LastCompareRec do 334 | begin 335 | Kind := ckNone; 336 | inc(oldIndex1); 337 | inc(oldIndex2); 338 | int1 := Integer(FList1[oldIndex1]); 339 | int2 := Integer(FList2[oldIndex2]); 340 | end; 341 | New(compareRec); 342 | compareRec^ := LastCompareRec; 343 | fCompareList.Add(compareRec); 344 | inc(fDiffStats.matches); 345 | end; 346 | finally 347 | fExecuting := false; 348 | end; 349 | 350 | end; 351 | //------------------------------------------------------------------------------ 352 | 353 | procedure TNDDiff.InitDiagArrays(MaxOscill, len1, len2: integer); 354 | var 355 | diag: integer; 356 | begin 357 | inc(maxOscill); //for the extra diag at each end of the arrays ... 358 | P8Bits(fDiag) := P8Bits(fDiagBuffer) - sizeof(integer)*(MAX_DIAGONAL-maxOscill); 359 | P8Bits(bDiag) := P8Bits(bDiagBuffer) - sizeof(integer)*(MAX_DIAGONAL-maxOscill); 360 | //initialize Diag arrays (assumes 0 based arrays) ... 361 | for diag := - maxOscill to maxOscill do fDiag[diag] := -MAXINT; 362 | fDiag[0] := -1; 363 | for diag := - maxOscill to maxOscill do bDiag[diag] := MAXINT; 364 | bDiag[len1 - len2] := len1-1; 365 | end; 366 | //------------------------------------------------------------------------------ 367 | 368 | procedure TNDDiff.RecursiveDiffChr(offset1, offset2, len1, len2: integer); 369 | var 370 | diag, lenDelta, Oscill, maxOscill, x1, x2: integer; 371 | begin 372 | //nb: the possible depth of recursion here is most unlikely to cause 373 | // problems with stack overflows. 374 | // application.processmessages; 375 | if fCancelled then exit; 376 | 377 | if (len1 = 0) then 378 | begin 379 | AddChangeChrs(offset1, len2, ckAdd); 380 | exit; 381 | end 382 | else if (len2 = 0) then 383 | begin 384 | AddChangeChrs(offset1, len1, ckDelete); 385 | exit; 386 | end 387 | else if (len1 = 1) and (len2 = 1) then 388 | begin 389 | AddChangeChrs(offset1, 1, ckDelete); 390 | AddChangeChrs(offset1, 1, ckAdd); 391 | exit; 392 | end; 393 | 394 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 395 | InitDiagArrays(MaxOscill, len1, len2); 396 | lenDelta := len1 -len2; 397 | 398 | Oscill := 1; //ie assumes prior filter of top and bottom matches 399 | while Oscill <= maxOscill do 400 | begin 401 | 402 | if (Oscill mod 200) = 0 then 403 | begin 404 | application.processmessages; 405 | if fCancelled then exit; 406 | end; 407 | 408 | //do forward oscillation (keeping diag within assigned grid)... 409 | diag := Oscill; 410 | while diag > len1 do dec(diag,2); 411 | while diag >= max(- Oscill, -len2) do 412 | begin 413 | if fDiag[diag-1] < fDiag[diag+1] then 414 | x1 := fDiag[diag+1] 415 | else 416 | x1 := fDiag[diag-1]+1; 417 | x2 := x1 - diag; 418 | while (x1 < len1-1) and (x2 < len2-1) and (offset1+x1+1 > 0) and (offset2+x2+1 > 0) and 419 | (offset1+x1+1 <= Length(FStr1)) and (offset2+x2+1 <= Length(FStr2)) and CompareChr(FStr1[offset1+x1+1], FStr2[offset2+x2+1]) do 420 | begin 421 | inc(x1); inc(x2); 422 | end; 423 | fDiag[diag] := x1; 424 | 425 | //nb: (fDiag[diag] is always < bDiag[diag]) here when NOT odd(lenDelta) ... 426 | if odd(lenDelta) and (fDiag[diag] >= bDiag[diag]) then 427 | begin 428 | inc(x1);inc(x2); 429 | //save x1 & x2 for second recursive_diff() call by reusing no longer 430 | //needed variables (ie minimize variable allocation in recursive fn) ... 431 | diag := x1; Oscill := x2; 432 | while (x1 > 0) and (x2 > 0) and (offset1+x1+1 > 0) and (offset2+x2-1 > 0) and 433 | (offset1+x1-1 <= Length(FStr1)) and (offset2+x2-1 <= Length(FStr2)) and CompareChr(FStr1[offset1+x1-1], FStr2[offset2+x2-1]) do 434 | begin 435 | dec(x1); dec(x2); 436 | end; 437 | RecursiveDiffChr(offset1, offset2, x1, x2); 438 | x1 := diag; x2 := Oscill; 439 | RecursiveDiffChr(offset1+x1, offset2+x2, len1-x1, len2-x2); 440 | exit; //ALL DONE 441 | end; 442 | dec(diag,2); 443 | end; 444 | 445 | //do backward oscillation (keeping diag within assigned grid)... 446 | diag := lenDelta + Oscill; 447 | while diag > len1 do dec(diag,2); 448 | while diag >= max(lenDelta - Oscill, -len2) do 449 | begin 450 | if bDiag[diag-1] < bDiag[diag+1] then 451 | x1 := bDiag[diag-1] else 452 | x1 := bDiag[diag+1]-1; 453 | x2 := x1 - diag; 454 | while (offset1+x1 > 0) and (offset2+x2 > 0) and (offset1+x1 <= Length(FStr1)) and (offset2+x2 <= Length(FStr1)) and 455 | CompareChr(FStr1[offset1+x1], FStr2[offset2+x2]) do 456 | begin 457 | dec(x1); dec(x2); 458 | end; 459 | bDiag[diag] := x1; 460 | 461 | if bDiag[diag] <= fDiag[diag] then 462 | begin 463 | //flag return value then ... 464 | inc(x1);inc(x2); 465 | RecursiveDiffChr(offset1, offset2, x1, x2); 466 | while (x1 < len1) and (x2 < len2) and (offset1+x1 <= Length(FStr1)) and (offset2+x2 <= Length(FStr1)) and 467 | CompareChr(FStr1[offset1+x1], FStr2[offset2+x2]) do 468 | begin 469 | inc(x1); inc(x2); 470 | end; 471 | RecursiveDiffChr(offset1+x1, offset2+x2, len1-x1, len2-x2); 472 | exit; //ALL DONE 473 | end; 474 | dec(diag,2); 475 | end; 476 | 477 | inc(Oscill); 478 | end; //while Oscill <= maxOscill 479 | 480 | raise Exception.create('oops - error in RecursiveDiffChr()'); 481 | end; 482 | //------------------------------------------------------------------------------ 483 | 484 | procedure TNDDiff.RecursiveDiffInt(offset1, offset2, len1, len2: integer); 485 | var 486 | diag, lenDelta, Oscill, maxOscill, x1, x2: integer; 487 | begin 488 | //nb: the possible depth of recursion here is most unlikely to cause 489 | // problems with stack overflows. 490 | // application.processmessages; 491 | if fCancelled then exit; 492 | 493 | if (len1 = 0) then 494 | begin 495 | assert(len2 > 0,'oops!'); 496 | AddChangeInts(offset1, len2, ckAdd); 497 | exit; 498 | end 499 | else if (len2 = 0) then 500 | begin 501 | AddChangeInts(offset1, len1, ckDelete); 502 | exit; 503 | end 504 | else if (len1 = 1) and (len2 = 1) then 505 | begin 506 | assert(FList1[offset1] <> FList2[offset2],'oops!'); 507 | AddChangeInts(offset1, 1, ckDelete); 508 | AddChangeInts(offset1, 1, ckAdd); 509 | exit; 510 | end; 511 | 512 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 513 | InitDiagArrays(MaxOscill, len1, len2); 514 | lenDelta := len1 -len2; 515 | 516 | Oscill := 1; //ie assumes prior filter of top and bottom matches 517 | while Oscill <= maxOscill do 518 | begin 519 | 520 | if (Oscill mod 200) = 0 then 521 | begin 522 | application.processmessages; 523 | if fCancelled then exit; 524 | end; 525 | 526 | //do forward oscillation (keeping diag within assigned grid)... 527 | diag := Oscill; 528 | while diag > len1 do dec(diag,2); 529 | while diag >= max(- Oscill, -len2) do 530 | begin 531 | if fDiag[diag-1] < fDiag[diag+1] then 532 | x1 := fDiag[diag+1] else 533 | x1 := fDiag[diag-1]+1; 534 | x2 := x1 - diag; 535 | while (x1 < len1-1) and (x2 < len2-1) and 536 | (FList1[offset1+x1+1] = FList2[offset2+x2+1]) do 537 | begin 538 | inc(x1); inc(x2); 539 | end; 540 | fDiag[diag] := x1; 541 | 542 | //nb: (fDiag[diag] is always < bDiag[diag]) here when NOT odd(lenDelta) ... 543 | if odd(lenDelta) and (fDiag[diag] >= bDiag[diag]) then 544 | begin 545 | inc(x1);inc(x2); 546 | //save x1 & x2 for second recursive_diff() call by reusing no longer 547 | //needed variables (ie minimize variable allocation in recursive fn) ... 548 | diag := x1; Oscill := x2; 549 | while (x1 > 0) and (x2 > 0) and (FList1[offset1+x1-1] = FList2[offset2+x2-1]) do 550 | begin 551 | dec(x1); dec(x2); 552 | end; 553 | RecursiveDiffInt(offset1, offset2, x1, x2); 554 | x1 := diag; x2 := Oscill; 555 | RecursiveDiffInt(offset1+x1, offset2+x2, len1-x1, len2-x2); 556 | exit; //ALL DONE 557 | end; 558 | dec(diag,2); 559 | end; 560 | 561 | //do backward oscillation (keeping diag within assigned grid)... 562 | diag := lenDelta + Oscill; 563 | while diag > len1 do dec(diag,2); 564 | while diag >= max(lenDelta - Oscill, -len2) do 565 | begin 566 | if bDiag[diag-1] < bDiag[diag+1] then 567 | x1 := bDiag[diag-1] else 568 | x1 := bDiag[diag+1]-1; 569 | x2 := x1 - diag; 570 | while (x1 > -1) and (x2 > -1) and (FList1[offset1+x1] = FList2[offset2+x2]) do 571 | begin 572 | dec(x1); dec(x2); 573 | end; 574 | bDiag[diag] := x1; 575 | 576 | if bDiag[diag] <= fDiag[diag] then 577 | begin 578 | //flag return value then ... 579 | inc(x1);inc(x2); 580 | RecursiveDiffInt(offset1, offset2, x1, x2); 581 | while (x1 < len1) and (x2 < len2) and 582 | (FList1[offset1+x1] = FList2[offset2+x2]) do 583 | begin 584 | inc(x1); inc(x2); 585 | end; 586 | RecursiveDiffInt(offset1+x1, offset2+x2, len1-x1, len2-x2); 587 | exit; //ALL DONE 588 | end; 589 | dec(diag,2); 590 | end; 591 | 592 | inc(Oscill); 593 | end; //while Oscill <= maxOscill 594 | 595 | raise Exception.create('oops - error in RecursiveDiffInt()'); 596 | end; 597 | //------------------------------------------------------------------------------ 598 | 599 | procedure TNDDiff.Clear; 600 | var 601 | i: integer; 602 | begin 603 | for i := 0 to fCompareList.Count-1 do 604 | dispose(PCompareRec(fCompareList[i])); 605 | fCompareList.clear; 606 | LastCompareRec.Kind := ckNone; 607 | LastCompareRec.oldIndex1 := -1; 608 | LastCompareRec.oldIndex2 := -1; 609 | fDiffStats.matches := 0; 610 | fDiffStats.adds := 0; 611 | fDiffStats.deletes :=0; 612 | fDiffStats.modifies :=0; 613 | end; 614 | //------------------------------------------------------------------------------ 615 | 616 | function TNDDiff.GetCompareCount: integer; 617 | begin 618 | result := fCompareList.count; 619 | end; 620 | //------------------------------------------------------------------------------ 621 | 622 | function TNDDiff.GetCompare(index: integer): TCompareRec; 623 | begin 624 | result := PCompareRec(fCompareList[index])^; 625 | end; 626 | //------------------------------------------------------------------------------ 627 | 628 | procedure TNDDiff.AddChangeChrs(offset1, range: integer; ChangeKind: TChangeKind); 629 | var 630 | i,j: integer; 631 | compareRec: PCompareRec; 632 | begin 633 | //first, add any unchanged items into this list ... 634 | if LastCompareRec.oldIndex1 < 0 then LastCompareRec.oldIndex1 := 0; 635 | if LastCompareRec.oldIndex2 < 0 then LastCompareRec.oldIndex2 := 0; 636 | while (LastCompareRec.oldIndex1 < offset1 -1) do 637 | begin 638 | with LastCompareRec do 639 | begin 640 | chr1 := #0; 641 | chr2 := #0; 642 | Kind := ckNone; 643 | inc(oldIndex1); 644 | inc(oldIndex2); 645 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 646 | chr1 := FStr1[oldIndex1]; 647 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 648 | chr2 := FStr2[oldIndex2]; 649 | end; 650 | New(compareRec); 651 | compareRec^ := LastCompareRec; 652 | fCompareList.Add(compareRec); 653 | inc(fDiffStats.matches); 654 | end; 655 | 656 | case ChangeKind of 657 | ckNone: 658 | for i := 1 to range do 659 | begin 660 | with LastCompareRec do 661 | begin 662 | Kind := ckNone; 663 | inc(oldIndex1); 664 | inc(oldIndex2); 665 | chr1 := FStr1[oldIndex1]; 666 | chr2 := FStr2[oldIndex2]; 667 | end; 668 | New(compareRec); 669 | compareRec^ := LastCompareRec; 670 | FCompareList.Add(compareRec); 671 | inc(FDiffStats.matches); 672 | end; 673 | ckAdd : 674 | begin 675 | for i := 1 to range do 676 | begin 677 | with LastCompareRec do 678 | begin 679 | 680 | //check if a range of adds are following a range of deletes 681 | //and convert them to modifies ... 682 | if Kind = ckDelete then 683 | begin 684 | j := fCompareList.Count -1; 685 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckDelete) do 686 | dec(j); 687 | PCompareRec(fCompareList[j]).Kind := ckModify; 688 | dec(fDiffStats.deletes); 689 | inc(fDiffStats.modifies); 690 | inc(LastCompareRec.oldIndex2); 691 | PCompareRec(fCompareList[j]).oldIndex2 := LastCompareRec.oldIndex2; 692 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 693 | PCompareRec(fCompareList[j]).chr2 := FStr2[oldIndex2]; 694 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 695 | continue; 696 | end; 697 | 698 | Kind := ckAdd; 699 | chr1 := #0; 700 | inc(oldIndex2); 701 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 702 | chr2 := Char(FStr2[oldIndex2]); //ie what we added 703 | end; 704 | New(compareRec); 705 | compareRec^ := LastCompareRec; 706 | fCompareList.Add(compareRec); 707 | inc(fDiffStats.adds); 708 | end; 709 | end; 710 | ckDelete : 711 | begin 712 | for i := 1 to range do 713 | begin 714 | with LastCompareRec do 715 | begin 716 | 717 | //check if a range of deletes are following a range of adds 718 | //and convert them to modifies ... 719 | if Kind = ckAdd then 720 | begin 721 | j := fCompareList.Count -1; 722 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckAdd) do 723 | dec(j); 724 | PCompareRec(fCompareList[j]).Kind := ckModify; 725 | dec(fDiffStats.adds); 726 | inc(fDiffStats.modifies); 727 | inc(LastCompareRec.oldIndex1); 728 | PCompareRec(fCompareList[j]).oldIndex1 := LastCompareRec.oldIndex1; 729 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 730 | PCompareRec(fCompareList[j]).chr1 := FStr1[oldIndex1]; 731 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 732 | continue; 733 | end; 734 | 735 | Kind := ckDelete; 736 | chr2 := #0; 737 | inc(oldIndex1); 738 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 739 | chr1 := FStr1[oldIndex1]; //ie what we deleted 740 | end; 741 | New(compareRec); 742 | compareRec^ := LastCompareRec; 743 | fCompareList.Add(compareRec); 744 | inc(fDiffStats.deletes); 745 | end; 746 | end; 747 | end; 748 | end; 749 | //------------------------------------------------------------------------------ 750 | 751 | procedure TNDDiff.AddChangeInts(offset1, range: integer; ChangeKind: TChangeKind); 752 | var 753 | i,j: integer; 754 | compareRec: PCompareRec; 755 | begin 756 | //first, add any unchanged items into this list ... 757 | while (LastCompareRec.oldIndex1 < offset1 -1) do 758 | begin 759 | with LastCompareRec do 760 | begin 761 | Kind := ckNone; 762 | inc(oldIndex1); 763 | inc(oldIndex2); 764 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 765 | int1 := Integer(FList1[oldIndex1]); 766 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 767 | int2 := Integer(FList2[oldIndex2]); 768 | end; 769 | New(compareRec); 770 | compareRec^ := LastCompareRec; 771 | fCompareList.Add(compareRec); 772 | inc(fDiffStats.matches); 773 | end; 774 | 775 | case ChangeKind of 776 | ckAdd : 777 | begin 778 | for i := 1 to range do 779 | begin 780 | with LastCompareRec do 781 | begin 782 | 783 | //check if a range of adds are following a range of deletes 784 | //and convert them to modifies ... 785 | if Kind = ckDelete then 786 | begin 787 | j := fCompareList.Count -1; 788 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckDelete) do 789 | dec(j); 790 | PCompareRec(fCompareList[j]).Kind := ckModify; 791 | dec(fDiffStats.deletes); 792 | inc(fDiffStats.modifies); 793 | inc(LastCompareRec.oldIndex2); 794 | PCompareRec(fCompareList[j]).oldIndex2 := LastCompareRec.oldIndex2; 795 | PCompareRec(fCompareList[j]).int2 := Integer(FList2[oldIndex2]); 796 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 797 | continue; 798 | end; 799 | 800 | Kind := ckAdd; 801 | int1 := $0; 802 | inc(oldIndex2); 803 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 804 | int2 := Integer(FList2[oldIndex2]); //ie what we added 805 | end; 806 | New(compareRec); 807 | compareRec^ := LastCompareRec; 808 | fCompareList.Add(compareRec); 809 | inc(fDiffStats.adds); 810 | end; 811 | end; 812 | ckDelete : 813 | begin 814 | for i := 1 to range do 815 | begin 816 | with LastCompareRec do 817 | begin 818 | 819 | //check if a range of deletes are following a range of adds 820 | //and convert them to modifies ... 821 | if Kind = ckAdd then 822 | begin 823 | j := fCompareList.Count -1; 824 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckAdd) do 825 | dec(j); 826 | PCompareRec(fCompareList[j]).Kind := ckModify; 827 | dec(fDiffStats.adds); 828 | inc(fDiffStats.modifies); 829 | inc(LastCompareRec.oldIndex1); 830 | PCompareRec(fCompareList[j]).oldIndex1 := LastCompareRec.oldIndex1; 831 | PCompareRec(fCompareList[j]).int1 := Integer(FList1[oldIndex1]); 832 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 833 | continue; 834 | end; 835 | 836 | Kind := ckDelete; 837 | int2 := $0; 838 | inc(oldIndex1); 839 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 840 | int1 := Integer(FList1[oldIndex1]); //ie what we deleted 841 | end; 842 | New(compareRec); 843 | compareRec^ := LastCompareRec; 844 | fCompareList.Add(compareRec); 845 | inc(fDiffStats.deletes); 846 | end; 847 | end; 848 | end; 849 | end; 850 | //------------------------------------------------------------------------------ 851 | 852 | procedure TNDDiff.Cancel; 853 | begin 854 | fCancelled := true; 855 | end; 856 | 857 | function TNDDiff.CompareChr(const ch1, ch2: Char): Boolean; 858 | begin 859 | if FIgnoreCase then 860 | Result := (ch1.ToLower = ch2.ToLower) 861 | else 862 | Result := (ch1 = ch2); 863 | end; 864 | 865 | //------------------------------------------------------------------------------ 866 | 867 | end. 868 | -------------------------------------------------------------------------------- /src/Diff_NP.pas: -------------------------------------------------------------------------------- 1 | unit Diff_NP; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | (******************************************************************************* 8 | * Component TNPDiff * 9 | * Version: 5.20 * 10 | * Date: 01 May 2025 * 11 | * Compilers: Delphi 10.x * 12 | * Author: Angus Johnson - angusj-AT-myrealbox-DOT-com * 13 | * Copyright: © 2001-2009 Angus Johnson * 14 | * Updated by: Rickard Johansson (RJ TextEd) * 15 | * * 16 | * Licence to use, terms and conditions: * 17 | * The code in the TNPDiff component is released as freeware * 18 | * provided you agree to the following terms & conditions: * 19 | * 1. the copyright notice, terms and conditions are * 20 | * left unchanged * 21 | * 2. modifications to the code by other authors must be * 22 | * clearly documented and accompanied by the modifier's name. * 23 | * 3. the TNPDiff component may be freely compiled into binary* 24 | * format and no acknowledgement is required. However, a * 25 | * discrete acknowledgement would be appreciated (eg. in a * 26 | * program's 'About Box'). * 27 | * * 28 | * Description: Component to list differences between two integer arrays * 29 | * using a "longest common subsequence" algorithm. * 30 | * Typically, this component is used to diff 2 text files * 31 | * once their individuals lines have been hashed. * 32 | * * 33 | * Acknowledgements: The key algorithm in this component is based on: * 34 | * "An O(NP) Sequence Comparison Algorithm" * 35 | * by Sun Wu, Udi Manber & Gene Myers * 36 | * and uses a "divide-and-conquer" technique to avoid * 37 | * using exponential amounts of memory as described in * 38 | * "An O(ND) Difference Algorithm and its Variations" * 39 | * By E Myers - Algorithmica Vol. 1 No. 2, 1986, pp. 251-266 * 40 | *******************************************************************************) 41 | 42 | (******************************************************************************* 43 | * History: * 44 | * 13 December 2001 - Original release (used Myer's O(ND) Difference Algorithm) * 45 | * 22 April 2008 - Complete rewrite to greatly improve the code and * 46 | * provide a much simpler view of differences through a new * 47 | * 'Compares' property. * 48 | * 21 May 2008 - Another complete code rewrite to use Sun Wu et al.'s * 49 | * O(NP) Sequence Comparison Algorithm which more than * 50 | * halves times of typical comparisons. * 51 | * 24 May 2008 - Reimplemented "divide-and-conquer" technique (which was * 52 | * omitted in 21 May release) so memory use is again minimal.* 53 | * 25 May 2008 - Removed recursion to avoid the possibility of running out * 54 | * of stack memory during massive comparisons. * 55 | * 2 June 2008 - Bugfix: incorrect number of appended AddChangeInt() calls * 56 | * in Execute() for integer arrays. (It was OK with Chars) * 57 | * Added check to prevent repeat calls to Execute() while * 58 | * already executing. * 59 | * Added extra parse of differences to find occasional * 60 | * missed matches. (See readme.txt for further discussion) * 61 | * 7 November 2009 - Updated so now compiles in newer versions of Delphi. * 62 | * * 63 | * 11 November 2018 - Added TList<Cardinal> to store hash values * 64 | * Made some minor code formatting and code changes * 65 | * 19 May 2020 Added Lazarus support * 66 | * 23 May 2020 - Minor changes and fixed an issue in AddChangeChr() * 67 | * 12 July 2023 Made some changes to enable switching algorithm between * 68 | * O(ND) and O(NP). * 69 | * 1 May 2025 - Added option to ignore case when comparing strings using * 70 | * Execute(s1, s2, bIgnoreCase). * 71 | *******************************************************************************) 72 | 73 | interface 74 | 75 | uses 76 | {$IFnDEF FPC} 77 | Generics.Collections, Windows, 78 | {$ELSE} 79 | LCLIntf, LCLType, Fgl, IntegerList, 80 | {$ENDIF} 81 | SysUtils, 82 | Forms, 83 | Classes, 84 | DiffTypes; 85 | 86 | const 87 | MAX_DIAGONAL = $FFFFFF; //~16 million 88 | 89 | type 90 | {.$IFDEF FPC} 91 | //TIntegerList = TFPGList<Cardinal>; 92 | {.$ENDIF} 93 | 94 | TNPDiff = class(TComponent) 95 | private 96 | FCompareList: TList; 97 | FDiffList: TList; //this TList circumvents the need for recursion 98 | FCancelled: boolean; 99 | FExecuting: boolean; 100 | FCompareInts: boolean; //ie are we comparing integer arrays or char arrays 101 | DiagBufferF: pointer; 102 | DiagBufferB: pointer; 103 | DiagF, DiagB: PDiags; 104 | FDiffStats: TDiffStats; 105 | FIgnoreCase: Boolean; 106 | FLastCompareRec: TCompareRec; 107 | {$IFDEF FPC} 108 | FList1: TCardinalList; 109 | FList2: TCardinalList; 110 | {$ELSE} 111 | FList1: TList<Cardinal>; 112 | FList2: TList<Cardinal>; 113 | {$ENDIF} 114 | FStr1: string; 115 | FStr2: string; 116 | procedure PushDiff(offset1, offset2, len1, len2: integer); 117 | function PopDiff: boolean; 118 | procedure InitDiagArrays(len1, len2: integer); 119 | procedure DiffInt(offset1, offset2, len1, len2: integer); 120 | procedure DiffChr(offset1, offset2, len1, len2: integer); 121 | function SnakeChrF(k,offset1,offset2,len1,len2: integer): boolean; 122 | function SnakeChrB(k,offset1,offset2,len1,len2: integer): boolean; 123 | function SnakeIntF(k,offset1,offset2,len1,len2: integer): boolean; 124 | function SnakeIntB(k,offset1,offset2,len1,len2: integer): boolean; 125 | procedure AddChangeChr(offset1, range: integer; ChangeKind: TChangeKind); 126 | procedure AddChangeInt(offset1, range: integer; ChangeKind: TChangeKind); 127 | function CompareChr(const ch1, ch2: Char): Boolean; 128 | function GetCompareCount: integer; 129 | function GetCompare(index: integer): TCompareRec; 130 | public 131 | constructor Create(aOwner: TComponent); override; 132 | destructor Destroy; override; 133 | 134 | // Compare strings or list of Cardinals ... 135 | {$IFDEF FPC} 136 | function Execute(const alist1, alist2: TCardinalList): boolean; overload; 137 | {$ELSE} 138 | function Execute(const alist1, alist2: TList<Cardinal>): boolean; overload; 139 | {$ENDIF} 140 | function Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; overload; 141 | // Cancel allows interrupting excessively prolonged comparisons 142 | procedure Cancel; 143 | procedure Clear; 144 | property Cancelled: boolean read FCancelled; 145 | property CompareList: TList read FCompareList write FCompareList; 146 | property Count: integer read GetCompareCount; 147 | property Compares[index: integer]: TCompareRec read GetCompare; default; 148 | property DiffStats: TDiffStats read FDiffStats; 149 | end; 150 | 151 | implementation 152 | 153 | uses 154 | System.Character; 155 | 156 | constructor TNPDiff.Create(aOwner: TComponent); 157 | begin 158 | inherited; 159 | FCompareList := TList.create; 160 | FDiffList := TList.Create; 161 | FIgnoreCase := False; 162 | end; 163 | //------------------------------------------------------------------------------ 164 | 165 | destructor TNPDiff.Destroy; 166 | begin 167 | Clear; 168 | FCompareList.free; 169 | FDiffList.Free; 170 | inherited; 171 | end; 172 | //------------------------------------------------------------------------------ 173 | 174 | {$IFDEF FPC} 175 | function TNPDiff.Execute(const alist1, alist2: TCardinalList): boolean; 176 | {$ELSE} 177 | function TNPDiff.Execute(const alist1, alist2: TList<Cardinal>): boolean; 178 | {$ENDIF} 179 | var 180 | i, Len1Minus1: integer; 181 | len1,len2: Integer; 182 | begin 183 | Result := not FExecuting; 184 | if not Result then exit; 185 | FCancelled := false; 186 | FExecuting := true; 187 | try 188 | FList1 := alist1; 189 | FList2 := alist2; 190 | len1 := FList1.Count; 191 | len2 := FList2.Count; 192 | 193 | Clear; 194 | 195 | Len1Minus1 := len1 -1; 196 | FCompareList.Capacity := len1 + len2; 197 | FCompareInts := true; 198 | 199 | GetMem(DiagBufferF, sizeof(integer)*(len1+len2+3)); 200 | GetMem(DiagBufferB, sizeof(integer)*(len1+len2+3)); 201 | try 202 | PushDiff(0, 0, len1, len2); 203 | while PopDiff do; 204 | finally 205 | freeMem(DiagBufferF); 206 | freeMem(DiagBufferB); 207 | end; 208 | 209 | if FCancelled then 210 | begin 211 | Result := false; 212 | Clear; 213 | exit; 214 | end; 215 | 216 | //correct the occasional missed match ... 217 | for i := 1 to count -1 do 218 | with PCompareRec(FCompareList[i])^ do 219 | if (Kind = ckModify) and (int1 = int2) then 220 | begin 221 | Kind := ckNone; 222 | Dec(FDiffStats.modifies); 223 | Inc(FDiffStats.matches); 224 | end; 225 | 226 | //finally, append any trailing matches onto compareList ... 227 | with FLastCompareRec do 228 | AddChangeInt(oldIndex1,len1Minus1-oldIndex1, ckNone); 229 | finally 230 | FExecuting := false; 231 | end; 232 | end; 233 | //------------------------------------------------------------------------------ 234 | 235 | function TNPDiff.Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; 236 | var 237 | i, Len1Minus1: integer; 238 | len1,len2: Integer; 239 | begin 240 | Result := not FExecuting; 241 | if not Result then exit; 242 | FCancelled := false; 243 | FExecuting := true; 244 | FIgnoreCase := bIgnoreCase; 245 | try 246 | Clear; 247 | len1 := Length(s1); 248 | len2 := Length(s2); 249 | Len1Minus1 := len1 -1; 250 | FCompareList.Capacity := len1 + len2; 251 | FDiffList.Capacity := 1024; 252 | FCompareInts := false; 253 | 254 | GetMem(DiagBufferF, sizeof(integer)*(len1+len2+3)); 255 | GetMem(DiagBufferB, sizeof(integer)*(len1+len2+3)); 256 | FStr1 := s1; 257 | FStr2 := s2; 258 | try 259 | PushDiff(1, 1, len1, len2); 260 | while PopDiff do; 261 | finally 262 | freeMem(DiagBufferF); 263 | freeMem(DiagBufferB); 264 | end; 265 | 266 | if FCancelled then 267 | begin 268 | Result := false; 269 | Clear; 270 | exit; 271 | end; 272 | 273 | //correct the occasional missed match ... 274 | for i := 1 to count -1 do 275 | with PCompareRec(FCompareList[i])^ do 276 | if (Kind = ckModify) and (chr1 = chr2) then 277 | begin 278 | Kind := ckNone; 279 | Dec(FDiffStats.modifies); 280 | Inc(FDiffStats.matches); 281 | end; 282 | 283 | //finally, append any trailing matches onto compareList ... 284 | with FLastCompareRec do 285 | begin 286 | AddChangeChr(oldIndex1,len1Minus1-oldIndex1+1, ckNone); 287 | end; 288 | finally 289 | FExecuting := false; 290 | end; 291 | end; 292 | //------------------------------------------------------------------------------ 293 | 294 | procedure TNPDiff.PushDiff(offset1, offset2, len1, len2: integer); 295 | var 296 | DiffVars: PDiffVars; 297 | begin 298 | new(DiffVars); 299 | DiffVars.offset1 := offset1; 300 | DiffVars.offset2 := offset2; 301 | DiffVars.len1 := len1; 302 | DiffVars.len2 := len2; 303 | FDiffList.Add(DiffVars); 304 | end; 305 | //------------------------------------------------------------------------------ 306 | 307 | function TNPDiff.PopDiff: boolean; 308 | var 309 | DiffVars: PDiffVars; 310 | idx: integer; 311 | begin 312 | idx := FDiffList.Count -1; 313 | Result := idx >= 0; 314 | if not Result then exit; 315 | DiffVars := PDiffVars(FDiffList[idx]); 316 | with DiffVars^ do 317 | if FCompareInts then 318 | DiffInt(offset1, offset2, len1, len2) 319 | else 320 | DiffChr(offset1, offset2, len1, len2); 321 | Dispose(DiffVars); 322 | FDiffList.Delete(idx); 323 | end; 324 | //------------------------------------------------------------------------------ 325 | 326 | procedure TNPDiff.InitDiagArrays(len1, len2: integer); 327 | var 328 | i: integer; 329 | begin 330 | //assumes that top and bottom matches have been excluded 331 | P8Bits(DiagF) := P8Bits(DiagBufferF) - sizeof(integer)*(MAX_DIAGONAL-(len1+1)); 332 | for i := - (len1+1) to (len2+1) do 333 | DiagF^[i] := -MAXINT; 334 | DiagF^[1] := -1; 335 | 336 | P8Bits(DiagB) := P8Bits(DiagBufferB) - sizeof(integer)*(MAX_DIAGONAL-(len1+1)); 337 | for i := - (len1+1) to (len2+1) do 338 | DiagB^[i] := MAXINT; 339 | DiagB^[len2-len1+1] := len2; 340 | end; 341 | //------------------------------------------------------------------------------ 342 | 343 | procedure TNPDiff.DiffInt(offset1, offset2, len1, len2: integer); 344 | var 345 | p, k, delta: integer; 346 | begin 347 | if offset1+len1 > FList1.Count then len1 := FList1.Count - offset1; 348 | if offset2+len2 > FList2.Count then len2 := FList2.Count - offset2; 349 | //trim matching bottoms ... 350 | while (len1 > 0) and (len2 > 0) and (FList1[offset1] = FList2[offset2]) do 351 | begin 352 | inc(offset1); inc(offset2); dec(len1); dec(len2); 353 | end; 354 | //trim matching tops ... 355 | while (len1 > 0) and (len2 > 0) and (FList1[offset1+len1-1] = FList2[offset2+len2-1]) do 356 | begin 357 | dec(len1); dec(len2); 358 | end; 359 | 360 | //stop diff'ing if minimal conditions reached ... 361 | if (len1 = 0) then 362 | begin 363 | AddChangeInt(offset1 ,len2, ckAdd); 364 | exit; 365 | end 366 | else if (len2 = 0) then 367 | begin 368 | AddChangeInt(offset1 ,len1, ckDelete); 369 | exit; 370 | end 371 | else if (len1 = 1) and (len2 = 1) then 372 | begin 373 | AddChangeInt(offset1, 1, ckDelete); 374 | AddChangeInt(offset1, 1, ckAdd); 375 | exit; 376 | end; 377 | 378 | p := -1; 379 | delta := len2 - len1; 380 | InitDiagArrays(len1, len2); 381 | if delta < 0 then 382 | begin 383 | repeat 384 | inc(p); 385 | if (p mod 1024) = 1023 then 386 | begin 387 | Application.ProcessMessages; 388 | if FCancelled then exit; 389 | end; 390 | //nb: the Snake order is important here 391 | for k := p downto delta +1 do 392 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 393 | for k := -p + delta to delta-1 do 394 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 395 | for k := delta -p to -1 do 396 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 397 | for k := p downto 1 do 398 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 399 | if SnakeIntF(delta,offset1,offset2,len1,len2) then exit; 400 | if SnakeIntB(0,offset1,offset2,len1,len2) then exit; 401 | until(false); 402 | end else 403 | begin 404 | repeat 405 | inc(p); 406 | if (p mod 1024) = 1023 then 407 | begin 408 | Application.ProcessMessages; 409 | if FCancelled then exit; 410 | end; 411 | //nb: the Snake order is important here 412 | for k := -p to delta -1 do 413 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 414 | for k := p + delta downto delta +1 do 415 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 416 | for k := delta + p downto 1 do 417 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 418 | for k := -p to -1 do 419 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 420 | if SnakeIntF(delta,offset1,offset2,len1,len2) then exit; 421 | if SnakeIntB(0,offset1,offset2,len1,len2) then exit; 422 | until(false); 423 | end; 424 | end; 425 | //------------------------------------------------------------------------------ 426 | 427 | procedure TNPDiff.DiffChr(offset1, offset2, len1, len2: integer); 428 | var 429 | p, k, delta: integer; 430 | begin 431 | //trim matching bottoms ... 432 | while (len1 > 0) and (len2 > 0) and CompareChr(FStr1[offset1], FStr2[offset2]) do 433 | begin 434 | inc(offset1); inc(offset2); dec(len1); dec(len2); 435 | end; 436 | //trim matching tops ... 437 | while (len1 > 0) and (len2 > 0) and CompareChr(FStr1[offset1+len1-1], FStr2[offset2+len2-1]) do 438 | begin 439 | dec(len1); dec(len2); 440 | end; 441 | 442 | //stop diff'ing if minimal conditions reached ... 443 | if (len1 = 0) then 444 | begin 445 | AddChangeChr(offset1 ,len2, ckAdd); 446 | exit; 447 | end 448 | else if (len2 = 0) then 449 | begin 450 | AddChangeChr(offset1, len1, ckDelete); 451 | exit; 452 | end 453 | else if (len1 = 1) and (len2 = 1) then 454 | begin 455 | AddChangeChr(offset1, 1, ckDelete); 456 | AddChangeChr(offset1, 1, ckAdd); 457 | exit; 458 | end; 459 | 460 | p := -1; 461 | delta := len2 - len1; 462 | InitDiagArrays(len1, len2); 463 | if delta < 0 then 464 | begin 465 | repeat 466 | inc(p); 467 | if (p mod 1024 = 1023) then 468 | begin 469 | Application.ProcessMessages; 470 | if FCancelled then exit; 471 | end; 472 | //nb: the Snake order is important here 473 | for k := p downto delta +1 do 474 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 475 | for k := -p + delta to delta-1 do 476 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 477 | for k := delta -p to -1 do 478 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 479 | for k := p downto 1 do 480 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 481 | if SnakeChrF(delta,offset1,offset2,len1,len2) then exit; 482 | if SnakeChrB(0,offset1,offset2,len1,len2) then exit; 483 | until(false); 484 | end else 485 | begin 486 | repeat 487 | inc(p); 488 | if (p mod 1024 = 1023) then 489 | begin 490 | Application.ProcessMessages; 491 | if FCancelled then exit; 492 | end; 493 | //nb: the Snake order is important here 494 | for k := -p to delta -1 do 495 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 496 | for k := p + delta downto delta +1 do 497 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 498 | for k := delta + p downto 1 do 499 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 500 | for k := -p to -1 do 501 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 502 | if SnakeChrF(delta,offset1,offset2,len1,len2) then exit; 503 | if SnakeChrB(0,offset1,offset2,len1,len2) then exit; 504 | until(false); 505 | end; 506 | end; 507 | //------------------------------------------------------------------------------ 508 | 509 | function TNPDiff.SnakeChrF(k,offset1,offset2,len1,len2: integer): boolean; 510 | var 511 | x,y: integer; 512 | begin 513 | if DiagF[k+1] > DiagF[k-1] then 514 | y := DiagF[k+1] else 515 | y := DiagF[k-1]+1; 516 | x := y - k; 517 | while (x < len1-1) and (y < len2-1) and CompareChr(FStr1[offset1+x+1], FStr2[offset2+y+1]) do 518 | begin 519 | inc(x); inc(y); 520 | end; 521 | DiagF[k] := y; 522 | Result := (DiagF[k] >= DiagB[k]); 523 | if not Result then exit; 524 | 525 | inc(x); inc(y); 526 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 527 | PushDiff(offset1, offset2, x, y); 528 | end; 529 | //------------------------------------------------------------------------------ 530 | 531 | function TNPDiff.SnakeChrB(k,offset1,offset2,len1,len2: integer): boolean; 532 | var 533 | x,y: integer; 534 | begin 535 | if DiagB[k-1] < DiagB[k+1] then 536 | y := DiagB[k-1] 537 | else 538 | y := DiagB[k+1]-1; 539 | 540 | x := y - k; 541 | while (x >= 0) and (y >= 0) and CompareChr(FStr1[offset1+x], FStr2[offset2+y]) do 542 | begin 543 | dec(x); dec(y); 544 | end; 545 | DiagB[k] := y; 546 | Result := DiagB[k] <= DiagF[k]; 547 | if not Result then exit; 548 | 549 | inc(x); inc(y); 550 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 551 | PushDiff(offset1, offset2, x, y); 552 | end; 553 | //------------------------------------------------------------------------------ 554 | 555 | function TNPDiff.SnakeIntF(k,offset1,offset2,len1,len2: integer): boolean; 556 | var 557 | x,y: integer; 558 | begin 559 | if DiagF^[k+1] > DiagF^[k-1] then 560 | y := DiagF^[k+1] 561 | else 562 | y := DiagF^[k-1]+1; 563 | x := y - k; 564 | while (x < len1-1) and (y < len2-1) and (FList1[offset1+x+1] = FList2[offset2+y+1]) do 565 | begin 566 | inc(x); inc(y); 567 | end; 568 | DiagF^[k] := y; 569 | Result := (DiagF^[k] >= DiagB^[k]); 570 | if not Result then exit; 571 | 572 | inc(x); inc(y); 573 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 574 | PushDiff(offset1, offset2, x, y); 575 | end; 576 | //------------------------------------------------------------------------------ 577 | 578 | function TNPDiff.SnakeIntB(k,offset1,offset2,len1,len2: integer): boolean; 579 | var 580 | x,y: integer; 581 | begin 582 | if DiagB^[k-1] < DiagB^[k+1] then 583 | y := DiagB^[k-1] 584 | else 585 | y := DiagB^[k+1]-1; 586 | x := y - k; 587 | while (x >= 0) and (y >= 0) and (FList1[offset1+x] = FList2[offset2+y]) do 588 | begin 589 | dec(x); dec(y); 590 | end; 591 | DiagB^[k] := y; 592 | Result := DiagB^[k] <= DiagF^[k]; 593 | if not Result then exit; 594 | 595 | inc(x); inc(y); 596 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 597 | PushDiff(offset1, offset2, x, y); 598 | end; 599 | //------------------------------------------------------------------------------ 600 | 601 | procedure TNPDiff.AddChangeChr(offset1, range: integer; ChangeKind: TChangeKind); 602 | var 603 | i,j: integer; 604 | compareRec: PCompareRec; 605 | begin 606 | //first, add any unchanged items into this list ... 607 | if FLastCompareRec.oldIndex1 < 0 then FLastCompareRec.oldIndex1 := 0; 608 | if FLastCompareRec.oldIndex2 < 0 then FLastCompareRec.oldIndex2 := 0; 609 | while (FLastCompareRec.oldIndex1 < offset1 -1) do 610 | begin 611 | with FLastCompareRec do 612 | begin 613 | chr1 := #0; 614 | chr2 := #0; 615 | Kind := ckNone; 616 | inc(oldIndex1); 617 | inc(oldIndex2); 618 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 619 | chr1 := FStr1[oldIndex1]; 620 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 621 | chr2 := FStr2[oldIndex2]; 622 | end; 623 | New(compareRec); 624 | compareRec^ := FLastCompareRec; 625 | FCompareList.Add(compareRec); 626 | inc(FDiffStats.matches); 627 | end; 628 | 629 | case ChangeKind of 630 | ckNone: 631 | for i := 1 to range do 632 | begin 633 | with FLastCompareRec do 634 | begin 635 | Kind := ckNone; 636 | inc(oldIndex1); 637 | inc(oldIndex2); 638 | chr1 := FStr1[oldIndex1]; 639 | chr2 := FStr2[oldIndex2]; 640 | end; 641 | New(compareRec); 642 | compareRec^ := FLastCompareRec; 643 | FCompareList.Add(compareRec); 644 | inc(FDiffStats.matches); 645 | end; 646 | ckAdd : 647 | begin 648 | for i := 1 to range do 649 | begin 650 | with FLastCompareRec do 651 | begin 652 | 653 | //check if a range of adds are following a range of deletes 654 | //and convert them to modifies ... 655 | if Kind = ckDelete then 656 | begin 657 | j := FCompareList.Count -1; 658 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckDelete) do 659 | dec(j); 660 | PCompareRec(FCompareList[j]).Kind := ckModify; 661 | dec(FDiffStats.deletes); 662 | inc(FDiffStats.modifies); 663 | inc(FLastCompareRec.oldIndex2); 664 | PCompareRec(FCompareList[j]).oldIndex2 := FLastCompareRec.oldIndex2; 665 | PCompareRec(FCompareList[j]).chr2 := FStr2[oldIndex2]; 666 | if j = FCompareList.Count-1 then 667 | FLastCompareRec.Kind := ckModify; 668 | continue; 669 | end; 670 | 671 | Kind := ckAdd; 672 | chr1 := #0; 673 | inc(oldIndex2); 674 | chr2 := FStr2[oldIndex2]; //ie what we added 675 | end; 676 | New(compareRec); 677 | compareRec^ := FLastCompareRec; 678 | FCompareList.Add(compareRec); 679 | inc(FDiffStats.adds); 680 | end; 681 | end; 682 | ckDelete : 683 | begin 684 | for i := 1 to range do 685 | begin 686 | with FLastCompareRec do 687 | begin 688 | 689 | //check if a range of deletes are following a range of adds 690 | //and convert them to modifies ... 691 | if Kind = ckAdd then 692 | begin 693 | j := FCompareList.Count -1; 694 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckAdd) do 695 | dec(j); 696 | PCompareRec(FCompareList[j]).Kind := ckModify; 697 | dec(FDiffStats.adds); 698 | inc(FDiffStats.modifies); 699 | inc(FLastCompareRec.oldIndex1); 700 | PCompareRec(FCompareList[j]).oldIndex1 := FLastCompareRec.oldIndex1; 701 | PCompareRec(FCompareList[j]).chr1 := FStr1[oldIndex1]; 702 | if j = FCompareList.Count-1 then 703 | FLastCompareRec.Kind := ckModify; 704 | continue; 705 | end; 706 | 707 | Kind := ckDelete; 708 | chr2 := #0; 709 | inc(oldIndex1); 710 | chr1 := FStr1[oldIndex1]; //ie what we deleted 711 | end; 712 | New(compareRec); 713 | compareRec^ := FLastCompareRec; 714 | FCompareList.Add(compareRec); 715 | inc(FDiffStats.deletes); 716 | end; 717 | end; 718 | end; 719 | end; 720 | //------------------------------------------------------------------------------ 721 | 722 | procedure TNPDiff.AddChangeInt(offset1, range: integer; ChangeKind: TChangeKind); 723 | var 724 | i,j: integer; 725 | compareRec: PCompareRec; 726 | begin 727 | //first, add any unchanged items into this list ... 728 | while (FLastCompareRec.oldIndex1 < offset1 -1) do 729 | begin 730 | with FLastCompareRec do 731 | begin 732 | Kind := ckNone; 733 | inc(oldIndex1); 734 | inc(oldIndex2); 735 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 736 | int1 := Integer(FList1[oldIndex1]); 737 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 738 | int2 := Integer(FList2[oldIndex2]); 739 | end; 740 | New(compareRec); 741 | compareRec^ := FLastCompareRec; 742 | FCompareList.Add(compareRec); 743 | inc(FDiffStats.matches); 744 | end; 745 | 746 | case ChangeKind of 747 | ckNone: 748 | for i := 1 to range do 749 | begin 750 | with FLastCompareRec do 751 | begin 752 | Kind := ckNone; 753 | inc(oldIndex1); 754 | inc(oldIndex2); 755 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 756 | int1 := Integer(FList1[oldIndex1]); 757 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 758 | int2 := Integer(FList2[oldIndex2]); 759 | end; 760 | New(compareRec); 761 | compareRec^ := FLastCompareRec; 762 | FCompareList.Add(compareRec); 763 | inc(FDiffStats.matches); 764 | end; 765 | ckAdd : 766 | begin 767 | for i := 1 to range do 768 | begin 769 | with FLastCompareRec do 770 | begin 771 | 772 | //check if a range of adds are following a range of deletes 773 | //and convert them to modifies ... 774 | if Kind = ckDelete then 775 | begin 776 | j := FCompareList.Count -1; 777 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckDelete) do 778 | dec(j); 779 | PCompareRec(FCompareList[j]).Kind := ckModify; 780 | dec(FDiffStats.deletes); 781 | inc(FDiffStats.modifies); 782 | inc(FLastCompareRec.oldIndex2); 783 | PCompareRec(FCompareList[j]).oldIndex2 := FLastCompareRec.oldIndex2; 784 | PCompareRec(FCompareList[j]).int2 := Integer(FList2[oldIndex2]); 785 | if j = FCompareList.Count-1 then FLastCompareRec.Kind := ckModify; 786 | continue; 787 | end; 788 | 789 | Kind := ckAdd; 790 | int1 := $0; 791 | inc(oldIndex2); 792 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 793 | int2 := Integer(FList2[oldIndex2]); //ie what we added 794 | end; 795 | New(compareRec); 796 | compareRec^ := FLastCompareRec; 797 | FCompareList.Add(compareRec); 798 | inc(FDiffStats.adds); 799 | end; 800 | end; 801 | ckDelete : 802 | begin 803 | for i := 1 to range do 804 | begin 805 | with FLastCompareRec do 806 | begin 807 | 808 | //check if a range of deletes are following a range of adds 809 | //and convert them to modifies ... 810 | if Kind = ckAdd then 811 | begin 812 | j := FCompareList.Count -1; 813 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckAdd) do 814 | dec(j); 815 | PCompareRec(FCompareList[j]).Kind := ckModify; 816 | dec(FDiffStats.adds); 817 | inc(FDiffStats.modifies); 818 | inc(FLastCompareRec.oldIndex1); 819 | PCompareRec(FCompareList[j]).oldIndex1 := FLastCompareRec.oldIndex1; 820 | PCompareRec(FCompareList[j]).int1 := Integer(FList1[oldIndex1]); 821 | if j = FCompareList.Count-1 then FLastCompareRec.Kind := ckModify; 822 | continue; 823 | end; 824 | 825 | Kind := ckDelete; 826 | int2 := $0; 827 | inc(oldIndex1); 828 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 829 | int1 := Integer(FList1[oldIndex1]); //ie what we deleted 830 | end; 831 | New(compareRec); 832 | compareRec^ := FLastCompareRec; 833 | FCompareList.Add(compareRec); 834 | inc(FDiffStats.deletes); 835 | end; 836 | end; 837 | end; 838 | end; 839 | //------------------------------------------------------------------------------ 840 | 841 | procedure TNPDiff.Clear; 842 | var 843 | i: integer; 844 | begin 845 | for i := 0 to FCompareList.Count-1 do 846 | dispose(PCompareRec(FCompareList[i])); 847 | FCompareList.clear; 848 | FLastCompareRec.Kind := ckNone; 849 | FLastCompareRec.oldIndex1 := -1; 850 | FLastCompareRec.oldIndex2 := -1; 851 | FDiffStats.matches := 0; 852 | FDiffStats.adds := 0; 853 | FDiffStats.deletes :=0; 854 | FDiffStats.modifies :=0; 855 | end; 856 | //------------------------------------------------------------------------------ 857 | 858 | function TNPDiff.GetCompareCount: integer; 859 | begin 860 | Result := FCompareList.count; 861 | end; 862 | //------------------------------------------------------------------------------ 863 | 864 | function TNPDiff.GetCompare(index: integer): TCompareRec; 865 | begin 866 | Result := PCompareRec(FCompareList[index])^; 867 | end; 868 | //------------------------------------------------------------------------------ 869 | 870 | procedure TNPDiff.Cancel; 871 | begin 872 | FCancelled := true; 873 | end; 874 | 875 | function TNPDiff.CompareChr(const ch1, ch2: Char): Boolean; 876 | begin 877 | if FIgnoreCase then 878 | Result := (ch1.ToLower = ch2.ToLower) 879 | else 880 | Result := (ch1 = ch2); 881 | end; 882 | 883 | //------------------------------------------------------------------------------ 884 | 885 | end. 886 | -------------------------------------------------------------------------------- /src/HashUnit.pas: -------------------------------------------------------------------------------- 1 | unit HashUnit; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | // ----------------------------------------------------------------------------- 8 | // Application: TextDiff . 9 | // Module: HashUnit . 10 | // Version: 5.0 . 11 | // Date: 18-MAY-2020 . 12 | // Target: Win32, Delphi 10.x . 13 | // Author: Angus Johnson - angusj-AT-myrealbox-DOT-com . 14 | // Updates by: Rickard Johansson (RJ TextEd) . 15 | // Copyright; © 2003-2004 Angus Johnson . 16 | // ----------------------------------------------------------------------------- 17 | 18 | (******************************************************************************* 19 | * History: * 20 | * 18 May 2020 * 21 | * Added Lazarus support * 22 | * Updated comment section for public release of version 5.0 * 23 | * * 24 | * 11 November 2018 * 25 | * - Hashline returns a Cardinal instead of a pointer * 26 | * Updated Hashline (IgnoreBlanks) to handle Unicode white spaces * 27 | * CalcCRC32 updated to handle Unicode string * 28 | *******************************************************************************) 29 | 30 | interface 31 | 32 | uses 33 | SysUtils; 34 | 35 | function HashLine(const line: string; IgnoreCase, IgnoreBlanks: boolean): Cardinal; 36 | 37 | implementation 38 | 39 | uses 40 | {$ifndef fpc} 41 | Winapi.Windows, 42 | System.Character; 43 | {$else} 44 | Character; 45 | {$endif} 46 | 47 | const 48 | table: ARRAY[0..255] OF DWORD = 49 | ($00000000, $77073096, $EE0E612C, $990951BA, 50 | $076DC419, $706AF48F, $E963A535, $9E6495A3, 51 | $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, 52 | $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91, 53 | $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, 54 | $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, 55 | $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, 56 | $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, 57 | $3B6E20C8, $4C69105E, $D56041E4, $A2677172, 58 | $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, 59 | $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, 60 | $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, 61 | $26D930AC, $51DE003A, $C8D75180, $BFD06116, 62 | $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F, 63 | $2802B89E, $5F058808, $C60CD9B2, $B10BE924, 64 | $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, 65 | 66 | $76DC4190, $01DB7106, $98D220BC, $EFD5102A, 67 | $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433, 68 | $7807C9A2, $0F00F934, $9609A88E, $E10E9818, 69 | $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01, 70 | $6B6B51F4, $1C6C6162, $856530D8, $F262004E, 71 | $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, 72 | $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, 73 | $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, 74 | $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, 75 | $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, 76 | $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, 77 | $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9, 78 | $5005713C, $270241AA, $BE0B1010, $C90C2086, 79 | $5768B525, $206F85B3, $B966D409, $CE61E49F, 80 | $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, 81 | $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD, 82 | 83 | $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, 84 | $EAD54739, $9DD277AF, $04DB2615, $73DC1683, 85 | $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, 86 | $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, 87 | $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, 88 | $F762575D, $806567CB, $196C3671, $6E6B06E7, 89 | $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, 90 | $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, 91 | $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, 92 | $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B, 93 | $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, 94 | $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79, 95 | $CB61B38C, $BC66831A, $256FD2A0, $5268E236, 96 | $CC0C7795, $BB0B4703, $220216B9, $5505262F, 97 | $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, 98 | $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D, 99 | 100 | $9B64C2B0, $EC63F226, $756AA39C, $026D930A, 101 | $9C0906A9, $EB0E363F, $72076785, $05005713, 102 | $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, 103 | $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, 104 | $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, 105 | $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, 106 | $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, 107 | $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, 108 | $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, 109 | $A7672661, $D06016F7, $4969474D, $3E6E77DB, 110 | $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, 111 | $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9, 112 | $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, 113 | $BAD03605, $CDD70693, $54DE5729, $23D967BF, 114 | $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, 115 | $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D); 116 | 117 | //CRC algorithm courtesy of Earl F. Glynn ... 118 | //(http://www.efg2.com/Lab/Mathematics/CRC.htm) 119 | function CalcCRC32(const s: string; len: Integer): Cardinal; 120 | var 121 | i,byteLen: integer; 122 | p: PByte; 123 | begin 124 | p := PByte(s); 125 | {$ifndef fpc} 126 | byteLen := 2*len; 127 | {$else} 128 | byteLen := len; 129 | {$endif} 130 | result := $FFFFFFFF; 131 | for i := 0 to byteLen-1 do 132 | begin 133 | result := (result shr 8) xor table[ p^ xor (result and $000000ff) ]; 134 | inc(p); 135 | end; 136 | result := not result; 137 | end; 138 | 139 | function HashLine(const line: string; IgnoreCase, IgnoreBlanks: boolean): Cardinal; 140 | var 141 | i,j,len: integer; 142 | s: string; 143 | begin 144 | s := line; 145 | len := Length(line); 146 | if IgnoreBlanks then 147 | begin 148 | i := 1; 149 | j := 1; 150 | while i <= len do 151 | begin 152 | if not IsWhiteSpace(line[i]) then 153 | begin 154 | s[j] := line[i]; 155 | inc(j); 156 | end; 157 | inc(i); 158 | end; 159 | len := j-1; 160 | setlength(s,len); 161 | end; 162 | if IgnoreCase then 163 | s := s.ToUpper; 164 | result := CalcCRC32(s, len); 165 | end; 166 | 167 | 168 | end. 169 | --------------------------------------------------------------------------------

├── .gitattributes ├── BasicDemo1 ├── BasicDiffDemo1.cfg ├── BasicDiffDemo1.dpr ├── BasicDiffDemo1.dproj ├── BasicDiffDemo1.dproj.local ├── BasicDiffDemo1.exe ├── BasicDiffDemo1.identcache ├── BasicDiffDemo1.lpi ├── BasicDiffDemo1.lps ├── BasicDiffDemo1.res ├── BasicDiffDemo1_Icon.ico ├── Unit1.dfm ├── Unit1.lfm └── Unit1.pas ├── BasicDemo2 ├── BasicDiffDemo2.dpr ├── BasicDiffDemo2.dproj ├── BasicDiffDemo2.dproj.local ├── BasicDiffDemo2.identcache ├── BasicDiffDemo2.lpi ├── BasicDiffDemo2.lps ├── BasicDiffDemo2.res ├── BasicDiffDemo2_Icon.ico ├── Unit1.dfm ├── Unit1.lfm └── Unit1.pas ├── docs ├── O(ND).pdf └── O(NP).pdf ├── readme.md └── src ├── Diff.pas ├── DiffTypes.pas ├── Diff_ND.pas ├── Diff_NP.pas └── HashUnit.pas /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.cfg: -------------------------------------------------------------------------------- 1 | -$A8 2 | -$B- 3 | -$C+ 4 | -$D+ 5 | -$E- 6 | -$F- 7 | -$G+ 8 | -$H+ 9 | -$I+ 10 | -$J- 11 | -$K- 12 | -$L+ 13 | -$M- 14 | -$N+ 15 | -$O+ 16 | -$P+ 17 | -$Q+ 18 | -$R+ 19 | -$S- 20 | -$T- 21 | -$U- 22 | -$V+ 23 | -$W- 24 | -$X+ 25 | -$YD 26 | -$Z1 27 | -cg 28 | -AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 29 | -H+ 30 | -W+ 31 | -M 32 | -$M16384,1048576 33 | -K$00400000 34 | -LE"c:\program files\borland\delphi 7\Projects\Bpl" 35 | -LN"c:\program files\borland\delphi 7\Projects\Bpl" 36 | -w-UNSAFE_TYPE 37 | -w-UNSAFE_CODE 38 | -w-UNSAFE_CAST 39 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.dpr: -------------------------------------------------------------------------------- 1 | // JCL_DEBUG_EXPERT_GENERATEJDBG OFF 2 | program BasicDiffDemo1; 3 | 4 | {$IFDEF FPC} 5 | {$MODE Delphi} 6 | {$ENDIF} 7 | 8 | uses 9 | {$IFnDEF FPC} 10 | {$ELSE} 11 | Interfaces, 12 | {$ENDIF } 13 | Forms, 14 | Unit1 in 'Unit1.pas' {Form1}, 15 | HashUnit in '..\src\HashUnit.pas', 16 | Diff in '..\src\Diff.pas', 17 | DiffTypes in '..\src\DiffTypes.pas', 18 | Diff_ND in '..\src\Diff_ND.pas', 19 | Diff_NP in '..\src\Diff_NP.pas'; 20 | 21 | {$R *.res} 22 | 23 | begin 24 | Application.Initialize; 25 | Application.CreateForm(TForm1, Form1); 26 | Application.Run; 27 | end. 28 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {EDF59D45-F679-48FD-9B94-8605BE01CBBE} 4 | BasicDiffDemo1.dpr 5 | True 6 | Debug 7 | 1 8 | Application 9 | VCL 10 | 20.1 11 | Win32 12 | BasicDiffDemo1 13 | 14 | 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | true 24 | Base 25 | true 26 | 27 | 28 | true 29 | Base 30 | true 31 | 32 | 33 | true 34 | Cfg_1 35 | true 36 | true 37 | 38 | 39 | true 40 | Base 41 | true 42 | 43 | 44 | true 45 | Cfg_2 46 | true 47 | true 48 | 49 | 50 | true 51 | 1 52 | false 53 | false 54 | false 55 | BasicDiffDemo1 56 | 1 57 | 00400000 58 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 59 | false 60 | true 61 | rtl;vcl;indy;vclx;VclSmp;dbrtl;adortl;vcldb;bdertl;vcldbx;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;dsnap;vclactnband;vclshlctrls;GR32_DSGN_D7;GR32_D7;$(DCC_UsePackage) 62 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 63 | 3081 64 | true 65 | 66 | 67 | BasicDiffDemo1_Icon.ico 68 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 69 | 1033 70 | true 71 | $(BDS)\bin\default_app.manifest 72 | true 73 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 74 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 75 | PerMonitorV2 76 | 77 | 78 | BasicDiffDemo1_Icon.ico 79 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 80 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 81 | 82 | 83 | 0 84 | 0 85 | false 86 | RELEASE;$(DCC_Define) 87 | 88 | 89 | true 90 | 1033 91 | true 92 | PerMonitorV2 93 | 94 | 95 | true 96 | false 97 | DEBUG;$(DCC_Define) 98 | 99 | 100 | Debug 101 | true 102 | 1033 103 | true 104 | PerMonitorV2 105 | 106 | 107 | 108 | MainSource 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | Base 120 | 121 | 122 | Cfg_1 123 | Base 124 | 125 | 126 | Cfg_2 127 | Base 128 | 129 | 130 | 131 | Delphi.Personality.12 132 | 133 | 134 | 135 | 136 | BasicDiffDemo1.dpr 137 | 138 | 139 | Microsoft Office 2000 Sample Automation Server Wrapper Components 140 | Microsoft Office XP Sample Automation Server Wrapper Components 141 | 142 | 143 | 144 | True 145 | False 146 | 147 | 148 | 149 | 150 | 151 | BasicDiffDemo1.exe 152 | true 153 | 154 | 155 | 156 | 157 | 1 158 | 159 | 160 | Contents\MacOS 161 | 1 162 | 163 | 164 | 0 165 | 166 | 167 | 168 | 169 | classes 170 | 64 171 | 172 | 173 | classes 174 | 64 175 | 176 | 177 | 178 | 179 | res\xml 180 | 1 181 | 182 | 183 | res\xml 184 | 1 185 | 186 | 187 | 188 | 189 | library\lib\armeabi-v7a 190 | 1 191 | 192 | 193 | 194 | 195 | library\lib\armeabi 196 | 1 197 | 198 | 199 | library\lib\armeabi 200 | 1 201 | 202 | 203 | 204 | 205 | library\lib\armeabi-v7a 206 | 1 207 | 208 | 209 | 210 | 211 | library\lib\mips 212 | 1 213 | 214 | 215 | library\lib\mips 216 | 1 217 | 218 | 219 | 220 | 221 | library\lib\armeabi-v7a 222 | 1 223 | 224 | 225 | library\lib\arm64-v8a 226 | 1 227 | 228 | 229 | 230 | 231 | library\lib\armeabi-v7a 232 | 1 233 | 234 | 235 | 236 | 237 | res\drawable 238 | 1 239 | 240 | 241 | res\drawable 242 | 1 243 | 244 | 245 | 246 | 247 | res\drawable-anydpi-v21 248 | 1 249 | 250 | 251 | res\drawable-anydpi-v21 252 | 1 253 | 254 | 255 | 256 | 257 | res\values 258 | 1 259 | 260 | 261 | res\values 262 | 1 263 | 264 | 265 | 266 | 267 | res\values-v21 268 | 1 269 | 270 | 271 | res\values-v21 272 | 1 273 | 274 | 275 | 276 | 277 | res\values-v31 278 | 1 279 | 280 | 281 | res\values-v31 282 | 1 283 | 284 | 285 | 286 | 287 | res\drawable-anydpi-v26 288 | 1 289 | 290 | 291 | res\drawable-anydpi-v26 292 | 1 293 | 294 | 295 | 296 | 297 | res\drawable 298 | 1 299 | 300 | 301 | res\drawable 302 | 1 303 | 304 | 305 | 306 | 307 | res\drawable 308 | 1 309 | 310 | 311 | res\drawable 312 | 1 313 | 314 | 315 | 316 | 317 | res\drawable 318 | 1 319 | 320 | 321 | res\drawable 322 | 1 323 | 324 | 325 | 326 | 327 | res\drawable-anydpi-v33 328 | 1 329 | 330 | 331 | res\drawable-anydpi-v33 332 | 1 333 | 334 | 335 | 336 | 337 | res\values 338 | 1 339 | 340 | 341 | res\values 342 | 1 343 | 344 | 345 | 346 | 347 | res\values-night-v21 348 | 1 349 | 350 | 351 | res\values-night-v21 352 | 1 353 | 354 | 355 | 356 | 357 | res\drawable 358 | 1 359 | 360 | 361 | res\drawable 362 | 1 363 | 364 | 365 | 366 | 367 | res\drawable-xxhdpi 368 | 1 369 | 370 | 371 | res\drawable-xxhdpi 372 | 1 373 | 374 | 375 | 376 | 377 | res\drawable-xxxhdpi 378 | 1 379 | 380 | 381 | res\drawable-xxxhdpi 382 | 1 383 | 384 | 385 | 386 | 387 | res\drawable-ldpi 388 | 1 389 | 390 | 391 | res\drawable-ldpi 392 | 1 393 | 394 | 395 | 396 | 397 | res\drawable-mdpi 398 | 1 399 | 400 | 401 | res\drawable-mdpi 402 | 1 403 | 404 | 405 | 406 | 407 | res\drawable-hdpi 408 | 1 409 | 410 | 411 | res\drawable-hdpi 412 | 1 413 | 414 | 415 | 416 | 417 | res\drawable-xhdpi 418 | 1 419 | 420 | 421 | res\drawable-xhdpi 422 | 1 423 | 424 | 425 | 426 | 427 | res\drawable-mdpi 428 | 1 429 | 430 | 431 | res\drawable-mdpi 432 | 1 433 | 434 | 435 | 436 | 437 | res\drawable-hdpi 438 | 1 439 | 440 | 441 | res\drawable-hdpi 442 | 1 443 | 444 | 445 | 446 | 447 | res\drawable-xhdpi 448 | 1 449 | 450 | 451 | res\drawable-xhdpi 452 | 1 453 | 454 | 455 | 456 | 457 | res\drawable-xxhdpi 458 | 1 459 | 460 | 461 | res\drawable-xxhdpi 462 | 1 463 | 464 | 465 | 466 | 467 | res\drawable-xxxhdpi 468 | 1 469 | 470 | 471 | res\drawable-xxxhdpi 472 | 1 473 | 474 | 475 | 476 | 477 | res\drawable-small 478 | 1 479 | 480 | 481 | res\drawable-small 482 | 1 483 | 484 | 485 | 486 | 487 | res\drawable-normal 488 | 1 489 | 490 | 491 | res\drawable-normal 492 | 1 493 | 494 | 495 | 496 | 497 | res\drawable-large 498 | 1 499 | 500 | 501 | res\drawable-large 502 | 1 503 | 504 | 505 | 506 | 507 | res\drawable-xlarge 508 | 1 509 | 510 | 511 | res\drawable-xlarge 512 | 1 513 | 514 | 515 | 516 | 517 | res\values 518 | 1 519 | 520 | 521 | res\values 522 | 1 523 | 524 | 525 | 526 | 527 | res\drawable-anydpi-v24 528 | 1 529 | 530 | 531 | res\drawable-anydpi-v24 532 | 1 533 | 534 | 535 | 536 | 537 | res\drawable 538 | 1 539 | 540 | 541 | res\drawable 542 | 1 543 | 544 | 545 | 546 | 547 | res\drawable-night-anydpi-v21 548 | 1 549 | 550 | 551 | res\drawable-night-anydpi-v21 552 | 1 553 | 554 | 555 | 556 | 557 | res\drawable-anydpi-v31 558 | 1 559 | 560 | 561 | res\drawable-anydpi-v31 562 | 1 563 | 564 | 565 | 566 | 567 | res\drawable-night-anydpi-v31 568 | 1 569 | 570 | 571 | res\drawable-night-anydpi-v31 572 | 1 573 | 574 | 575 | 576 | 577 | 1 578 | 579 | 580 | Contents\MacOS 581 | 1 582 | 583 | 584 | 0 585 | 586 | 587 | 588 | 589 | Contents\MacOS 590 | 1 591 | .framework 592 | 593 | 594 | Contents\MacOS 595 | 1 596 | .framework 597 | 598 | 599 | Contents\MacOS 600 | 1 601 | .framework 602 | 603 | 604 | 0 605 | 606 | 607 | 608 | 609 | 1 610 | .dylib 611 | 612 | 613 | 1 614 | .dylib 615 | 616 | 617 | 1 618 | .dylib 619 | 620 | 621 | Contents\MacOS 622 | 1 623 | .dylib 624 | 625 | 626 | Contents\MacOS 627 | 1 628 | .dylib 629 | 630 | 631 | Contents\MacOS 632 | 1 633 | .dylib 634 | 635 | 636 | 0 637 | .dll;.bpl 638 | 639 | 640 | 641 | 642 | 1 643 | .dylib 644 | 645 | 646 | 1 647 | .dylib 648 | 649 | 650 | 1 651 | .dylib 652 | 653 | 654 | Contents\MacOS 655 | 1 656 | .dylib 657 | 658 | 659 | Contents\MacOS 660 | 1 661 | .dylib 662 | 663 | 664 | Contents\MacOS 665 | 1 666 | .dylib 667 | 668 | 669 | 0 670 | .bpl 671 | 672 | 673 | 674 | 675 | 0 676 | 677 | 678 | 0 679 | 680 | 681 | 0 682 | 683 | 684 | 0 685 | 686 | 687 | 0 688 | 689 | 690 | Contents\Resources\StartUp\ 691 | 0 692 | 693 | 694 | Contents\Resources\StartUp\ 695 | 0 696 | 697 | 698 | Contents\Resources\StartUp\ 699 | 0 700 | 701 | 702 | 0 703 | 704 | 705 | 706 | 707 | 1 708 | 709 | 710 | 1 711 | 712 | 713 | 714 | 715 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 716 | 1 717 | 718 | 719 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 720 | 1 721 | 722 | 723 | 724 | 725 | ..\ 726 | 1 727 | 728 | 729 | ..\ 730 | 1 731 | 732 | 733 | ..\ 734 | 1 735 | 736 | 737 | 738 | 739 | Contents 740 | 1 741 | 742 | 743 | Contents 744 | 1 745 | 746 | 747 | Contents 748 | 1 749 | 750 | 751 | 752 | 753 | Contents\Resources 754 | 1 755 | 756 | 757 | Contents\Resources 758 | 1 759 | 760 | 761 | Contents\Resources 762 | 1 763 | 764 | 765 | 766 | 767 | library\lib\armeabi-v7a 768 | 1 769 | 770 | 771 | library\lib\arm64-v8a 772 | 1 773 | 774 | 775 | 1 776 | 777 | 778 | 1 779 | 780 | 781 | 1 782 | 783 | 784 | 1 785 | 786 | 787 | Contents\MacOS 788 | 1 789 | 790 | 791 | Contents\MacOS 792 | 1 793 | 794 | 795 | Contents\MacOS 796 | 1 797 | 798 | 799 | 0 800 | 801 | 802 | 803 | 804 | library\lib\armeabi-v7a 805 | 1 806 | 807 | 808 | 809 | 810 | 1 811 | 812 | 813 | 1 814 | 815 | 816 | 1 817 | 818 | 819 | 820 | 821 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 822 | 1 823 | 824 | 825 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 826 | 1 827 | 828 | 829 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 830 | 1 831 | 832 | 833 | 834 | 835 | ..\ 836 | 1 837 | 838 | 839 | ..\ 840 | 1 841 | 842 | 843 | ..\ 844 | 1 845 | 846 | 847 | 848 | 849 | 1 850 | 851 | 852 | 1 853 | 854 | 855 | 1 856 | 857 | 858 | 859 | 860 | ..\$(PROJECTNAME).launchscreen 861 | 64 862 | 863 | 864 | ..\$(PROJECTNAME).launchscreen 865 | 64 866 | 867 | 868 | 869 | 870 | 1 871 | 872 | 873 | 1 874 | 875 | 876 | 1 877 | 878 | 879 | 880 | 881 | Assets 882 | 1 883 | 884 | 885 | Assets 886 | 1 887 | 888 | 889 | 890 | 891 | Assets 892 | 1 893 | 894 | 895 | Assets 896 | 1 897 | 898 | 899 | 900 | 901 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 902 | 1 903 | 904 | 905 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 906 | 1 907 | 908 | 909 | 910 | 911 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 912 | 1 913 | 914 | 915 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 916 | 1 917 | 918 | 919 | 920 | 921 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 922 | 1 923 | 924 | 925 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 926 | 1 927 | 928 | 929 | 930 | 931 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 932 | 1 933 | 934 | 935 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 936 | 1 937 | 938 | 939 | 940 | 941 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 942 | 1 943 | 944 | 945 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 946 | 1 947 | 948 | 949 | 950 | 951 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 952 | 1 953 | 954 | 955 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 956 | 1 957 | 958 | 959 | 960 | 961 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 962 | 1 963 | 964 | 965 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 966 | 1 967 | 968 | 969 | 970 | 971 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 972 | 1 973 | 974 | 975 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 976 | 1 977 | 978 | 979 | 980 | 981 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 982 | 1 983 | 984 | 985 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 986 | 1 987 | 988 | 989 | 990 | 991 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 992 | 1 993 | 994 | 995 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 996 | 1 997 | 998 | 999 | 1000 | 1001 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1002 | 1 1003 | 1004 | 1005 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1006 | 1 1007 | 1008 | 1009 | 1010 | 1011 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1012 | 1 1013 | 1014 | 1015 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1016 | 1 1017 | 1018 | 1019 | 1020 | 1021 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1022 | 1 1023 | 1024 | 1025 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1026 | 1 1027 | 1028 | 1029 | 1030 | 1031 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1032 | 1 1033 | 1034 | 1035 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset 1036 | 1 1037 | 1038 | 1039 | 1040 | 1041 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1042 | 1 1043 | 1044 | 1045 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1046 | 1 1047 | 1048 | 1049 | 1050 | 1051 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1052 | 1 1053 | 1054 | 1055 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1056 | 1 1057 | 1058 | 1059 | 1060 | 1061 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1062 | 1 1063 | 1064 | 1065 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1066 | 1 1067 | 1068 | 1069 | 1070 | 1071 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1072 | 1 1073 | 1074 | 1075 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1076 | 1 1077 | 1078 | 1079 | 1080 | 1081 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1082 | 1 1083 | 1084 | 1085 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1086 | 1 1087 | 1088 | 1089 | 1090 | 1091 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1092 | 1 1093 | 1094 | 1095 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset 1096 | 1 1097 | 1098 | 1099 | 1100 | 1101 | 1102 | 1103 | 1104 | 1105 | 1106 | 1107 | 1108 | 1109 | 1110 | 1111 | 1112 | 1113 | 1114 | 12 1115 | 1116 | 1117 | 1118 | 1119 | 1120 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.dproj.local: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo1/BasicDiffDemo1.exe -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.identcache: -------------------------------------------------------------------------------- 1 | OC:\Users\Rickard\Documents\Source\Delphi XE\Components\TextDiff\src\Diff_NP.pasLC:\Users\Rickard\Documents\Source\Delphi XE\Components\TextDiff\src\Diff.pas]C:\Users\Rickard\Documents\Source\Delphi XE\Components\TextDiff\BasicDemo1\BasicDiffDemo1.dprQC:\Users\Rickard\Documents\Source\Delphi XE\Components\TextDiff\src\DiffTypes.pasPC:\Users\Rickard\Documents\Source\Delphi XE\Components\TextDiff\src\HashUnit.pasOC:\Users\Rickard\Documents\Source\Delphi XE\Components\TextDiff\src\Diff_ND.pasTC:\Users\Rickard\Documents\Source\Delphi XE\Components\TextDiff\BasicDemo1\Unit1.pas -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | <UseAppBundle Value="False"/> 17 | <ResourceType Value="res"/> 18 | </General> 19 | <BuildModes Count="1"> 20 | <Item1 Name="Default" Default="True"/> 21 | </BuildModes> 22 | <PublishOptions> 23 | <Version Value="2"/> 24 | <UseFileFilters Value="True"/> 25 | </PublishOptions> 26 | <RunParams> 27 | <FormatVersion Value="2"/> 28 | </RunParams> 29 | <RequiredPackages Count="1"> 30 | <Item1> 31 | <PackageName Value="LCL"/> 32 | </Item1> 33 | </RequiredPackages> 34 | <Units Count="3"> 35 | <Unit0> 36 | <Filename Value="BasicDiffDemo1.dpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | <Unit1> 40 | <Filename Value="Unit1.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <ComponentName Value="Form1"/> 43 | <HasResources Value="True"/> 44 | <ResourceBaseClass Value="Form"/> 45 | </Unit1> 46 | <Unit2> 47 | <Filename Value="..\src\Diff.pas"/> 48 | <IsPartOfProject Value="True"/> 49 | </Unit2> 50 | </Units> 51 | </ProjectOptions> 52 | <CompilerOptions> 53 | <Version Value="11"/> 54 | <PathDelim Value="\"/> 55 | <SearchPaths> 56 | <IncludeFiles Value=".."/> 57 | <OtherUnitFiles Value="..\src"/> 58 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 59 | </SearchPaths> 60 | <Parsing> 61 | <SyntaxOptions> 62 | <SyntaxMode Value="delphi"/> 63 | </SyntaxOptions> 64 | </Parsing> 65 | <Linking> 66 | <Debugging> 67 | <DebugInfoType Value="dsDwarf3"/> 68 | </Debugging> 69 | <Options> 70 | <Win32> 71 | <GraphicApplication Value="True"/> 72 | </Win32> 73 | </Options> 74 | </Linking> 75 | <Other> 76 | <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/> 77 | </Other> 78 | </CompilerOptions> 79 | <Debugging> 80 | <Exceptions Count="3"> 81 | <Item1> 82 | <Name Value="EAbort"/> 83 | </Item1> 84 | <Item2> 85 | <Name Value="ECodetoolError"/> 86 | </Item2> 87 | <Item3> 88 | <Name Value="EFOpenError"/> 89 | </Item3> 90 | </Exceptions> 91 | </Debugging> 92 | </CONFIG> 93 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="12"/> 6 | <BuildModes Active="Default"/> 7 | <Units Count="5"> 8 | <Unit0> 9 | <Filename Value="BasicDiffDemo1.dpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <UsageCount Value="20"/> 12 | <Loaded Value="True"/> 13 | </Unit0> 14 | <Unit1> 15 | <Filename Value="Unit1.pas"/> 16 | <IsPartOfProject Value="True"/> 17 | <ComponentName Value="Form1"/> 18 | <HasResources Value="True"/> 19 | <ResourceBaseClass Value="Form"/> 20 | <UsageCount Value="20"/> 21 | </Unit1> 22 | <Unit2> 23 | <Filename Value="..\src\Diff.pas"/> 24 | <IsPartOfProject Value="True"/> 25 | <EditorIndex Value="3"/> 26 | <TopLine Value="93"/> 27 | <CursorPos X="57" Y="73"/> 28 | <UsageCount Value="20"/> 29 | <Loaded Value="True"/> 30 | </Unit2> 31 | <Unit3> 32 | <Filename Value="..\src\Diff_NP.pas"/> 33 | <IsVisibleTab Value="True"/> 34 | <EditorIndex Value="1"/> 35 | <TopLine Value="100"/> 36 | <CursorPos X="22" Y="106"/> 37 | <UsageCount Value="10"/> 38 | <Loaded Value="True"/> 39 | </Unit3> 40 | <Unit4> 41 | <Filename Value="C:\lazarus\components\lazutils\integerlist.pas"/> 42 | <UnitName Value="IntegerList"/> 43 | <EditorIndex Value="2"/> 44 | <TopLine Value="19"/> 45 | <CursorPos X="3" Y="35"/> 46 | <UsageCount Value="10"/> 47 | <Loaded Value="True"/> 48 | </Unit4> 49 | </Units> 50 | <JumpHistory Count="15" HistoryIndex="14"> 51 | <Position1> 52 | <Filename Value="BasicDiffDemo1.dpr"/> 53 | </Position1> 54 | <Position2> 55 | <Filename Value="..\src\Diff_NP.pas"/> 56 | <Caret Line="150" Column="3" TopLine="141"/> 57 | </Position2> 58 | <Position3> 59 | <Filename Value="..\src\Diff.pas"/> 60 | <Caret Line="136" Column="23" TopLine="120"/> 61 | </Position3> 62 | <Position4> 63 | <Filename Value="..\src\Diff.pas"/> 64 | <Caret Line="74" Column="102" TopLine="65"/> 65 | </Position4> 66 | <Position5> 67 | <Filename Value="..\src\Diff_NP.pas"/> 68 | <Caret Line="147" Column="15" TopLine="136"/> 69 | </Position5> 70 | <Position6> 71 | <Filename Value="..\src\Diff.pas"/> 72 | <Caret Line="47" Column="19" TopLine="38"/> 73 | </Position6> 74 | <Position7> 75 | <Filename Value="..\src\Diff.pas"/> 76 | <Caret Line="49" Column="12"/> 77 | </Position7> 78 | <Position8> 79 | <Filename Value="..\src\Diff.pas"/> 80 | <Caret Line="73" Column="56" TopLine="55"/> 81 | </Position8> 82 | <Position9> 83 | <Filename Value="..\src\Diff_NP.pas"/> 84 | <Caret Line="77" Column="37" TopLine="73"/> 85 | </Position9> 86 | <Position10> 87 | <Filename Value="BasicDiffDemo1.dpr"/> 88 | </Position10> 89 | <Position11> 90 | <Filename Value="..\src\Diff.pas"/> 91 | <Caret Line="135" Column="55" TopLine="129"/> 92 | </Position11> 93 | <Position12> 94 | <Filename Value="..\src\Diff.pas"/> 95 | <Caret Line="47" Column="20" TopLine="35"/> 96 | </Position12> 97 | <Position13> 98 | <Filename Value="..\src\Diff.pas"/> 99 | <Caret Line="73" Column="57" TopLine="93"/> 100 | </Position13> 101 | <Position14> 102 | <Filename Value="..\src\Diff_NP.pas"/> 103 | <Caret Line="132" Column="53" TopLine="125"/> 104 | </Position14> 105 | <Position15> 106 | <Filename Value="..\src\Diff_NP.pas"/> 107 | <Caret Line="180" Column="11" TopLine="164"/> 108 | </Position15> 109 | </JumpHistory> 110 | <RunParams> 111 | <FormatVersion Value="2"/> 112 | <Modes ActiveMode=""/> 113 | </RunParams> 114 | </ProjectSession> 115 | </CONFIG> 116 | -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo1/BasicDiffDemo1.res -------------------------------------------------------------------------------- /BasicDemo1/BasicDiffDemo1_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo1/BasicDiffDemo1_Icon.ico -------------------------------------------------------------------------------- /BasicDemo1/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 526 3 | Top = 192 4 | Caption = 'Basic Diff Demo' 5 | ClientHeight = 385 6 | ClientWidth = 367 7 | Color = clBtnFace 8 | Font.Charset = ANSI_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Arial' 12 | Font.Style = [] 13 | Position = poScreenCenter 14 | OnCreate = FormCreate 15 | TextHeight = 15 16 | object Label1: TLabel 17 | Left = 23 18 | Top = 23 19 | Width = 193 20 | Height = 15 21 | Caption = 'Type some text below and compare' 22 | end 23 | object PaintBox1: TPaintBox 24 | Left = 24 25 | Top = 160 26 | Width = 320 27 | Height = 161 28 | Font.Charset = ANSI_CHARSET 29 | Font.Color = clWindowText 30 | Font.Height = -12 31 | Font.Name = 'Courier New' 32 | Font.Style = [] 33 | ParentFont = False 34 | Visible = False 35 | OnPaint = PaintBox1Paint 36 | end 37 | object Edit1: TEdit 38 | Left = 23 39 | Top = 50 40 | Width = 320 41 | Height = 23 42 | TabOrder = 0 43 | Text = 'Lorem ipsum aterium' 44 | end 45 | object Edit2: TEdit 46 | Left = 23 47 | Top = 83 48 | Width = 320 49 | Height = 23 50 | TabOrder = 1 51 | Text = 'Lohames in uto' 52 | end 53 | object Button1: TButton 54 | Left = 23 55 | Top = 121 56 | Width = 320 57 | Height = 25 58 | Caption = 'Co&mpare' 59 | Default = True 60 | TabOrder = 2 61 | OnClick = Button1Click 62 | end 63 | object Button2: TButton 64 | Left = 24 65 | Top = 335 66 | Width = 320 67 | Height = 25 68 | Caption = '&Close' 69 | ModalResult = 1 70 | TabOrder = 3 71 | OnClick = Button2Click 72 | end 73 | end 74 | -------------------------------------------------------------------------------- /BasicDemo1/Unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 526 3 | Height = 385 4 | Top = 192 5 | Width = 396 6 | Caption = 'Basic Diff Demo' 7 | ClientHeight = 385 8 | ClientWidth = 396 9 | Color = clBtnFace 10 | DefaultMonitor = dmDesktop 11 | Font.CharSet = ANSI_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -12 14 | Font.Name = 'Arial' 15 | OnCreate = FormCreate 16 | OnShow = FormShow 17 | Position = poScreenCenter 18 | LCLVersion = '2.0.8.0' 19 | Visible = True 20 | object Label1: TLabel 21 | Left = 23 22 | Height = 15 23 | Top = 23 24 | Width = 222 25 | Caption = ' ' 26 | ParentColor = False 27 | end 28 | object PaintBox1: TPaintBox 29 | Left = 24 30 | Height = 161 31 | Top = 159 32 | Width = 352 33 | Font.CharSet = ANSI_CHARSET 34 | Font.Color = clWindowText 35 | Font.Height = -13 36 | Font.Name = 'Courier New' 37 | ParentFont = False 38 | Visible = False 39 | OnPaint = PaintBox1Paint 40 | end 41 | object Edit1: TEdit 42 | Left = 23 43 | Height = 23 44 | Top = 50 45 | Width = 353 46 | TabOrder = 0 47 | Text = 'Change the text here & then compare' 48 | end 49 | object Edit2: TEdit 50 | Left = 23 51 | Height = 23 52 | Top = 83 53 | Width = 353 54 | TabOrder = 1 55 | Text = 'Change the text here & then compare' 56 | end 57 | object Button1: TButton 58 | Left = 23 59 | Height = 25 60 | Top = 121 61 | Width = 353 62 | Caption = 'Co&mpare' 63 | Default = True 64 | OnClick = Button1Click 65 | TabOrder = 2 66 | end 67 | object Button2: TButton 68 | Left = 24 69 | Height = 25 70 | Top = 335 71 | Width = 352 72 | Caption = '&Close' 73 | ModalResult = 1 74 | OnClick = Button2Click 75 | TabOrder = 3 76 | end 77 | end 78 | -------------------------------------------------------------------------------- /BasicDemo1/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | {$IFDEF FPC} 11 | LCLIntf, LCLType, 12 | {$ENDIF} 13 | SysUtils, 14 | Variants, 15 | Classes, 16 | Graphics, 17 | Controls, 18 | Forms, 19 | Dialogs, 20 | StdCtrls, 21 | DiffTypes, 22 | Diff, 23 | ExtCtrls; 24 | 25 | type 26 | 27 | { TForm1 } 28 | 29 | TForm1 = class(TForm) 30 | Edit1: TEdit; 31 | Edit2: TEdit; 32 | Button1: TButton; 33 | Label1: TLabel; 34 | PaintBox1: TPaintBox; 35 | Button2: TButton; 36 | procedure FormCreate(Sender: TObject); 37 | procedure Button1Click(Sender: TObject); 38 | procedure PaintBox1Paint(Sender: TObject); 39 | procedure Button2Click(Sender: TObject); 40 | private 41 | Diff: TDiff; 42 | FCharHeight: Integer; 43 | FCharWidth: Integer; 44 | public 45 | { Public declarations } 46 | end; 47 | 48 | 49 | var 50 | Form1: TForm1; 51 | 52 | implementation 53 | 54 | {$R *.dfm} 55 | 56 | 57 | { TForm1 } 58 | 59 | procedure TForm1.FormCreate(Sender: TObject); 60 | begin 61 | Diff := TDiff.Create(self); 62 | FCharHeight := 0; 63 | FCharWidth := 0; 64 | end; 65 | 66 | procedure TForm1.Button1Click(Sender: TObject); 67 | begin 68 | //do the 'diff' here ... 69 | Diff.Execute(edit1.text, edit2.text); 70 | 71 | PaintBox1.visible := true; 72 | PaintBox1.Invalidate; 73 | end; 74 | 75 | procedure TForm1.PaintBox1Paint(Sender: TObject); 76 | var 77 | i: Integer; 78 | clBk: TColor; 79 | ch1,ch2: Char; 80 | x,y: Integer; 81 | LCanvas: TCanvas; 82 | begin 83 | x := 1; 84 | y := 1; 85 | LCanvas := PaintBox1.Canvas; 86 | if FCharHeight = 0 then 87 | FCharHeight := LCanvas.TextHeight('W'); 88 | if FCharWidth = 0 then 89 | FCharWidth := LCanvas.TextWidth('W'); 90 | for i := 0 to Diff.count-1 do 91 | begin 92 | with Diff.Compares[i] do 93 | begin 94 | if Kind = ckAdd then 95 | begin 96 | ch1 := #32; 97 | ch2 := chr2; 98 | clBk := $FFAAAA; 99 | end 100 | else if Kind = ckDelete then 101 | begin 102 | ch1 := chr1; 103 | ch2 := #32; 104 | clBk := $AAAAFF; 105 | end 106 | else if Kind = ckModify then 107 | begin 108 | ch1 := chr1; 109 | ch2 := chr2; 110 | clBk := $AAFFAA; 111 | end 112 | else 113 | begin 114 | ch1 := chr1; 115 | ch2 := chr2; 116 | clBk := clBtnFace; 117 | end; 118 | 119 | LCanvas.Brush.Color := clBk; 120 | LCanvas.TextOut(x,y,ch1); 121 | LCanvas.TextOut(x,y+FCharHeight+2,ch2); 122 | Inc(x,FCharWidth); 123 | end; 124 | end; 125 | 126 | y := y+3*FCharHeight; 127 | LCanvas.Brush.Color := clBtnFace; 128 | LCanvas.TextOut(0,y,'Compare Statistics ...'); 129 | with Diff.DiffStats do 130 | begin 131 | y := y+FCharHeight+5; 132 | LCanvas.Brush.Color := clBtnFace; 133 | LCanvas.TextOut(0,y,' Matches : '+inttostr(matches)); 134 | y := y+FCharHeight+2; 135 | LCanvas.Brush.Color := $AAFFAA; 136 | LCanvas.TextOut(0,y,' Modifies: '+inttostr(modifies)); 137 | y := y+FCharHeight+2; 138 | LCanvas.Brush.Color := $FFAAAA; 139 | LCanvas.TextOut(0,y,' Adds : '+inttostr(adds)); 140 | y := y+FCharHeight+2; 141 | LCanvas.Brush.Color := $AAAAFF; 142 | LCanvas.TextOut(0,y,' Deletes : '+inttostr(deletes)); 143 | end; 144 | end; 145 | 146 | procedure TForm1.Button2Click(Sender: TObject); 147 | begin 148 | close; 149 | end; 150 | 151 | end. 152 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.dpr: -------------------------------------------------------------------------------- 1 | // JCL_DEBUG_EXPERT_GENERATEJDBG OFF 2 | program BasicDiffDemo2; 3 | 4 | {$IFDEF FPC} 5 | {$MODE Delphi} 6 | {$ENDIF} 7 | 8 | uses 9 | {$IFnDEF FPC} 10 | {$ELSE} 11 | Interfaces, 12 | {$ENDIF } 13 | Forms, 14 | Unit1 in 'Unit1.pas' {Form1}, 15 | Diff in '..\src\Diff.pas', 16 | Diff_ND in '..\src\Diff_ND.pas', 17 | Diff_NP in '..\src\Diff_NP.pas', 18 | DiffTypes in '..\src\DiffTypes.pas', 19 | HashUnit in '..\src\HashUnit.pas'; 20 | 21 | {$R *.res} 22 | 23 | begin 24 | Application.Initialize; 25 | Application.CreateForm(TForm1, Form1); 26 | Application.Run; 27 | end. 28 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.dproj.local: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="utf-8"?> 2 | <BorlandProject/> 3 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.identcache: -------------------------------------------------------------------------------- 1 | ��\C:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\BasicDemo2\BasicDiffDemo2.dpr��PC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\DiffTypes.pas��NC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\Diff_NP.pas��SC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\BasicDemo2\Unit1.pas��KC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\Diff.pas��OC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\HashUnit.pas��NC:\Users\simon\Desktop\Diff 1.0 - Rickard Johansson OK - Copia\src\Diff_ND.pas�� -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="12"/> 5 | <PathDelim Value="\"/> 6 | <General> 7 | <Flags> 8 | <MainUnitHasUsesSectionForAllUnits Value="False"/> 9 | <MainUnitHasCreateFormStatements Value="False"/> 10 | <MainUnitHasTitleStatement Value="False"/> 11 | <MainUnitHasScaledStatement Value="False"/> 12 | <CompatibilityMode Value="True"/> 13 | </Flags> 14 | <SessionStorage Value="InProjectDir"/> 15 | <Title Value="BasicDiffDemo2"/> 16 | <UseAppBundle Value="False"/> 17 | <ResourceType Value="res"/> 18 | </General> 19 | <BuildModes Count="1"> 20 | <Item1 Name="Default" Default="True"/> 21 | </BuildModes> 22 | <PublishOptions> 23 | <Version Value="2"/> 24 | <UseFileFilters Value="True"/> 25 | </PublishOptions> 26 | <RunParams> 27 | <FormatVersion Value="2"/> 28 | </RunParams> 29 | <RequiredPackages Count="1"> 30 | <Item1> 31 | <PackageName Value="LCL"/> 32 | </Item1> 33 | </RequiredPackages> 34 | <Units Count="4"> 35 | <Unit0> 36 | <Filename Value="BasicDiffDemo2.dpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | <Unit1> 40 | <Filename Value="Unit1.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <ComponentName Value="Form1"/> 43 | <HasResources Value="True"/> 44 | <ResourceBaseClass Value="Form"/> 45 | </Unit1> 46 | <Unit2> 47 | <Filename Value="..\src\HashUnit.pas"/> 48 | <IsPartOfProject Value="True"/> 49 | </Unit2> 50 | <Unit3> 51 | <Filename Value="..\src\Diff.pas"/> 52 | <IsPartOfProject Value="True"/> 53 | </Unit3> 54 | </Units> 55 | </ProjectOptions> 56 | <CompilerOptions> 57 | <Version Value="11"/> 58 | <PathDelim Value="\"/> 59 | <SearchPaths> 60 | <IncludeFiles Value=".."/> 61 | <OtherUnitFiles Value="..\src"/> 62 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 63 | </SearchPaths> 64 | <Parsing> 65 | <SyntaxOptions> 66 | <SyntaxMode Value="delphi"/> 67 | </SyntaxOptions> 68 | </Parsing> 69 | <Linking> 70 | <Debugging> 71 | <DebugInfoType Value="dsDwarf3"/> 72 | </Debugging> 73 | <Options> 74 | <Win32> 75 | <GraphicApplication Value="True"/> 76 | </Win32> 77 | </Options> 78 | </Linking> 79 | <Other> 80 | <CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/> 81 | </Other> 82 | </CompilerOptions> 83 | <Debugging> 84 | <Exceptions Count="3"> 85 | <Item1> 86 | <Name Value="EAbort"/> 87 | </Item1> 88 | <Item2> 89 | <Name Value="ECodetoolError"/> 90 | </Item2> 91 | <Item3> 92 | <Name Value="EFOpenError"/> 93 | </Item3> 94 | </Exceptions> 95 | </Debugging> 96 | </CONFIG> 97 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="12"/> 6 | <BuildModes Active="Default"/> 7 | <Units Count="4"> 8 | <Unit0> 9 | <Filename Value="BasicDiffDemo2.dpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <UsageCount Value="20"/> 12 | <Loaded Value="True"/> 13 | </Unit0> 14 | <Unit1> 15 | <Filename Value="Unit1.pas"/> 16 | <IsPartOfProject Value="True"/> 17 | <ComponentName Value="Form1"/> 18 | <HasResources Value="True"/> 19 | <ResourceBaseClass Value="Form"/> 20 | <IsVisibleTab Value="True"/> 21 | <EditorIndex Value="1"/> 22 | <TopLine Value="109"/> 23 | <CursorPos X="29" Y="115"/> 24 | <UsageCount Value="20"/> 25 | <Loaded Value="True"/> 26 | <LoadedDesigner Value="True"/> 27 | </Unit1> 28 | <Unit2> 29 | <Filename Value="..\src\HashUnit.pas"/> 30 | <IsPartOfProject Value="True"/> 31 | <UsageCount Value="20"/> 32 | </Unit2> 33 | <Unit3> 34 | <Filename Value="..\src\Diff.pas"/> 35 | <IsPartOfProject Value="True"/> 36 | <UsageCount Value="20"/> 37 | </Unit3> 38 | </Units> 39 | <JumpHistory Count="6" HistoryIndex="5"> 40 | <Position1> 41 | <Filename Value="BasicDiffDemo2.dpr"/> 42 | </Position1> 43 | <Position2> 44 | <Filename Value="Unit1.pas"/> 45 | <Caret Line="15" Column="12" TopLine="45"/> 46 | </Position2> 47 | <Position3> 48 | <Filename Value="Unit1.pas"/> 49 | <Caret Line="293" Column="38" TopLine="277"/> 50 | </Position3> 51 | <Position4> 52 | <Filename Value="Unit1.pas"/> 53 | <Caret Line="85" Column="36" TopLine="78"/> 54 | </Position4> 55 | <Position5> 56 | <Filename Value="Unit1.pas"/> 57 | <Caret Line="34" Column="5" TopLine="26"/> 58 | </Position5> 59 | <Position6> 60 | <Filename Value="Unit1.pas"/> 61 | <Caret Line="14" Column="20" TopLine="8"/> 62 | </Position6> 63 | </JumpHistory> 64 | <RunParams> 65 | <FormatVersion Value="2"/> 66 | <Modes ActiveMode=""/> 67 | </RunParams> 68 | </ProjectSession> 69 | </CONFIG> 70 | -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo2/BasicDiffDemo2.res -------------------------------------------------------------------------------- /BasicDemo2/BasicDiffDemo2_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/BasicDemo2/BasicDiffDemo2_Icon.ico -------------------------------------------------------------------------------- /BasicDemo2/Unit1.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 190 3 | Top = 219 4 | Caption = 'Basic Diff Demo2' 5 | ClientHeight = 365 6 | ClientWidth = 804 7 | Color = clBtnFace 8 | Font.Charset = ANSI_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -12 11 | Font.Name = 'Arial' 12 | Font.Style = [] 13 | Menu = MainMenu1 14 | Position = poScreenCenter 15 | OnActivate = FormActivate 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | OnResize = FormResize 19 | TextHeight = 15 20 | object Panel1: TPanel 21 | Left = 0 22 | Top = 0 23 | Width = 804 24 | Height = 23 25 | Align = alTop 26 | BevelOuter = bvNone 27 | TabOrder = 0 28 | ExplicitWidth = 798 29 | object lblFile1: TLabel 30 | Left = 0 31 | Top = 5 32 | Width = 36 33 | Height = 15 34 | Caption = ' File1: ' 35 | end 36 | object lblFile2: TLabel 37 | Left = 381 38 | Top = 5 39 | Width = 36 40 | Height = 15 41 | Caption = ' File2: ' 42 | end 43 | end 44 | object StatusBar1: TStatusBar 45 | Left = 0 46 | Top = 346 47 | Width = 804 48 | Height = 19 49 | Panels = < 50 | item 51 | Width = 100 52 | end 53 | item 54 | Width = 100 55 | end 56 | item 57 | Width = 100 58 | end 59 | item 60 | Width = 100 61 | end> 62 | ExplicitTop = 329 63 | ExplicitWidth = 798 64 | end 65 | object ResultGrid: TStringGrid 66 | Left = 0 67 | Top = 23 68 | Width = 804 69 | Height = 323 70 | Align = alClient 71 | ColCount = 4 72 | DefaultRowHeight = 17 73 | DefaultDrawing = False 74 | FixedCols = 0 75 | RowCount = 1 76 | FixedRows = 0 77 | Font.Charset = ANSI_CHARSET 78 | Font.Color = clWindowText 79 | Font.Height = -12 80 | Font.Name = 'Courier New' 81 | Font.Style = [] 82 | GridLineWidth = 0 83 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goRowSelect] 84 | ParentFont = False 85 | TabOrder = 2 86 | OnDrawCell = ResultGridDrawCell 87 | ExplicitWidth = 798 88 | ExplicitHeight = 306 89 | end 90 | object MainMenu1: TMainMenu 91 | Left = 112 92 | Top = 137 93 | object File1: TMenuItem 94 | Caption = '&File' 95 | object Open11: TMenuItem 96 | Caption = 'Open &1 ...' 97 | ShortCut = 16433 98 | OnClick = Open11Click 99 | end 100 | object Open21: TMenuItem 101 | Caption = 'Open &2 ...' 102 | ShortCut = 16434 103 | OnClick = Open21Click 104 | end 105 | object N1: TMenuItem 106 | Caption = '-' 107 | end 108 | object mnuCompare: TMenuItem 109 | Caption = '&Compare' 110 | Enabled = False 111 | ShortCut = 120 112 | OnClick = mnuCompareClick 113 | end 114 | object mnuCancel: TMenuItem 115 | Caption = 'C&ancel' 116 | Enabled = False 117 | ShortCut = 27 118 | OnClick = mnuCancelClick 119 | end 120 | object N2: TMenuItem 121 | Caption = '-' 122 | end 123 | object Exit1: TMenuItem 124 | Caption = 'E&xit' 125 | OnClick = Exit1Click 126 | end 127 | end 128 | object mnuView: TMenuItem 129 | Caption = '&View' 130 | Enabled = False 131 | object PreviousChanges1: TMenuItem 132 | Caption = '&Previous Changes' 133 | ShortCut = 16464 134 | OnClick = PreviousChanges1Click 135 | end 136 | object NextChanges1: TMenuItem 137 | Caption = '&Next Changes' 138 | ShortCut = 16462 139 | OnClick = NextChanges1Click 140 | end 141 | end 142 | object Options1: TMenuItem 143 | Caption = '&Options' 144 | object mnuIgnoreCase: TMenuItem 145 | Caption = 'Ignore &Case' 146 | OnClick = mnuIgnoreCaseClick 147 | end 148 | object mnuIgnoreWhiteSpace: TMenuItem 149 | Caption = 'Ignore &White Space' 150 | OnClick = mnuIgnoreWhiteSpaceClick 151 | end 152 | object N3: TMenuItem 153 | Caption = '-' 154 | end 155 | object mnuNP: TMenuItem 156 | Caption = 'O(NP) Sequence Comparison Algorithm' 157 | Checked = True 158 | GroupIndex = 10 159 | RadioItem = True 160 | OnClick = mnuNPClick 161 | end 162 | object mnuND: TMenuItem 163 | Caption = 'O(ND) Difference Algorithm' 164 | GroupIndex = 10 165 | RadioItem = True 166 | OnClick = mnuNDClick 167 | end 168 | end 169 | end 170 | object OpenDialog1: TOpenDialog 171 | Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing] 172 | Left = 183 173 | Top = 119 174 | end 175 | end 176 | -------------------------------------------------------------------------------- /BasicDemo2/Unit1.lfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 353 3 | Height = 548 4 | Top = 239 5 | Width = 1206 6 | Caption = 'Basic Diff Demo2' 7 | ClientHeight = 548 8 | ClientWidth = 1206 9 | Color = clBtnFace 10 | DesignTimePPI = 144 11 | Font.CharSet = ANSI_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -18 14 | Font.Name = 'Arial' 15 | Menu = MainMenu1 16 | OnActivate = FormActivate 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | OnResize = FormResize 20 | Position = poScreenCenter 21 | LCLVersion = '3.6.0.0' 22 | object Panel1: TPanel 23 | Left = 0 24 | Height = 34 25 | Top = 0 26 | Width = 1206 27 | Align = alTop 28 | BevelOuter = bvNone 29 | ClientHeight = 34 30 | ClientWidth = 1206 31 | ParentBackground = False 32 | TabOrder = 0 33 | object lblFile1: TLabel 34 | Left = 0 35 | Height = 21 36 | Top = 8 37 | Width = 54 38 | Caption = ' File1: ' 39 | ParentColor = False 40 | end 41 | object lblFile2: TLabel 42 | Left = 572 43 | Height = 21 44 | Top = 8 45 | Width = 54 46 | Caption = ' File2: ' 47 | ParentColor = False 48 | end 49 | end 50 | object StatusBar1: TStatusBar 51 | Left = 0 52 | Height = 36 53 | Top = 512 54 | Width = 1206 55 | Panels = < 56 | item 57 | Width = 150 58 | end 59 | item 60 | Width = 150 61 | end 62 | item 63 | Width = 150 64 | end 65 | item 66 | Width = 150 67 | end> 68 | end 69 | object ResultGrid: TStringGrid 70 | Left = 0 71 | Height = 478 72 | Top = 34 73 | Width = 1206 74 | Align = alClient 75 | ColCount = 4 76 | DefaultDrawing = False 77 | DefaultRowHeight = 26 78 | DoubleBuffered = True 79 | FixedCols = 0 80 | FixedRows = 0 81 | Flat = True 82 | Font.CharSet = ANSI_CHARSET 83 | Font.Color = clWindowText 84 | Font.Height = -18 85 | Font.Name = 'Courier New' 86 | GridLineWidth = 0 87 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goDrawFocusSelected, goRowSelect, goRowHighlight] 88 | ParentDoubleBuffered = False 89 | ParentFont = False 90 | RowCount = 1 91 | TabOrder = 2 92 | OnDrawCell = ResultGridDrawCell 93 | ColWidths = ( 94 | 300 95 | 300 96 | 300 97 | 304 98 | ) 99 | end 100 | object MainMenu1: TMainMenu 101 | Left = 168 102 | Top = 206 103 | object File1: TMenuItem 104 | Caption = '&File' 105 | object Open11: TMenuItem 106 | Caption = 'Open &1 ...' 107 | ShortCut = 16433 108 | OnClick = Open11Click 109 | end 110 | object Open21: TMenuItem 111 | Caption = 'Open &2 ...' 112 | ShortCut = 16434 113 | OnClick = Open21Click 114 | end 115 | object N1: TMenuItem 116 | Caption = '-' 117 | end 118 | object mnuCompare: TMenuItem 119 | Caption = '&Compare' 120 | Enabled = False 121 | ShortCut = 120 122 | OnClick = mnuCompareClick 123 | end 124 | object mnuCancel: TMenuItem 125 | Caption = 'C&ancel' 126 | Enabled = False 127 | ShortCut = 27 128 | OnClick = mnuCancelClick 129 | end 130 | object N2: TMenuItem 131 | Caption = '-' 132 | end 133 | object Exit1: TMenuItem 134 | Caption = 'E&xit' 135 | OnClick = Exit1Click 136 | end 137 | end 138 | object mnuView: TMenuItem 139 | Caption = '&View' 140 | Enabled = False 141 | object PreviousChanges1: TMenuItem 142 | Caption = '&Previous Changes' 143 | ShortCut = 16464 144 | OnClick = PreviousChanges1Click 145 | end 146 | object NextChanges1: TMenuItem 147 | Caption = '&Next Changes' 148 | ShortCut = 16462 149 | OnClick = NextChanges1Click 150 | end 151 | end 152 | object Options1: TMenuItem 153 | Caption = '&Options' 154 | object mnuIgnoreCase: TMenuItem 155 | Caption = 'Ignore &Case' 156 | OnClick = mnuIgnoreCaseClick 157 | end 158 | object mnuIgnoreWhiteSpace: TMenuItem 159 | Caption = 'Ignore &White Space' 160 | OnClick = mnuIgnoreWhiteSpaceClick 161 | end 162 | end 163 | end 164 | object OpenDialog1: TOpenDialog 165 | Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing] 166 | Left = 275 167 | Top = 179 168 | end 169 | end 170 | -------------------------------------------------------------------------------- /BasicDemo2/Unit1.pas: -------------------------------------------------------------------------------- 1 | unit Unit1; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | {$IFnDEF FPC} 11 | Generics.Collections, 12 | System.Types, 13 | {$ELSE} 14 | FGL, IntegerList, 15 | {$ENDIF} 16 | SysUtils, 17 | Variants, 18 | Classes, 19 | Graphics, 20 | Controls, 21 | Forms, 22 | Dialogs, 23 | StdCtrls, 24 | Math, 25 | DiffTypes, 26 | Diff, 27 | ExtCtrls, 28 | Grids, 29 | Menus, 30 | ComCtrls; 31 | 32 | type 33 | {.$IFDEF FPC} 34 | //TIntegerList = TFPGList<Cardinal>; 35 | {.$ENDIF} 36 | 37 | TForm1 = class(TForm) 38 | MainMenu1: TMainMenu; 39 | File1: TMenuItem; 40 | Open11: TMenuItem; 41 | Open21: TMenuItem; 42 | N1: TMenuItem; 43 | mnuCompare: TMenuItem; 44 | N2: TMenuItem; 45 | Exit1: TMenuItem; 46 | OpenDialog1: TOpenDialog; 47 | mnuCancel: TMenuItem; 48 | Panel1: TPanel; 49 | lblFile1: TLabel; 50 | lblFile2: TLabel; 51 | StatusBar1: TStatusBar; 52 | ResultGrid: TStringGrid; 53 | Options1: TMenuItem; 54 | mnuIgnoreCase: TMenuItem; 55 | mnuIgnoreWhiteSpace: TMenuItem; 56 | mnuView: TMenuItem; 57 | PreviousChanges1: TMenuItem; 58 | NextChanges1: TMenuItem; 59 | N3: TMenuItem; 60 | mnuNP: TMenuItem; 61 | mnuND: TMenuItem; 62 | procedure FormCreate(Sender: TObject); 63 | procedure Open11Click(Sender: TObject); 64 | procedure Open21Click(Sender: TObject); 65 | procedure Exit1Click(Sender: TObject); 66 | procedure FormDestroy(Sender: TObject); 67 | procedure mnuCompareClick(Sender: TObject); 68 | procedure mnuCancelClick(Sender: TObject); 69 | procedure FormResize(Sender: TObject); 70 | procedure ResultGridDrawCell(Sender: TObject; ACol, ARow: Integer; 71 | Rect: TRect; State: TGridDrawState); 72 | procedure mnuIgnoreCaseClick(Sender: TObject); 73 | procedure mnuIgnoreWhiteSpaceClick(Sender: TObject); 74 | procedure PreviousChanges1Click(Sender: TObject); 75 | procedure NextChanges1Click(Sender: TObject); 76 | procedure FormActivate(Sender: TObject); 77 | procedure mnuNDClick(Sender: TObject); 78 | procedure mnuNPClick(Sender: TObject); 79 | private 80 | Diff: TDiff; 81 | FDiffAlgorithm: TDiffAlgorithm; 82 | source1, source2: TStringList; 83 | result1, result2: TStringList; 84 | {$IFDEF FPC} 85 | hashlist1, hashlist2: TCardinalList; 86 | {$ELSE} 87 | hashlist1, hashlist2: TList<Cardinal>; 88 | {$ENDIF} 89 | procedure Clear(aleft,aright: boolean); 90 | procedure BuildHashList(left,right: boolean); 91 | procedure OpenFile1(const filename: string); 92 | procedure OpenFile2(const filename: string); 93 | public 94 | { Public declarations } 95 | end; 96 | 97 | var 98 | Form1: TForm1; 99 | 100 | implementation 101 | 102 | uses HashUnit; 103 | 104 | {$R *.dfm} 105 | 106 | procedure TForm1.FormCreate(Sender: TObject); 107 | begin 108 | Diff := TDiff.Create(self); 109 | source1 := TStringList.Create; 110 | source2 := TStringList.Create; 111 | result1 := TStringList.Create; 112 | result2 := TStringList.Create; 113 | {$IFDEF FPC} 114 | hashlist1 := TCardinalList.Create; 115 | hashlist2 := TCardinalList.Create; 116 | {$ELSE} 117 | hashlist1 := TList<Cardinal>.Create; 118 | hashlist2 := TList<Cardinal>.Create; 119 | {$ENDIF} 120 | 121 | FDiffAlgorithm := algNP; 122 | ResultGrid.ColWidths[0] := 40; 123 | ResultGrid.ColWidths[2] := 40; 124 | ResultGrid.Canvas.Font := ResultGrid.Font; 125 | end; 126 | //------------------------------------------------------------------------------ 127 | 128 | procedure TForm1.FormActivate(Sender: TObject); 129 | begin 130 | if (paramcount > 0) then OpenFile1(paramstr(1)); 131 | if (paramcount > 1) then OpenFile2(paramstr(2)); 132 | mnuCompareClick(nil); 133 | end; 134 | //------------------------------------------------------------------------------ 135 | 136 | procedure TForm1.FormDestroy(Sender: TObject); 137 | begin 138 | source1.Free; 139 | source2.Free; 140 | result1.Free; 141 | result2.Free; 142 | hashlist1.Free; 143 | hashlist2.Free; 144 | end; 145 | //------------------------------------------------------------------------------ 146 | 147 | procedure TForm1.Clear(aleft, aright: boolean); 148 | begin 149 | if aleft then 150 | begin 151 | source1.Clear; 152 | result1.Clear; 153 | hashlist1.Clear; 154 | lblFile1.Caption := ' File1: '; 155 | end; 156 | if aright then 157 | begin 158 | source2.Clear; 159 | result2.Clear; 160 | hashlist2.Clear; 161 | lblFile2.Caption := ' File2: '; 162 | end; 163 | ResultGrid.RowCount := 0; 164 | Diff.Clear; 165 | StatusBar1.Panels[0].Text := ''; 166 | StatusBar1.Panels[1].Text := ''; 167 | StatusBar1.Panels[2].Text := ''; 168 | StatusBar1.Panels[3].Text := ''; 169 | mnuCompare.Enabled := false; 170 | mnuView.Enabled := false; 171 | end; 172 | //------------------------------------------------------------------------------ 173 | 174 | //Because it's SO MUCH EASIER AND FASTER comparing hashes (integers) than 175 | //comparing whole lines of text, we'll build a list of hashes for each line 176 | //in the source files. Each line is represented by a (virtually) unique 177 | //hash that is based on the contents of that line. Also, since the 178 | //likelihood of 2 different lines generating the same hash is so small, 179 | //we can safely ignore that possibility. 180 | 181 | procedure TForm1.BuildHashList(left,right: boolean); 182 | var 183 | i: integer; 184 | begin 185 | if left then 186 | begin 187 | hashlist1.Clear; 188 | for i := 0 to source1.Count -1 do 189 | hashlist1.Add(HashLine(source1[i], 190 | mnuIgnoreCase.Checked, mnuIgnoreWhiteSpace.checked)); 191 | end; 192 | if right then 193 | begin 194 | hashlist2.Clear; 195 | for i := 0 to source2.Count -1 do 196 | hashlist2.Add(HashLine(source2[i], 197 | mnuIgnoreCase.Checked, mnuIgnoreWhiteSpace.checked)); 198 | end; 199 | 200 | mnuCompare.Enabled := (hashlist1.Count > 0) and (hashlist2.Count > 0); 201 | end; 202 | //------------------------------------------------------------------------------ 203 | 204 | procedure TForm1.OpenFile1(const filename: string); 205 | var 206 | i: integer; 207 | begin 208 | if not fileExists(fileName) then exit; 209 | Clear(true,false); 210 | source1.LoadFromFile(fileName); 211 | lblFile1.Caption := ' File1: ' + ExtractFileName(fileName); 212 | 213 | BuildHashList(true,false); 214 | 215 | ResultGrid.RowCount := max(source1.Count, source2.Count); 216 | for i := 0 to 3 do ResultGrid.Cols[i].BeginUpdate; 217 | try 218 | for i := 0 to source1.Count -1 do 219 | begin 220 | ResultGrid.Cells[0,i] := inttostr(i+1); 221 | ResultGrid.Cells[1,i] := source1[i]; 222 | end; 223 | for i := 0 to source2.Count -1 do 224 | begin 225 | ResultGrid.Cells[2,i] := inttostr(i+1); 226 | ResultGrid.Cells[3,i] := source2[i]; 227 | end; 228 | finally 229 | for i := 0 to 3 do ResultGrid.Cols[i].EndUpdate; 230 | end; 231 | end; 232 | //------------------------------------------------------------------------------ 233 | 234 | procedure TForm1.OpenFile2(const filename: string); 235 | var 236 | i: integer; 237 | begin 238 | if not fileExists(fileName) then exit; 239 | Clear(false,true); 240 | source2.LoadFromFile(fileName); 241 | lblFile2.Caption := ' File2: ' + ExtractFileName(fileName); 242 | 243 | BuildHashList(false,true); 244 | 245 | ResultGrid.RowCount := max(source1.Count, source2.Count); 246 | for i := 0 to 3 do ResultGrid.Cols[i].BeginUpdate; 247 | try 248 | for i := 0 to source1.Count -1 do 249 | begin 250 | ResultGrid.Cells[0,i] := inttostr(i+1); 251 | ResultGrid.Cells[1,i] := source1[i]; 252 | end; 253 | for i := 0 to source2.Count -1 do 254 | begin 255 | ResultGrid.Cells[2,i] := inttostr(i+1); 256 | ResultGrid.Cells[3,i] := source2[i]; 257 | end; 258 | finally 259 | for i := 0 to 3 do ResultGrid.Cols[i].EndUpdate; 260 | end; 261 | end; 262 | //------------------------------------------------------------------------------ 263 | 264 | procedure TForm1.Open11Click(Sender: TObject); 265 | begin 266 | if OpenDialog1.Execute then OpenFile1(OpenDialog1.FileName); 267 | end; 268 | //------------------------------------------------------------------------------ 269 | 270 | procedure TForm1.Open21Click(Sender: TObject); 271 | begin 272 | if OpenDialog1.Execute then OpenFile2(OpenDialog1.FileName); 273 | end; 274 | //------------------------------------------------------------------------------ 275 | 276 | procedure TForm1.Exit1Click(Sender: TObject); 277 | begin 278 | close; 279 | end; 280 | //------------------------------------------------------------------------------ 281 | 282 | procedure TForm1.mnuCompareClick(Sender: TObject); 283 | var 284 | i: integer; 285 | begin 286 | if (hashlist1.Count = 0) or (hashlist2.Count = 0) then exit; 287 | mnuCancel.Enabled := true; 288 | screen.Cursor := crHourGlass; 289 | try 290 | //this is where it all happens ... 291 | 292 | //nb: TList.list is a pointer to the bottom of the list's integer array 293 | Diff.Execute(hashlist1, hashlist2, FDiffAlgorithm); 294 | 295 | if Diff.Cancelled then exit; 296 | 297 | //now fill ResultGrid with the differences ... 298 | for i := 0 to 3 do 299 | begin 300 | ResultGrid.Cols[i].BeginUpdate; 301 | ResultGrid.Cols[i].Clear; 302 | end; 303 | try 304 | ResultGrid.RowCount := Diff.Count; 305 | for i := 0 to Diff.Count -1 do 306 | with Diff.Compares[i], ResultGrid do 307 | begin 308 | if Kind <> ckAdd then 309 | begin 310 | Cells[0,i] := inttostr(oldIndex1+1); 311 | Cells[1,i] := source1[oldIndex1]; 312 | end; 313 | if Kind <> ckDelete then 314 | begin 315 | Cells[2,i] := inttostr(oldIndex2+1); 316 | Cells[3,i] := source2[oldIndex2]; 317 | end; 318 | end; 319 | finally 320 | for i := 0 to 3 do ResultGrid.Cols[i].EndUpdate; 321 | end; 322 | 323 | with Diff.DiffStats do 324 | begin 325 | StatusBar1.SimplePanel := False; 326 | StatusBar1.Panels[0].Text := ' Matches: ' + inttostr(matches); 327 | StatusBar1.Panels[1].Text := ' Modifies: ' + inttostr(modifies); 328 | StatusBar1.Panels[2].Text := ' Adds: ' + inttostr(adds); 329 | StatusBar1.Panels[3].Text := ' Deletes: ' + inttostr(deletes); 330 | end; 331 | 332 | finally 333 | screen.Cursor := crDefault; 334 | mnuCancel.Enabled := false; 335 | end; 336 | mnuView.Enabled := true; 337 | end; 338 | //------------------------------------------------------------------------------ 339 | 340 | procedure TForm1.mnuCancelClick(Sender: TObject); 341 | begin 342 | Diff.Cancel; 343 | end; 344 | //------------------------------------------------------------------------------ 345 | 346 | procedure TForm1.FormResize(Sender: TObject); 347 | var 348 | i: integer; 349 | begin 350 | with ResultGrid do 351 | begin 352 | i := (ClientWidth -80) div 2; 353 | ResultGrid.ColWidths[1] := i; 354 | ResultGrid.ColWidths[3] := i; 355 | end; 356 | lblFile2.Left := Panel1.ClientWidth div 2; 357 | end; 358 | //------------------------------------------------------------------------------ 359 | 360 | procedure AddCharToStr(var s: string; c: char; kind, lastkind: TChangeKind); 361 | begin 362 | if (Kind = lastKind) then s := s + c 363 | else 364 | case kind of 365 | ckNone: s := s + '<BC:------>' + c; 366 | else s := s + '<BC:33FFFF>' + c; 367 | end; 368 | end; 369 | //------------------------------------------------------------------------------ 370 | 371 | procedure TForm1.ResultGridDrawCell(Sender: TObject; ACol, ARow: Integer; 372 | Rect: TRect; State: TGridDrawState); 373 | const 374 | PaleGreen: TColor = $AAFFAA; 375 | PaleRed : TColor = $AAAAFF; 376 | PaleBlue : TColor = $FFAAAA; 377 | var 378 | clr,ctxt: Tcolor; 379 | begin 380 | if (gdSelected in State) and (ACol in [0,2]) then 381 | begin 382 | clr := clHighlight; 383 | ctxt := clHighlightText; 384 | end 385 | else if (Diff.Count = 0) then 386 | begin 387 | clr := clWhite; 388 | ctxt := clBlack; 389 | end 390 | else 391 | begin 392 | clr := clBtnFace; 393 | ctxt := clBlack; 394 | end; 395 | 396 | if (ACol in [1,3]) and (ARow < Diff.Count) then 397 | begin 398 | case Diff.Compares[ARow].Kind of 399 | ckNone: clr := clWhite; 400 | ckModify: clr := PaleGreen; 401 | ckDelete: clr := PaleRed; 402 | ckAdd: clr := PaleBlue; 403 | end; 404 | end; 405 | 406 | with ResultGrid.Canvas do 407 | begin 408 | Brush.Color := clr; 409 | Font.Color := ctxt; 410 | FillRect(Rect); 411 | TextRect(Rect, Rect.Left+3,Rect.Top+2, ResultGrid.Cells[ACol,ARow]); 412 | 413 | if (source1.Count = 0) and (source2.Count = 0) then exit; 414 | 415 | //now just some fancy coloring ... 416 | if (ACol in [0,2]) then 417 | begin 418 | Pen.Color := clWhite; 419 | MoveTo(Rect.Right-1,0); 420 | LineTo(Rect.Right-1,Rect.Bottom); 421 | end else 422 | begin 423 | if (ACol = 1) then 424 | begin 425 | Pen.Color := $333333; 426 | MoveTo(Rect.Right-1,0); 427 | LineTo(Rect.Right-1,Rect.Bottom); 428 | end; 429 | Pen.Color := clSilver; 430 | MoveTo(Rect.Left,0); 431 | LineTo(Rect.Left,Rect.Bottom); 432 | end; 433 | //finally, draw the focusRect ... 434 | if (gdSelected in State) and (ACol in [1,3]) then 435 | begin 436 | rect.Left := 0; 437 | DrawFocusRect(Rect); 438 | end; 439 | end; 440 | end; 441 | //------------------------------------------------------------------------------ 442 | 443 | procedure TForm1.mnuIgnoreCaseClick(Sender: TObject); 444 | begin 445 | mnuIgnoreCase.Checked := not mnuIgnoreCase.Checked; 446 | Clear(false,false); 447 | BuildHashList(true,true); 448 | mnuCompareClick(nil); 449 | end; 450 | //------------------------------------------------------------------------------ 451 | 452 | procedure TForm1.mnuIgnoreWhiteSpaceClick(Sender: TObject); 453 | begin 454 | mnuIgnoreWhiteSpace.Checked := not mnuIgnoreWhiteSpace.Checked; 455 | Clear(false,false); 456 | BuildHashList(true,true); 457 | mnuCompareClick(nil); 458 | end; 459 | //------------------------------------------------------------------------------ 460 | 461 | function GridRect(Coord1, Coord2: TGridCoord): TGridRect; 462 | begin 463 | with Result do 464 | begin 465 | Left := Coord2.X; 466 | if Coord1.X < Coord2.X then Left := Coord1.X; 467 | Right := Coord1.X; 468 | if Coord1.X < Coord2.X then Right := Coord2.X; 469 | Top := Coord2.Y; 470 | if Coord1.Y < Coord2.Y then Top := Coord1.Y; 471 | Bottom := Coord1.Y; 472 | if Coord1.Y < Coord2.Y then Bottom := Coord2.Y; 473 | end; 474 | end; 475 | //------------------------------------------------------------------------------ 476 | 477 | procedure TForm1.PreviousChanges1Click(Sender: TObject); 478 | var 479 | row: integer; 480 | Kind: TChangeKind; 481 | begin 482 | row := ResultGrid.Selection.Top; 483 | if row = 0 then exit; 484 | Kind := Diff.Compares[row].Kind; 485 | while (row > 0) and (Diff.Compares[row].Kind = Kind) do dec(row); 486 | if Diff.Compares[row].Kind = ckNone then 487 | begin 488 | Kind := ckNone; 489 | while (row > 0) and 490 | (Diff.Compares[row].Kind = Kind) do dec(row); 491 | end; 492 | ResultGrid.Selection := TGridRect(Rect(0, row, 3, row)); 493 | If row < ResultGrid.TopRow then 494 | ResultGrid.TopRow := Max(0, row - ResultGrid.VisibleRowCount +1); 495 | 496 | ResultGrid.Row := row; 497 | end; 498 | //------------------------------------------------------------------------------ 499 | 500 | procedure TForm1.NextChanges1Click(Sender: TObject); 501 | var 502 | row: integer; 503 | Kind: TChangeKind; 504 | begin 505 | row := ResultGrid.Selection.Top; 506 | if row = ResultGrid.RowCount -1 then exit; 507 | Kind := Diff.Compares[row].Kind; 508 | while (row < ResultGrid.RowCount -1) and 509 | (Diff.Compares[row].Kind = Kind) do inc(row); 510 | if Diff.Compares[row].Kind = ckNone then 511 | begin 512 | Kind := ckNone; 513 | while (row < ResultGrid.RowCount -1) and 514 | (Diff.Compares[row].Kind = Kind) do inc(row); 515 | end; 516 | ResultGrid.Selection := TGridRect(Rect(0, row, 3, row)); 517 | if row > ResultGrid.TopRow + ResultGrid.VisibleRowCount -1 then 518 | ResultGrid.TopRow := max(0,min(row, ResultGrid.RowCount - ResultGrid.VisibleRowCount)); 519 | 520 | ResultGrid.Row := row; 521 | end; 522 | 523 | procedure TForm1.mnuNDClick(Sender: TObject); 524 | begin 525 | mnuND.Checked := not mnuND.Checked; 526 | FDiffAlgorithm := algND; 527 | Clear(false,false); 528 | mnuCompareClick(nil); 529 | end; 530 | 531 | procedure TForm1.mnuNPClick(Sender: TObject); 532 | begin 533 | mnuNP.Checked := not mnuNP.Checked; 534 | FDiffAlgorithm := algNP; 535 | Clear(false,false); 536 | mnuCompareClick(nil); 537 | end; 538 | 539 | //------------------------------------------------------------------------------ 540 | 541 | end. 542 | -------------------------------------------------------------------------------- /docs/O(ND).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/docs/O(ND).pdf -------------------------------------------------------------------------------- /docs/O(NP).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rickard67/TextDiff/68822bc1540e708ad94b45d6fb0f1035d6f22fe6/docs/O(NP).pdf -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Text compare component for Delphi and Free Pascal 2 | 3 | Source code for the freeware component TDiff is written in Delphi. This 4 | component dramatically simplify programming tasks that require calculations 5 | of 'shortest path' or 'longest common sequence' as typically required in file 6 | compare utilities. 7 | 8 | TDiff is used in RJ TextEd to compare text or source files. You need to add 9 | the units "DiffTypes" and "Diff" to the uses section of your application. 10 | 11 | The units "Diff_NP" and "Diff_ND" contains the available algorithms that can 12 | be used from the TDiff class. 13 | 14 | PDF documents fully describing the principle algorithms used in Diff_NP and Diff_ND...\ 15 | The algorithm in the Diff_ND unit is based on: 16 | "An O(ND) Difference Algorithm and its Variations" by E Myers - 17 | Algorithmica Vol. 1 No. 2, 1986, pp. 251-266\ 18 | The algorithm in the Diff_NP unit is based on: "An O(NP) Sequence Comparison Algorithm" 19 | by Sun Wu, Udi Manber & Gene Myers 20 | 21 | ### Getting Started 22 | 23 | Download the files and include the units DiffTypes and Diff in your project. 24 | 25 | ### Demo applications 26 | 27 | Two very simple demo applications (with full source code) are include to 28 | demonstrate how the 'TDiff' component can be used in Delphi and Lazarus programs. 29 | 30 | ### Authors 31 | Author : Angus Johnson - angusj-AT-myrealbox-DOT-com\ 32 | Copyright : © 2001-2008 Angus Johnson\ 33 | Updated by : Rickard Johansson ([RJ TextEd](https://www.rj-texted.se)) 34 | 35 | ### Version history 36 | - **1 May 2025**\ 37 | Added option to ignore case when comparing strings using Execute(s1, s2, ...). 38 | - **16 April 2025**\ 39 | Fixed an issue in Diff_ND when comparing strings. 40 | - **13 July 2023**\ 41 | Rewrote the component and made it easy to select the algorithm to use for comparison.\ 42 | Fixed several issues and updated the demos. 43 | - **23 May 2020**\ 44 | Replaced almost all code in demo 1. It should be much easier to understand now.\ 45 | Fixed a few issues in demo 2. 46 | - **19 May 2020**\ 47 | Added Lazarus support 48 | - **11 November 2018**\ 49 | Added TList<Cardinal> to store hash values.\ 50 | Made some minor code formatting and code changes\ 51 | Fixed Unicode string issues 52 | - **2 June 2008**\ 53 | Minor bugfixes. 54 | - **25 May 2008**\ 55 | Removed recursion to avoid the possibility of running out of stack memory during massive comparisons. 56 | - **24 May 2008**\ 57 | Reimplemented "divide-and-conquer" technique (which was omitted in 21 May release) so memory use is again minimal. 58 | - **21 May 2008**\ 59 | Another complete code rewrite to use Sun Wu et al. O(NP) Sequence Comparison Algorithm which more than halves times of typical comparisons. 60 | - **22 April 2008**\ 61 | Complete rewrite to greatly improve the code and provide a much simpler view of differences through a new 'Compares' property. 62 | - **December 2001**\ 63 | Original release (used Myer O(ND) Difference Algorithm) 64 | 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /src/Diff.pas: -------------------------------------------------------------------------------- 1 | unit Diff; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | (******************************************************************************* 8 | * Component TDiff * 9 | * Version: 1.0 * 10 | * Date: 1 May 2025 * 11 | * Compilers: Delphi 10.x * 12 | * Author: Rickard Johansson * 13 | * Copyright: � 2023 Rickard Johansson * 14 | * * 15 | * Licence to use, terms and conditions: * 16 | * The code in the TDiff component is released as freeware * 17 | * provided you agree to the following terms & conditions: * 18 | * 1. the copyright notice, terms and conditions are * 19 | * left unchanged * 20 | * 2. modifications to the code by other authors must be * 21 | * clearly documented and accompanied by the modifier's name. * 22 | * 3. the TDiff component may be freely compiled into binary * 23 | * format and no acknowledgement is required. However, a * 24 | * discrete acknowledgement would be appreciated (eg. in a * 25 | * program's 'About Box'). * 26 | * * 27 | * Description: Component to list differences between two integer arrays * 28 | * using a "longest common subsequence" algorithm. * 29 | * Typically, this component is used to diff 2 text files * 30 | * once their individuals lines have been hashed. * 31 | * * 32 | * * 33 | *******************************************************************************) 34 | 35 | 36 | (******************************************************************************* 37 | * History: * 38 | * 12 July 2023 - Original Release. * 39 | * 1 May 2025 - Added option to ignore case when comparing strings using * 40 | * Execute(s1, s2, aDiffAlgorithm, bIgnoreCase). * 41 | *******************************************************************************) 42 | 43 | interface 44 | 45 | uses 46 | {$IFnDEF FPC} 47 | Generics.Collections, Windows, 48 | {$ELSE} 49 | LCLIntf, LCLType, IntegerList, 50 | {$ENDIF} 51 | SysUtils, 52 | Forms, 53 | Classes, 54 | DiffTypes, 55 | Diff_ND, 56 | Diff_NP; 57 | 58 | type 59 | TDiff = class(TComponent) 60 | private 61 | FCancelled: boolean; 62 | FExecuting: boolean; 63 | FDiffAlgorithm: TDiffAlgorithm; 64 | FDiff_ND: TNDDiff; 65 | FDiff_NP: TNPDiff; 66 | function GetCompareCount: integer; 67 | function GetCompare(index: integer): TCompareRec; 68 | function GetDiffStats: TDiffStats; 69 | public 70 | constructor Create(aOwner: TComponent); override; 71 | destructor Destroy; override; 72 | 73 | // Compare strings or list of Cardinals ... 74 | {$IFDEF FPC} 75 | function Execute(const alist1, alist2: TCardinalList; const aDiffAlgorithm: TDiffAlgorithm = algND): boolean; overload; 76 | {$ELSE} 77 | function Execute(const alist1, alist2: TList<Cardinal>; const aDiffAlgorithm: TDiffAlgorithm = algND): boolean; 78 | overload; 79 | {$ENDIF} 80 | function Execute(const s1, s2: string; const aDiffAlgorithm: TDiffAlgorithm = algND; const bIgnoreCase: Boolean = 81 | False): boolean; overload; 82 | 83 | // Cancel allows interrupting excessively prolonged comparisons 84 | procedure Cancel; 85 | procedure Clear; 86 | property Cancelled: boolean read FCancelled; 87 | property Count: integer read GetCompareCount; 88 | property Compares[index: integer]: TCompareRec read GetCompare; default; 89 | property DiffAlgorithm: TDiffAlgorithm read FDiffAlgorithm write FDiffAlgorithm; 90 | property DiffStats: TDiffStats read GetDiffStats; 91 | end; 92 | 93 | procedure Register; 94 | 95 | implementation 96 | 97 | procedure Register; 98 | begin 99 | RegisterComponents('Samples', [TDiff]); 100 | end; 101 | 102 | constructor TDiff.Create(aOwner: TComponent); 103 | begin 104 | inherited; 105 | FDiff_ND := TNDDiff.Create(AOwner); 106 | FDiff_NP := TNPDiff.Create(AOwner); 107 | FDiffAlgorithm := algNP; 108 | end; 109 | //------------------------------------------------------------------------------ 110 | 111 | destructor TDiff.Destroy; 112 | begin 113 | // FDiff_ND.Free; 114 | // FDiff_NP.Free; 115 | inherited; 116 | end; 117 | //------------------------------------------------------------------------------ 118 | 119 | function TDiff.Execute(const s1, s2: string; const aDiffAlgorithm: TDiffAlgorithm = algND; const bIgnoreCase: Boolean = 120 | False): boolean; 121 | begin 122 | Result := not FExecuting; 123 | if not Result then exit; 124 | FCancelled := false; 125 | FExecuting := true; 126 | FDiffAlgorithm := aDiffAlgorithm; 127 | try 128 | if aDiffAlgorithm = algND then 129 | FDiff_ND.Execute(s1, s2, bIgnoreCase) 130 | else if aDiffAlgorithm = algNP then 131 | FDiff_NP.Execute(s1, s2, bIgnoreCase); 132 | finally 133 | FExecuting := false; 134 | end; 135 | end; 136 | //------------------------------------------------------------------------------ 137 | 138 | {$IFDEF FPC} 139 | function TDiff.Execute(const alist1, alist2: TCardinalList; const aDiffAlgorithm: TDiffAlgorithm): boolean; 140 | {$ELSE} 141 | function TDiff.Execute(const alist1, alist2: TList<Cardinal>; const aDiffAlgorithm: TDiffAlgorithm = algND): boolean; 142 | {$ENDIF} 143 | begin 144 | Result := not FExecuting; 145 | if not Result then exit; 146 | FCancelled := false; 147 | FExecuting := true; 148 | FDiffAlgorithm := aDiffAlgorithm; 149 | try 150 | if aDiffAlgorithm = algND then 151 | FDiff_ND.Execute(alist1, alist2) 152 | else if aDiffAlgorithm = algNP then 153 | FDiff_NP.Execute(alist1, alist2); 154 | finally 155 | FExecuting := false; 156 | end; 157 | end; 158 | //------------------------------------------------------------------------------ 159 | 160 | function TDiff.GetCompareCount: integer; 161 | begin 162 | if FDiffAlgorithm = algND then 163 | Result := FDiff_ND.CompareList.Count 164 | else 165 | Result := FDiff_NP.CompareList.count; 166 | end; 167 | //------------------------------------------------------------------------------ 168 | 169 | function TDiff.GetCompare(index: integer): TCompareRec; 170 | begin 171 | if FDiffAlgorithm = algND then 172 | Result := PCompareRec(FDiff_ND.CompareList[index])^ 173 | else if FDiffAlgorithm = algNP then 174 | Result := PCompareRec(FDiff_NP.CompareList[index])^; 175 | end; 176 | //------------------------------------------------------------------------------ 177 | 178 | procedure TDiff.Cancel; 179 | begin 180 | FCancelled := True; 181 | if FDiffAlgorithm = algND then 182 | FDiff_ND.Cancel 183 | else if FDiffAlgorithm = algNP then 184 | FDiff_NP.Cancel; 185 | end; 186 | 187 | procedure TDiff.Clear; 188 | begin 189 | if FDiffAlgorithm = algND then 190 | FDiff_ND.Clear 191 | else if FDiffAlgorithm = algNP then 192 | FDiff_NP.Clear; 193 | end; 194 | 195 | function TDiff.GetDiffStats: TDiffStats; 196 | begin 197 | if FDiffAlgorithm = algND then 198 | Result := FDiff_ND.DiffStats 199 | else if FDiffAlgorithm = algNP then 200 | Result := FDiff_NP.DiffStats; 201 | end; 202 | 203 | //------------------------------------------------------------------------------ 204 | 205 | end. 206 | -------------------------------------------------------------------------------- /src/DiffTypes.pas: -------------------------------------------------------------------------------- 1 | unit DiffTypes; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | interface 8 | 9 | uses 10 | {$IFnDEF FPC} 11 | Generics.Collections, Windows, 12 | {$ELSE} 13 | LCLIntf, LCLType, FGL, 14 | {$ENDIF} 15 | SysUtils, 16 | Math, 17 | Forms, 18 | Classes; 19 | 20 | const 21 | MAX_DIAGONAL = $FFFFFF; //~16 million 22 | 23 | type 24 | TDiffAlgorithm = (algND,algNP); 25 | 26 | P8Bits = PByte; 27 | 28 | PDiags = ^TDiags; 29 | TDiags = array [-MAX_DIAGONAL .. MAX_DIAGONAL] of integer; 30 | 31 | TChangeKind = (ckNone, ckAdd, ckDelete, ckModify); 32 | 33 | PCompareRec = ^TCompareRec; 34 | TCompareRec = record 35 | Kind : TChangeKind; 36 | oldIndex1, 37 | oldIndex2 : integer; 38 | case boolean of 39 | false : (chr1, chr2 : Char); 40 | true : (int1, int2 : integer); 41 | end; 42 | 43 | PDiffVars = ^TDiffVars; 44 | TDiffVars = record 45 | offset1 : integer; 46 | offset2 : integer; 47 | len1 : integer; 48 | len2 : integer; 49 | end; 50 | 51 | TDiffStats = record 52 | matches : integer; 53 | adds : integer; 54 | deletes : integer; 55 | modifies : integer; 56 | end; 57 | 58 | implementation 59 | 60 | 61 | 62 | end. 63 | -------------------------------------------------------------------------------- /src/Diff_ND.pas: -------------------------------------------------------------------------------- 1 | unit Diff_ND; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | (******************************************************************************* 8 | * Component TNDDiff * 9 | * Version: 5.20 * 10 | * Date: 1 May 2025 * 11 | * Compilers: Delphi 10.x * 12 | * Author: Angus Johnson - angusj-AT-myrealbox-DOT-com * 13 | * Copyright: � 2001-2009 Angus Johnson * 14 | * Updated by: Rickard Johansson (RJ TextEd) * 15 | * * 16 | * Licence to use, terms and conditions: * 17 | * The code in the TNDDiff component is released as freeware * 18 | * provided you agree to the following terms & conditions: * 19 | * 1. the copyright notice, terms and conditions are * 20 | * left unchanged * 21 | * 2. modifications to the code by other authors must be * 22 | * clearly documented and accompanied by the modifier's name. * 23 | * 3. the TNDDiff component may be freely compiled into binary* 24 | * format and no acknowledgement is required. However, a * 25 | * discrete acknowledgement would be appreciated (eg. in a * 26 | * program's 'About Box'). * 27 | * * 28 | * Description: Component to list differences between two integer arrays * 29 | * using a "longest common subsequence" algorithm. * 30 | * Typically, this component is used to diff 2 text files * 31 | * once their individuals lines have been hashed. * 32 | * * 33 | * Acknowledgements: The key algorithm in this component is based on: * 34 | * "An O(ND) Difference Algorithm and its Variations" * 35 | * By E Myers - Algorithmica Vol. 1 No. 2, 1986, pp. 251-266 * 36 | * http://www.cs.arizona.edu/people/gene/ * 37 | * http://www.cs.arizona.edu/people/gene/PAPERS/diff.ps * 38 | * * 39 | *******************************************************************************) 40 | 41 | 42 | (******************************************************************************* 43 | * History: * 44 | * 13 December 2001 - Original Release * 45 | * 22 April 2008 - Complete rewrite to greatly improve the code and * 46 | * provide a much simpler view of differences through a new * 47 | * 'Compares' property. * 48 | * 7 November 2009 - Updated so now compiles in newer versions of Delphi. * 49 | * * 50 | * 11 November 2018 - Added TList<Cardinal> to store hash values * 51 | * Made some minor code formatting and code changes * 52 | * 19 May 2020 Added Lazarus support * 53 | * 12 July 2023 Made some changes to enable switching algorithm between * 54 | * O(ND) and O(NP) and fixed several issues and range * 55 | * errors. * 56 | * * 57 | * 16 Apr 2025 Fixed an issue in Execute(const s1, s2: string) * 58 | * 1 May 2025 - Added option to ignore case when comparing strings using * 59 | * Execute(s1, s2, bIgnoreCase). * 60 | *******************************************************************************) 61 | 62 | interface 63 | 64 | uses 65 | {$IFnDEF FPC} 66 | Generics.Collections, Windows, 67 | {$ELSE} 68 | LCLIntf, LCLType, FGL, 69 | {$ENDIF} 70 | SysUtils, 71 | Math, 72 | Forms, 73 | Classes, 74 | DiffTypes; 75 | 76 | const 77 | //Maximum realistic deviation from centre diagonal vector ... 78 | MAX_DIAGONAL = $FFFFFF; //~16 million 79 | 80 | type 81 | {$IFDEF FPC} 82 | TIntegerList = TFPGList<Cardinal>; 83 | {$ENDIF} 84 | 85 | TNDDiff = class(TComponent) 86 | private 87 | FCompareList: TList; 88 | FCancelled: boolean; 89 | FExecuting: boolean; 90 | FDiagBuffer, bDiagBuffer: pointer; 91 | FStr1: string; 92 | FStr2: string; 93 | {$IFDEF FPC} 94 | FList1: TIntegerList; 95 | FList2: TIntegerList; 96 | {$ELSE} 97 | FList1: TList<Cardinal>; 98 | FList2: TList<Cardinal>; 99 | {$ENDIF} 100 | LastCompareRec: TCompareRec; 101 | fDiag, bDiag: PDiags; 102 | fDiffStats: TDiffStats; 103 | FIgnoreCase: Boolean; 104 | procedure InitDiagArrays(MaxOscill, len1, len2: integer); 105 | //nb: To optimize speed, separate functions are called for either 106 | //integer or character compares ... 107 | procedure RecursiveDiffChr(offset1, offset2, len1, len2: integer); 108 | procedure AddChangeChrs(offset1, range: integer; ChangeKind: TChangeKind); 109 | procedure RecursiveDiffInt(offset1, offset2, len1, len2: integer); 110 | procedure AddChangeInts(offset1, range: integer; ChangeKind: TChangeKind); 111 | function CompareChr(const ch1, ch2: Char): Boolean; 112 | 113 | function GetCompareCount: integer; 114 | function GetCompare(index: integer): TCompareRec; 115 | public 116 | constructor Create(aOwner: TComponent); override; 117 | destructor Destroy; override; 118 | 119 | // Compare strings or list of Cardinals ... 120 | {$IFDEF FPC} 121 | function Execute(const alist1, alist2: TIntegerList): boolean; overload; 122 | {$ELSE} 123 | function Execute(const alist1, alist2: TList<Cardinal>): boolean; overload; 124 | {$ENDIF} 125 | function Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; overload; 126 | 127 | // Cancel allows interrupting excessively prolonged comparisons 128 | procedure Cancel; 129 | procedure Clear; 130 | 131 | property Cancelled: boolean read fCancelled; 132 | property CompareList: TList read FCompareList write FCompareList; 133 | property Count: integer read GetCompareCount; 134 | property Compares[index: integer]: TCompareRec read GetCompare; default; 135 | property DiffStats: TDiffStats read fDiffStats; 136 | end; 137 | 138 | implementation 139 | 140 | uses 141 | System.Character; 142 | 143 | constructor TNDDiff.Create(aOwner: TComponent); 144 | begin 145 | inherited; 146 | fCompareList := TList.create; 147 | FIgnoreCase := False; 148 | end; 149 | //------------------------------------------------------------------------------ 150 | 151 | destructor TNDDiff.Destroy; 152 | begin 153 | Clear; 154 | fCompareList.free; 155 | inherited; 156 | end; 157 | //------------------------------------------------------------------------------ 158 | 159 | function TNDDiff.Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; 160 | var 161 | maxOscill, x1,x2, savedLen: integer; 162 | compareRec: PCompareRec; 163 | len1,len2: Integer; 164 | l1,l2: Integer; 165 | begin 166 | result := not fExecuting; 167 | if not result then exit; 168 | fExecuting := true; 169 | fCancelled := false; 170 | FIgnoreCase := bIgnoreCase; 171 | try 172 | Clear; 173 | len1 := Length(s1); 174 | len2 := Length(s2); 175 | 176 | //save first string length for later (ie for any trailing matches) ... 177 | savedLen := len1; 178 | 179 | //setup the character arrays ... 180 | FStr1 := s1; 181 | FStr2 := s2; 182 | 183 | //ignore top matches ... 184 | x1:= 1; x2 := 1; 185 | while (len1 > 0) and (len2 > 0) and CompareChr(FStr1[len1], FStr2[len2]) do 186 | begin 187 | dec(len1); dec(len2); 188 | end; 189 | 190 | //if something doesn't match ... 191 | if (len1 <> 0) or (len2 <> 0) then 192 | begin 193 | //ignore bottom of matches too ... 194 | l1 := len1; l2 := len2; 195 | while (len1 > 0) and (len2 > 0) and (x1 > 0) and (x2 > 0) and (x1 <= Length(FStr1)) and (x2 <= Length(FStr2)) and CompareChr(FStr1[x1], FStr2[x2]) do 196 | begin 197 | if (x1 < Length(FStr1)) and (x2 < Length(FStr2)) and not CompareChr(FStr1[x1+1], FStr2[x2+1]) and (CompareChr(FStr1[x1], FStr1[x1+1]) or CompareChr(FStr1[x1], FStr2[x2+1])) then 198 | begin 199 | // Reset if we have strings like 200 | // 201 | // aaabc : aabcd 202 | // 203 | // Character 3 is still the same 'a' in string 1 but different 'b' in string 2. The algorithm needs to handle this 204 | // so reset x1 and x2 to 1. 205 | x1:= 1; 206 | x2 := 1; 207 | len1 := l1; 208 | len2 := l2; 209 | Break; 210 | end; 211 | dec(len1); dec(len2); 212 | inc(x1); inc(x2); 213 | end; 214 | 215 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 216 | fCompareList.Capacity := len1 + len2; 217 | 218 | //nb: the Diag arrays are extended by 1 at each end to avoid testing 219 | //for array limits. Hence '+3' because will also includes Diag[0] ... 220 | GetMem(fDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 221 | GetMem(bDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 222 | try 223 | RecursiveDiffChr(x1, x2, len1, len2); 224 | finally 225 | freeMem(fDiagBuffer); 226 | freeMem(bDiagBuffer); 227 | end; 228 | end; 229 | 230 | if fCancelled then 231 | begin 232 | result := false; 233 | Clear; 234 | exit; 235 | end; 236 | 237 | //finally, append any trailing matches onto compareList ... 238 | if LastCompareRec.oldIndex1 < 0 then LastCompareRec.oldIndex1 := 0; 239 | if LastCompareRec.oldIndex2 < 0 then LastCompareRec.oldIndex2 := 0; 240 | while (LastCompareRec.oldIndex1 < savedLen) do 241 | begin 242 | with LastCompareRec do 243 | begin 244 | Kind := ckNone; 245 | inc(oldIndex1); 246 | inc(oldIndex2); 247 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 248 | chr1 := FStr1[oldIndex1]; 249 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 250 | chr2 := FStr2[oldIndex2]; 251 | end; 252 | New(compareRec); 253 | compareRec^ := LastCompareRec; 254 | fCompareList.Add(compareRec); 255 | inc(fDiffStats.matches); 256 | end; 257 | finally 258 | fExecuting := false; 259 | end; 260 | 261 | end; 262 | //------------------------------------------------------------------------------ 263 | 264 | {$IFDEF FPC} 265 | function TNDDiff.Execute(const alist1, alist2: TIntegerList): boolean; 266 | {$ELSE} 267 | function TNDDiff.Execute(const alist1, alist2: TList<Cardinal>): boolean; 268 | {$ENDIF} 269 | var 270 | maxOscill, x1,x2, savedLen: integer; 271 | compareRec: PCompareRec; 272 | len1,len2: Integer; 273 | begin 274 | result := not fExecuting; 275 | if not result then exit; 276 | fExecuting := true; 277 | fCancelled := false; 278 | try 279 | Clear; 280 | 281 | //setup the character arrays ... 282 | FList1 := alist1; 283 | FList2 := alist2; 284 | len1 := FList1.Count; 285 | len2 := FList2.Count; 286 | 287 | //save first string length for later (ie for any trailing matches) ... 288 | savedLen := len1-1; 289 | 290 | //ignore top matches ... 291 | x1:= 0; x2 := 0; 292 | while (len1 > 0) and (len2 > 0) and (FList1[len1-1] = FList2[len2-1]) do 293 | begin 294 | dec(len1); dec(len2); 295 | end; 296 | 297 | //if something doesn't match ... 298 | if (len1 <> 0) or (len2 <> 0) then 299 | begin 300 | 301 | //ignore bottom of matches too ... 302 | while (len1 > 0) and (len2 > 0) and (FList1[x1] = FList2[x2]) do 303 | begin 304 | dec(len1); dec(len2); 305 | inc(x1); inc(x2); 306 | end; 307 | 308 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 309 | fCompareList.Capacity := len1 + len2; 310 | 311 | //nb: the Diag arrays are extended by 1 at each end to avoid testing 312 | //for array limits. Hence '+3' because will also includes Diag[0] ... 313 | GetMem(fDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 314 | GetMem(bDiagBuffer, sizeof(integer)*(maxOscill*2+3)); 315 | try 316 | RecursiveDiffInt(x1, x2, len1, len2); 317 | finally 318 | freeMem(fDiagBuffer); 319 | freeMem(bDiagBuffer); 320 | end; 321 | end; 322 | 323 | if fCancelled then 324 | begin 325 | result := false; 326 | Clear; 327 | exit; 328 | end; 329 | 330 | //finally, append any trailing matches onto compareList ... 331 | while (LastCompareRec.oldIndex1 < savedLen) do 332 | begin 333 | with LastCompareRec do 334 | begin 335 | Kind := ckNone; 336 | inc(oldIndex1); 337 | inc(oldIndex2); 338 | int1 := Integer(FList1[oldIndex1]); 339 | int2 := Integer(FList2[oldIndex2]); 340 | end; 341 | New(compareRec); 342 | compareRec^ := LastCompareRec; 343 | fCompareList.Add(compareRec); 344 | inc(fDiffStats.matches); 345 | end; 346 | finally 347 | fExecuting := false; 348 | end; 349 | 350 | end; 351 | //------------------------------------------------------------------------------ 352 | 353 | procedure TNDDiff.InitDiagArrays(MaxOscill, len1, len2: integer); 354 | var 355 | diag: integer; 356 | begin 357 | inc(maxOscill); //for the extra diag at each end of the arrays ... 358 | P8Bits(fDiag) := P8Bits(fDiagBuffer) - sizeof(integer)*(MAX_DIAGONAL-maxOscill); 359 | P8Bits(bDiag) := P8Bits(bDiagBuffer) - sizeof(integer)*(MAX_DIAGONAL-maxOscill); 360 | //initialize Diag arrays (assumes 0 based arrays) ... 361 | for diag := - maxOscill to maxOscill do fDiag[diag] := -MAXINT; 362 | fDiag[0] := -1; 363 | for diag := - maxOscill to maxOscill do bDiag[diag] := MAXINT; 364 | bDiag[len1 - len2] := len1-1; 365 | end; 366 | //------------------------------------------------------------------------------ 367 | 368 | procedure TNDDiff.RecursiveDiffChr(offset1, offset2, len1, len2: integer); 369 | var 370 | diag, lenDelta, Oscill, maxOscill, x1, x2: integer; 371 | begin 372 | //nb: the possible depth of recursion here is most unlikely to cause 373 | // problems with stack overflows. 374 | // application.processmessages; 375 | if fCancelled then exit; 376 | 377 | if (len1 = 0) then 378 | begin 379 | AddChangeChrs(offset1, len2, ckAdd); 380 | exit; 381 | end 382 | else if (len2 = 0) then 383 | begin 384 | AddChangeChrs(offset1, len1, ckDelete); 385 | exit; 386 | end 387 | else if (len1 = 1) and (len2 = 1) then 388 | begin 389 | AddChangeChrs(offset1, 1, ckDelete); 390 | AddChangeChrs(offset1, 1, ckAdd); 391 | exit; 392 | end; 393 | 394 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 395 | InitDiagArrays(MaxOscill, len1, len2); 396 | lenDelta := len1 -len2; 397 | 398 | Oscill := 1; //ie assumes prior filter of top and bottom matches 399 | while Oscill <= maxOscill do 400 | begin 401 | 402 | if (Oscill mod 200) = 0 then 403 | begin 404 | application.processmessages; 405 | if fCancelled then exit; 406 | end; 407 | 408 | //do forward oscillation (keeping diag within assigned grid)... 409 | diag := Oscill; 410 | while diag > len1 do dec(diag,2); 411 | while diag >= max(- Oscill, -len2) do 412 | begin 413 | if fDiag[diag-1] < fDiag[diag+1] then 414 | x1 := fDiag[diag+1] 415 | else 416 | x1 := fDiag[diag-1]+1; 417 | x2 := x1 - diag; 418 | while (x1 < len1-1) and (x2 < len2-1) and (offset1+x1+1 > 0) and (offset2+x2+1 > 0) and 419 | (offset1+x1+1 <= Length(FStr1)) and (offset2+x2+1 <= Length(FStr2)) and CompareChr(FStr1[offset1+x1+1], FStr2[offset2+x2+1]) do 420 | begin 421 | inc(x1); inc(x2); 422 | end; 423 | fDiag[diag] := x1; 424 | 425 | //nb: (fDiag[diag] is always < bDiag[diag]) here when NOT odd(lenDelta) ... 426 | if odd(lenDelta) and (fDiag[diag] >= bDiag[diag]) then 427 | begin 428 | inc(x1);inc(x2); 429 | //save x1 & x2 for second recursive_diff() call by reusing no longer 430 | //needed variables (ie minimize variable allocation in recursive fn) ... 431 | diag := x1; Oscill := x2; 432 | while (x1 > 0) and (x2 > 0) and (offset1+x1+1 > 0) and (offset2+x2-1 > 0) and 433 | (offset1+x1-1 <= Length(FStr1)) and (offset2+x2-1 <= Length(FStr2)) and CompareChr(FStr1[offset1+x1-1], FStr2[offset2+x2-1]) do 434 | begin 435 | dec(x1); dec(x2); 436 | end; 437 | RecursiveDiffChr(offset1, offset2, x1, x2); 438 | x1 := diag; x2 := Oscill; 439 | RecursiveDiffChr(offset1+x1, offset2+x2, len1-x1, len2-x2); 440 | exit; //ALL DONE 441 | end; 442 | dec(diag,2); 443 | end; 444 | 445 | //do backward oscillation (keeping diag within assigned grid)... 446 | diag := lenDelta + Oscill; 447 | while diag > len1 do dec(diag,2); 448 | while diag >= max(lenDelta - Oscill, -len2) do 449 | begin 450 | if bDiag[diag-1] < bDiag[diag+1] then 451 | x1 := bDiag[diag-1] else 452 | x1 := bDiag[diag+1]-1; 453 | x2 := x1 - diag; 454 | while (offset1+x1 > 0) and (offset2+x2 > 0) and (offset1+x1 <= Length(FStr1)) and (offset2+x2 <= Length(FStr1)) and 455 | CompareChr(FStr1[offset1+x1], FStr2[offset2+x2]) do 456 | begin 457 | dec(x1); dec(x2); 458 | end; 459 | bDiag[diag] := x1; 460 | 461 | if bDiag[diag] <= fDiag[diag] then 462 | begin 463 | //flag return value then ... 464 | inc(x1);inc(x2); 465 | RecursiveDiffChr(offset1, offset2, x1, x2); 466 | while (x1 < len1) and (x2 < len2) and (offset1+x1 <= Length(FStr1)) and (offset2+x2 <= Length(FStr1)) and 467 | CompareChr(FStr1[offset1+x1], FStr2[offset2+x2]) do 468 | begin 469 | inc(x1); inc(x2); 470 | end; 471 | RecursiveDiffChr(offset1+x1, offset2+x2, len1-x1, len2-x2); 472 | exit; //ALL DONE 473 | end; 474 | dec(diag,2); 475 | end; 476 | 477 | inc(Oscill); 478 | end; //while Oscill <= maxOscill 479 | 480 | raise Exception.create('oops - error in RecursiveDiffChr()'); 481 | end; 482 | //------------------------------------------------------------------------------ 483 | 484 | procedure TNDDiff.RecursiveDiffInt(offset1, offset2, len1, len2: integer); 485 | var 486 | diag, lenDelta, Oscill, maxOscill, x1, x2: integer; 487 | begin 488 | //nb: the possible depth of recursion here is most unlikely to cause 489 | // problems with stack overflows. 490 | // application.processmessages; 491 | if fCancelled then exit; 492 | 493 | if (len1 = 0) then 494 | begin 495 | assert(len2 > 0,'oops!'); 496 | AddChangeInts(offset1, len2, ckAdd); 497 | exit; 498 | end 499 | else if (len2 = 0) then 500 | begin 501 | AddChangeInts(offset1, len1, ckDelete); 502 | exit; 503 | end 504 | else if (len1 = 1) and (len2 = 1) then 505 | begin 506 | assert(FList1[offset1] <> FList2[offset2],'oops!'); 507 | AddChangeInts(offset1, 1, ckDelete); 508 | AddChangeInts(offset1, 1, ckAdd); 509 | exit; 510 | end; 511 | 512 | maxOscill := min(max(len1,len2), MAX_DIAGONAL); 513 | InitDiagArrays(MaxOscill, len1, len2); 514 | lenDelta := len1 -len2; 515 | 516 | Oscill := 1; //ie assumes prior filter of top and bottom matches 517 | while Oscill <= maxOscill do 518 | begin 519 | 520 | if (Oscill mod 200) = 0 then 521 | begin 522 | application.processmessages; 523 | if fCancelled then exit; 524 | end; 525 | 526 | //do forward oscillation (keeping diag within assigned grid)... 527 | diag := Oscill; 528 | while diag > len1 do dec(diag,2); 529 | while diag >= max(- Oscill, -len2) do 530 | begin 531 | if fDiag[diag-1] < fDiag[diag+1] then 532 | x1 := fDiag[diag+1] else 533 | x1 := fDiag[diag-1]+1; 534 | x2 := x1 - diag; 535 | while (x1 < len1-1) and (x2 < len2-1) and 536 | (FList1[offset1+x1+1] = FList2[offset2+x2+1]) do 537 | begin 538 | inc(x1); inc(x2); 539 | end; 540 | fDiag[diag] := x1; 541 | 542 | //nb: (fDiag[diag] is always < bDiag[diag]) here when NOT odd(lenDelta) ... 543 | if odd(lenDelta) and (fDiag[diag] >= bDiag[diag]) then 544 | begin 545 | inc(x1);inc(x2); 546 | //save x1 & x2 for second recursive_diff() call by reusing no longer 547 | //needed variables (ie minimize variable allocation in recursive fn) ... 548 | diag := x1; Oscill := x2; 549 | while (x1 > 0) and (x2 > 0) and (FList1[offset1+x1-1] = FList2[offset2+x2-1]) do 550 | begin 551 | dec(x1); dec(x2); 552 | end; 553 | RecursiveDiffInt(offset1, offset2, x1, x2); 554 | x1 := diag; x2 := Oscill; 555 | RecursiveDiffInt(offset1+x1, offset2+x2, len1-x1, len2-x2); 556 | exit; //ALL DONE 557 | end; 558 | dec(diag,2); 559 | end; 560 | 561 | //do backward oscillation (keeping diag within assigned grid)... 562 | diag := lenDelta + Oscill; 563 | while diag > len1 do dec(diag,2); 564 | while diag >= max(lenDelta - Oscill, -len2) do 565 | begin 566 | if bDiag[diag-1] < bDiag[diag+1] then 567 | x1 := bDiag[diag-1] else 568 | x1 := bDiag[diag+1]-1; 569 | x2 := x1 - diag; 570 | while (x1 > -1) and (x2 > -1) and (FList1[offset1+x1] = FList2[offset2+x2]) do 571 | begin 572 | dec(x1); dec(x2); 573 | end; 574 | bDiag[diag] := x1; 575 | 576 | if bDiag[diag] <= fDiag[diag] then 577 | begin 578 | //flag return value then ... 579 | inc(x1);inc(x2); 580 | RecursiveDiffInt(offset1, offset2, x1, x2); 581 | while (x1 < len1) and (x2 < len2) and 582 | (FList1[offset1+x1] = FList2[offset2+x2]) do 583 | begin 584 | inc(x1); inc(x2); 585 | end; 586 | RecursiveDiffInt(offset1+x1, offset2+x2, len1-x1, len2-x2); 587 | exit; //ALL DONE 588 | end; 589 | dec(diag,2); 590 | end; 591 | 592 | inc(Oscill); 593 | end; //while Oscill <= maxOscill 594 | 595 | raise Exception.create('oops - error in RecursiveDiffInt()'); 596 | end; 597 | //------------------------------------------------------------------------------ 598 | 599 | procedure TNDDiff.Clear; 600 | var 601 | i: integer; 602 | begin 603 | for i := 0 to fCompareList.Count-1 do 604 | dispose(PCompareRec(fCompareList[i])); 605 | fCompareList.clear; 606 | LastCompareRec.Kind := ckNone; 607 | LastCompareRec.oldIndex1 := -1; 608 | LastCompareRec.oldIndex2 := -1; 609 | fDiffStats.matches := 0; 610 | fDiffStats.adds := 0; 611 | fDiffStats.deletes :=0; 612 | fDiffStats.modifies :=0; 613 | end; 614 | //------------------------------------------------------------------------------ 615 | 616 | function TNDDiff.GetCompareCount: integer; 617 | begin 618 | result := fCompareList.count; 619 | end; 620 | //------------------------------------------------------------------------------ 621 | 622 | function TNDDiff.GetCompare(index: integer): TCompareRec; 623 | begin 624 | result := PCompareRec(fCompareList[index])^; 625 | end; 626 | //------------------------------------------------------------------------------ 627 | 628 | procedure TNDDiff.AddChangeChrs(offset1, range: integer; ChangeKind: TChangeKind); 629 | var 630 | i,j: integer; 631 | compareRec: PCompareRec; 632 | begin 633 | //first, add any unchanged items into this list ... 634 | if LastCompareRec.oldIndex1 < 0 then LastCompareRec.oldIndex1 := 0; 635 | if LastCompareRec.oldIndex2 < 0 then LastCompareRec.oldIndex2 := 0; 636 | while (LastCompareRec.oldIndex1 < offset1 -1) do 637 | begin 638 | with LastCompareRec do 639 | begin 640 | chr1 := #0; 641 | chr2 := #0; 642 | Kind := ckNone; 643 | inc(oldIndex1); 644 | inc(oldIndex2); 645 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 646 | chr1 := FStr1[oldIndex1]; 647 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 648 | chr2 := FStr2[oldIndex2]; 649 | end; 650 | New(compareRec); 651 | compareRec^ := LastCompareRec; 652 | fCompareList.Add(compareRec); 653 | inc(fDiffStats.matches); 654 | end; 655 | 656 | case ChangeKind of 657 | ckNone: 658 | for i := 1 to range do 659 | begin 660 | with LastCompareRec do 661 | begin 662 | Kind := ckNone; 663 | inc(oldIndex1); 664 | inc(oldIndex2); 665 | chr1 := FStr1[oldIndex1]; 666 | chr2 := FStr2[oldIndex2]; 667 | end; 668 | New(compareRec); 669 | compareRec^ := LastCompareRec; 670 | FCompareList.Add(compareRec); 671 | inc(FDiffStats.matches); 672 | end; 673 | ckAdd : 674 | begin 675 | for i := 1 to range do 676 | begin 677 | with LastCompareRec do 678 | begin 679 | 680 | //check if a range of adds are following a range of deletes 681 | //and convert them to modifies ... 682 | if Kind = ckDelete then 683 | begin 684 | j := fCompareList.Count -1; 685 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckDelete) do 686 | dec(j); 687 | PCompareRec(fCompareList[j]).Kind := ckModify; 688 | dec(fDiffStats.deletes); 689 | inc(fDiffStats.modifies); 690 | inc(LastCompareRec.oldIndex2); 691 | PCompareRec(fCompareList[j]).oldIndex2 := LastCompareRec.oldIndex2; 692 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 693 | PCompareRec(fCompareList[j]).chr2 := FStr2[oldIndex2]; 694 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 695 | continue; 696 | end; 697 | 698 | Kind := ckAdd; 699 | chr1 := #0; 700 | inc(oldIndex2); 701 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 702 | chr2 := Char(FStr2[oldIndex2]); //ie what we added 703 | end; 704 | New(compareRec); 705 | compareRec^ := LastCompareRec; 706 | fCompareList.Add(compareRec); 707 | inc(fDiffStats.adds); 708 | end; 709 | end; 710 | ckDelete : 711 | begin 712 | for i := 1 to range do 713 | begin 714 | with LastCompareRec do 715 | begin 716 | 717 | //check if a range of deletes are following a range of adds 718 | //and convert them to modifies ... 719 | if Kind = ckAdd then 720 | begin 721 | j := fCompareList.Count -1; 722 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckAdd) do 723 | dec(j); 724 | PCompareRec(fCompareList[j]).Kind := ckModify; 725 | dec(fDiffStats.adds); 726 | inc(fDiffStats.modifies); 727 | inc(LastCompareRec.oldIndex1); 728 | PCompareRec(fCompareList[j]).oldIndex1 := LastCompareRec.oldIndex1; 729 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 730 | PCompareRec(fCompareList[j]).chr1 := FStr1[oldIndex1]; 731 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 732 | continue; 733 | end; 734 | 735 | Kind := ckDelete; 736 | chr2 := #0; 737 | inc(oldIndex1); 738 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 739 | chr1 := FStr1[oldIndex1]; //ie what we deleted 740 | end; 741 | New(compareRec); 742 | compareRec^ := LastCompareRec; 743 | fCompareList.Add(compareRec); 744 | inc(fDiffStats.deletes); 745 | end; 746 | end; 747 | end; 748 | end; 749 | //------------------------------------------------------------------------------ 750 | 751 | procedure TNDDiff.AddChangeInts(offset1, range: integer; ChangeKind: TChangeKind); 752 | var 753 | i,j: integer; 754 | compareRec: PCompareRec; 755 | begin 756 | //first, add any unchanged items into this list ... 757 | while (LastCompareRec.oldIndex1 < offset1 -1) do 758 | begin 759 | with LastCompareRec do 760 | begin 761 | Kind := ckNone; 762 | inc(oldIndex1); 763 | inc(oldIndex2); 764 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 765 | int1 := Integer(FList1[oldIndex1]); 766 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 767 | int2 := Integer(FList2[oldIndex2]); 768 | end; 769 | New(compareRec); 770 | compareRec^ := LastCompareRec; 771 | fCompareList.Add(compareRec); 772 | inc(fDiffStats.matches); 773 | end; 774 | 775 | case ChangeKind of 776 | ckAdd : 777 | begin 778 | for i := 1 to range do 779 | begin 780 | with LastCompareRec do 781 | begin 782 | 783 | //check if a range of adds are following a range of deletes 784 | //and convert them to modifies ... 785 | if Kind = ckDelete then 786 | begin 787 | j := fCompareList.Count -1; 788 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckDelete) do 789 | dec(j); 790 | PCompareRec(fCompareList[j]).Kind := ckModify; 791 | dec(fDiffStats.deletes); 792 | inc(fDiffStats.modifies); 793 | inc(LastCompareRec.oldIndex2); 794 | PCompareRec(fCompareList[j]).oldIndex2 := LastCompareRec.oldIndex2; 795 | PCompareRec(fCompareList[j]).int2 := Integer(FList2[oldIndex2]); 796 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 797 | continue; 798 | end; 799 | 800 | Kind := ckAdd; 801 | int1 := $0; 802 | inc(oldIndex2); 803 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 804 | int2 := Integer(FList2[oldIndex2]); //ie what we added 805 | end; 806 | New(compareRec); 807 | compareRec^ := LastCompareRec; 808 | fCompareList.Add(compareRec); 809 | inc(fDiffStats.adds); 810 | end; 811 | end; 812 | ckDelete : 813 | begin 814 | for i := 1 to range do 815 | begin 816 | with LastCompareRec do 817 | begin 818 | 819 | //check if a range of deletes are following a range of adds 820 | //and convert them to modifies ... 821 | if Kind = ckAdd then 822 | begin 823 | j := fCompareList.Count -1; 824 | while (j > 0) and (PCompareRec(fCompareList[j-1]).Kind = ckAdd) do 825 | dec(j); 826 | PCompareRec(fCompareList[j]).Kind := ckModify; 827 | dec(fDiffStats.adds); 828 | inc(fDiffStats.modifies); 829 | inc(LastCompareRec.oldIndex1); 830 | PCompareRec(fCompareList[j]).oldIndex1 := LastCompareRec.oldIndex1; 831 | PCompareRec(fCompareList[j]).int1 := Integer(FList1[oldIndex1]); 832 | if j = fCompareList.Count-1 then LastCompareRec.Kind := ckModify; 833 | continue; 834 | end; 835 | 836 | Kind := ckDelete; 837 | int2 := $0; 838 | inc(oldIndex1); 839 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 840 | int1 := Integer(FList1[oldIndex1]); //ie what we deleted 841 | end; 842 | New(compareRec); 843 | compareRec^ := LastCompareRec; 844 | fCompareList.Add(compareRec); 845 | inc(fDiffStats.deletes); 846 | end; 847 | end; 848 | end; 849 | end; 850 | //------------------------------------------------------------------------------ 851 | 852 | procedure TNDDiff.Cancel; 853 | begin 854 | fCancelled := true; 855 | end; 856 | 857 | function TNDDiff.CompareChr(const ch1, ch2: Char): Boolean; 858 | begin 859 | if FIgnoreCase then 860 | Result := (ch1.ToLower = ch2.ToLower) 861 | else 862 | Result := (ch1 = ch2); 863 | end; 864 | 865 | //------------------------------------------------------------------------------ 866 | 867 | end. 868 | -------------------------------------------------------------------------------- /src/Diff_NP.pas: -------------------------------------------------------------------------------- 1 | unit Diff_NP; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | (******************************************************************************* 8 | * Component TNPDiff * 9 | * Version: 5.20 * 10 | * Date: 01 May 2025 * 11 | * Compilers: Delphi 10.x * 12 | * Author: Angus Johnson - angusj-AT-myrealbox-DOT-com * 13 | * Copyright: © 2001-2009 Angus Johnson * 14 | * Updated by: Rickard Johansson (RJ TextEd) * 15 | * * 16 | * Licence to use, terms and conditions: * 17 | * The code in the TNPDiff component is released as freeware * 18 | * provided you agree to the following terms & conditions: * 19 | * 1. the copyright notice, terms and conditions are * 20 | * left unchanged * 21 | * 2. modifications to the code by other authors must be * 22 | * clearly documented and accompanied by the modifier's name. * 23 | * 3. the TNPDiff component may be freely compiled into binary* 24 | * format and no acknowledgement is required. However, a * 25 | * discrete acknowledgement would be appreciated (eg. in a * 26 | * program's 'About Box'). * 27 | * * 28 | * Description: Component to list differences between two integer arrays * 29 | * using a "longest common subsequence" algorithm. * 30 | * Typically, this component is used to diff 2 text files * 31 | * once their individuals lines have been hashed. * 32 | * * 33 | * Acknowledgements: The key algorithm in this component is based on: * 34 | * "An O(NP) Sequence Comparison Algorithm" * 35 | * by Sun Wu, Udi Manber & Gene Myers * 36 | * and uses a "divide-and-conquer" technique to avoid * 37 | * using exponential amounts of memory as described in * 38 | * "An O(ND) Difference Algorithm and its Variations" * 39 | * By E Myers - Algorithmica Vol. 1 No. 2, 1986, pp. 251-266 * 40 | *******************************************************************************) 41 | 42 | (******************************************************************************* 43 | * History: * 44 | * 13 December 2001 - Original release (used Myer's O(ND) Difference Algorithm) * 45 | * 22 April 2008 - Complete rewrite to greatly improve the code and * 46 | * provide a much simpler view of differences through a new * 47 | * 'Compares' property. * 48 | * 21 May 2008 - Another complete code rewrite to use Sun Wu et al.'s * 49 | * O(NP) Sequence Comparison Algorithm which more than * 50 | * halves times of typical comparisons. * 51 | * 24 May 2008 - Reimplemented "divide-and-conquer" technique (which was * 52 | * omitted in 21 May release) so memory use is again minimal.* 53 | * 25 May 2008 - Removed recursion to avoid the possibility of running out * 54 | * of stack memory during massive comparisons. * 55 | * 2 June 2008 - Bugfix: incorrect number of appended AddChangeInt() calls * 56 | * in Execute() for integer arrays. (It was OK with Chars) * 57 | * Added check to prevent repeat calls to Execute() while * 58 | * already executing. * 59 | * Added extra parse of differences to find occasional * 60 | * missed matches. (See readme.txt for further discussion) * 61 | * 7 November 2009 - Updated so now compiles in newer versions of Delphi. * 62 | * * 63 | * 11 November 2018 - Added TList<Cardinal> to store hash values * 64 | * Made some minor code formatting and code changes * 65 | * 19 May 2020 Added Lazarus support * 66 | * 23 May 2020 - Minor changes and fixed an issue in AddChangeChr() * 67 | * 12 July 2023 Made some changes to enable switching algorithm between * 68 | * O(ND) and O(NP). * 69 | * 1 May 2025 - Added option to ignore case when comparing strings using * 70 | * Execute(s1, s2, bIgnoreCase). * 71 | *******************************************************************************) 72 | 73 | interface 74 | 75 | uses 76 | {$IFnDEF FPC} 77 | Generics.Collections, Windows, 78 | {$ELSE} 79 | LCLIntf, LCLType, Fgl, IntegerList, 80 | {$ENDIF} 81 | SysUtils, 82 | Forms, 83 | Classes, 84 | DiffTypes; 85 | 86 | const 87 | MAX_DIAGONAL = $FFFFFF; //~16 million 88 | 89 | type 90 | {.$IFDEF FPC} 91 | //TIntegerList = TFPGList<Cardinal>; 92 | {.$ENDIF} 93 | 94 | TNPDiff = class(TComponent) 95 | private 96 | FCompareList: TList; 97 | FDiffList: TList; //this TList circumvents the need for recursion 98 | FCancelled: boolean; 99 | FExecuting: boolean; 100 | FCompareInts: boolean; //ie are we comparing integer arrays or char arrays 101 | DiagBufferF: pointer; 102 | DiagBufferB: pointer; 103 | DiagF, DiagB: PDiags; 104 | FDiffStats: TDiffStats; 105 | FIgnoreCase: Boolean; 106 | FLastCompareRec: TCompareRec; 107 | {$IFDEF FPC} 108 | FList1: TCardinalList; 109 | FList2: TCardinalList; 110 | {$ELSE} 111 | FList1: TList<Cardinal>; 112 | FList2: TList<Cardinal>; 113 | {$ENDIF} 114 | FStr1: string; 115 | FStr2: string; 116 | procedure PushDiff(offset1, offset2, len1, len2: integer); 117 | function PopDiff: boolean; 118 | procedure InitDiagArrays(len1, len2: integer); 119 | procedure DiffInt(offset1, offset2, len1, len2: integer); 120 | procedure DiffChr(offset1, offset2, len1, len2: integer); 121 | function SnakeChrF(k,offset1,offset2,len1,len2: integer): boolean; 122 | function SnakeChrB(k,offset1,offset2,len1,len2: integer): boolean; 123 | function SnakeIntF(k,offset1,offset2,len1,len2: integer): boolean; 124 | function SnakeIntB(k,offset1,offset2,len1,len2: integer): boolean; 125 | procedure AddChangeChr(offset1, range: integer; ChangeKind: TChangeKind); 126 | procedure AddChangeInt(offset1, range: integer; ChangeKind: TChangeKind); 127 | function CompareChr(const ch1, ch2: Char): Boolean; 128 | function GetCompareCount: integer; 129 | function GetCompare(index: integer): TCompareRec; 130 | public 131 | constructor Create(aOwner: TComponent); override; 132 | destructor Destroy; override; 133 | 134 | // Compare strings or list of Cardinals ... 135 | {$IFDEF FPC} 136 | function Execute(const alist1, alist2: TCardinalList): boolean; overload; 137 | {$ELSE} 138 | function Execute(const alist1, alist2: TList<Cardinal>): boolean; overload; 139 | {$ENDIF} 140 | function Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; overload; 141 | // Cancel allows interrupting excessively prolonged comparisons 142 | procedure Cancel; 143 | procedure Clear; 144 | property Cancelled: boolean read FCancelled; 145 | property CompareList: TList read FCompareList write FCompareList; 146 | property Count: integer read GetCompareCount; 147 | property Compares[index: integer]: TCompareRec read GetCompare; default; 148 | property DiffStats: TDiffStats read FDiffStats; 149 | end; 150 | 151 | implementation 152 | 153 | uses 154 | System.Character; 155 | 156 | constructor TNPDiff.Create(aOwner: TComponent); 157 | begin 158 | inherited; 159 | FCompareList := TList.create; 160 | FDiffList := TList.Create; 161 | FIgnoreCase := False; 162 | end; 163 | //------------------------------------------------------------------------------ 164 | 165 | destructor TNPDiff.Destroy; 166 | begin 167 | Clear; 168 | FCompareList.free; 169 | FDiffList.Free; 170 | inherited; 171 | end; 172 | //------------------------------------------------------------------------------ 173 | 174 | {$IFDEF FPC} 175 | function TNPDiff.Execute(const alist1, alist2: TCardinalList): boolean; 176 | {$ELSE} 177 | function TNPDiff.Execute(const alist1, alist2: TList<Cardinal>): boolean; 178 | {$ENDIF} 179 | var 180 | i, Len1Minus1: integer; 181 | len1,len2: Integer; 182 | begin 183 | Result := not FExecuting; 184 | if not Result then exit; 185 | FCancelled := false; 186 | FExecuting := true; 187 | try 188 | FList1 := alist1; 189 | FList2 := alist2; 190 | len1 := FList1.Count; 191 | len2 := FList2.Count; 192 | 193 | Clear; 194 | 195 | Len1Minus1 := len1 -1; 196 | FCompareList.Capacity := len1 + len2; 197 | FCompareInts := true; 198 | 199 | GetMem(DiagBufferF, sizeof(integer)*(len1+len2+3)); 200 | GetMem(DiagBufferB, sizeof(integer)*(len1+len2+3)); 201 | try 202 | PushDiff(0, 0, len1, len2); 203 | while PopDiff do; 204 | finally 205 | freeMem(DiagBufferF); 206 | freeMem(DiagBufferB); 207 | end; 208 | 209 | if FCancelled then 210 | begin 211 | Result := false; 212 | Clear; 213 | exit; 214 | end; 215 | 216 | //correct the occasional missed match ... 217 | for i := 1 to count -1 do 218 | with PCompareRec(FCompareList[i])^ do 219 | if (Kind = ckModify) and (int1 = int2) then 220 | begin 221 | Kind := ckNone; 222 | Dec(FDiffStats.modifies); 223 | Inc(FDiffStats.matches); 224 | end; 225 | 226 | //finally, append any trailing matches onto compareList ... 227 | with FLastCompareRec do 228 | AddChangeInt(oldIndex1,len1Minus1-oldIndex1, ckNone); 229 | finally 230 | FExecuting := false; 231 | end; 232 | end; 233 | //------------------------------------------------------------------------------ 234 | 235 | function TNPDiff.Execute(const s1, s2: string; const bIgnoreCase: Boolean = False): boolean; 236 | var 237 | i, Len1Minus1: integer; 238 | len1,len2: Integer; 239 | begin 240 | Result := not FExecuting; 241 | if not Result then exit; 242 | FCancelled := false; 243 | FExecuting := true; 244 | FIgnoreCase := bIgnoreCase; 245 | try 246 | Clear; 247 | len1 := Length(s1); 248 | len2 := Length(s2); 249 | Len1Minus1 := len1 -1; 250 | FCompareList.Capacity := len1 + len2; 251 | FDiffList.Capacity := 1024; 252 | FCompareInts := false; 253 | 254 | GetMem(DiagBufferF, sizeof(integer)*(len1+len2+3)); 255 | GetMem(DiagBufferB, sizeof(integer)*(len1+len2+3)); 256 | FStr1 := s1; 257 | FStr2 := s2; 258 | try 259 | PushDiff(1, 1, len1, len2); 260 | while PopDiff do; 261 | finally 262 | freeMem(DiagBufferF); 263 | freeMem(DiagBufferB); 264 | end; 265 | 266 | if FCancelled then 267 | begin 268 | Result := false; 269 | Clear; 270 | exit; 271 | end; 272 | 273 | //correct the occasional missed match ... 274 | for i := 1 to count -1 do 275 | with PCompareRec(FCompareList[i])^ do 276 | if (Kind = ckModify) and (chr1 = chr2) then 277 | begin 278 | Kind := ckNone; 279 | Dec(FDiffStats.modifies); 280 | Inc(FDiffStats.matches); 281 | end; 282 | 283 | //finally, append any trailing matches onto compareList ... 284 | with FLastCompareRec do 285 | begin 286 | AddChangeChr(oldIndex1,len1Minus1-oldIndex1+1, ckNone); 287 | end; 288 | finally 289 | FExecuting := false; 290 | end; 291 | end; 292 | //------------------------------------------------------------------------------ 293 | 294 | procedure TNPDiff.PushDiff(offset1, offset2, len1, len2: integer); 295 | var 296 | DiffVars: PDiffVars; 297 | begin 298 | new(DiffVars); 299 | DiffVars.offset1 := offset1; 300 | DiffVars.offset2 := offset2; 301 | DiffVars.len1 := len1; 302 | DiffVars.len2 := len2; 303 | FDiffList.Add(DiffVars); 304 | end; 305 | //------------------------------------------------------------------------------ 306 | 307 | function TNPDiff.PopDiff: boolean; 308 | var 309 | DiffVars: PDiffVars; 310 | idx: integer; 311 | begin 312 | idx := FDiffList.Count -1; 313 | Result := idx >= 0; 314 | if not Result then exit; 315 | DiffVars := PDiffVars(FDiffList[idx]); 316 | with DiffVars^ do 317 | if FCompareInts then 318 | DiffInt(offset1, offset2, len1, len2) 319 | else 320 | DiffChr(offset1, offset2, len1, len2); 321 | Dispose(DiffVars); 322 | FDiffList.Delete(idx); 323 | end; 324 | //------------------------------------------------------------------------------ 325 | 326 | procedure TNPDiff.InitDiagArrays(len1, len2: integer); 327 | var 328 | i: integer; 329 | begin 330 | //assumes that top and bottom matches have been excluded 331 | P8Bits(DiagF) := P8Bits(DiagBufferF) - sizeof(integer)*(MAX_DIAGONAL-(len1+1)); 332 | for i := - (len1+1) to (len2+1) do 333 | DiagF^[i] := -MAXINT; 334 | DiagF^[1] := -1; 335 | 336 | P8Bits(DiagB) := P8Bits(DiagBufferB) - sizeof(integer)*(MAX_DIAGONAL-(len1+1)); 337 | for i := - (len1+1) to (len2+1) do 338 | DiagB^[i] := MAXINT; 339 | DiagB^[len2-len1+1] := len2; 340 | end; 341 | //------------------------------------------------------------------------------ 342 | 343 | procedure TNPDiff.DiffInt(offset1, offset2, len1, len2: integer); 344 | var 345 | p, k, delta: integer; 346 | begin 347 | if offset1+len1 > FList1.Count then len1 := FList1.Count - offset1; 348 | if offset2+len2 > FList2.Count then len2 := FList2.Count - offset2; 349 | //trim matching bottoms ... 350 | while (len1 > 0) and (len2 > 0) and (FList1[offset1] = FList2[offset2]) do 351 | begin 352 | inc(offset1); inc(offset2); dec(len1); dec(len2); 353 | end; 354 | //trim matching tops ... 355 | while (len1 > 0) and (len2 > 0) and (FList1[offset1+len1-1] = FList2[offset2+len2-1]) do 356 | begin 357 | dec(len1); dec(len2); 358 | end; 359 | 360 | //stop diff'ing if minimal conditions reached ... 361 | if (len1 = 0) then 362 | begin 363 | AddChangeInt(offset1 ,len2, ckAdd); 364 | exit; 365 | end 366 | else if (len2 = 0) then 367 | begin 368 | AddChangeInt(offset1 ,len1, ckDelete); 369 | exit; 370 | end 371 | else if (len1 = 1) and (len2 = 1) then 372 | begin 373 | AddChangeInt(offset1, 1, ckDelete); 374 | AddChangeInt(offset1, 1, ckAdd); 375 | exit; 376 | end; 377 | 378 | p := -1; 379 | delta := len2 - len1; 380 | InitDiagArrays(len1, len2); 381 | if delta < 0 then 382 | begin 383 | repeat 384 | inc(p); 385 | if (p mod 1024) = 1023 then 386 | begin 387 | Application.ProcessMessages; 388 | if FCancelled then exit; 389 | end; 390 | //nb: the Snake order is important here 391 | for k := p downto delta +1 do 392 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 393 | for k := -p + delta to delta-1 do 394 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 395 | for k := delta -p to -1 do 396 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 397 | for k := p downto 1 do 398 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 399 | if SnakeIntF(delta,offset1,offset2,len1,len2) then exit; 400 | if SnakeIntB(0,offset1,offset2,len1,len2) then exit; 401 | until(false); 402 | end else 403 | begin 404 | repeat 405 | inc(p); 406 | if (p mod 1024) = 1023 then 407 | begin 408 | Application.ProcessMessages; 409 | if FCancelled then exit; 410 | end; 411 | //nb: the Snake order is important here 412 | for k := -p to delta -1 do 413 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 414 | for k := p + delta downto delta +1 do 415 | if SnakeIntF(k,offset1,offset2,len1,len2) then exit; 416 | for k := delta + p downto 1 do 417 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 418 | for k := -p to -1 do 419 | if SnakeIntB(k,offset1,offset2,len1,len2) then exit; 420 | if SnakeIntF(delta,offset1,offset2,len1,len2) then exit; 421 | if SnakeIntB(0,offset1,offset2,len1,len2) then exit; 422 | until(false); 423 | end; 424 | end; 425 | //------------------------------------------------------------------------------ 426 | 427 | procedure TNPDiff.DiffChr(offset1, offset2, len1, len2: integer); 428 | var 429 | p, k, delta: integer; 430 | begin 431 | //trim matching bottoms ... 432 | while (len1 > 0) and (len2 > 0) and CompareChr(FStr1[offset1], FStr2[offset2]) do 433 | begin 434 | inc(offset1); inc(offset2); dec(len1); dec(len2); 435 | end; 436 | //trim matching tops ... 437 | while (len1 > 0) and (len2 > 0) and CompareChr(FStr1[offset1+len1-1], FStr2[offset2+len2-1]) do 438 | begin 439 | dec(len1); dec(len2); 440 | end; 441 | 442 | //stop diff'ing if minimal conditions reached ... 443 | if (len1 = 0) then 444 | begin 445 | AddChangeChr(offset1 ,len2, ckAdd); 446 | exit; 447 | end 448 | else if (len2 = 0) then 449 | begin 450 | AddChangeChr(offset1, len1, ckDelete); 451 | exit; 452 | end 453 | else if (len1 = 1) and (len2 = 1) then 454 | begin 455 | AddChangeChr(offset1, 1, ckDelete); 456 | AddChangeChr(offset1, 1, ckAdd); 457 | exit; 458 | end; 459 | 460 | p := -1; 461 | delta := len2 - len1; 462 | InitDiagArrays(len1, len2); 463 | if delta < 0 then 464 | begin 465 | repeat 466 | inc(p); 467 | if (p mod 1024 = 1023) then 468 | begin 469 | Application.ProcessMessages; 470 | if FCancelled then exit; 471 | end; 472 | //nb: the Snake order is important here 473 | for k := p downto delta +1 do 474 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 475 | for k := -p + delta to delta-1 do 476 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 477 | for k := delta -p to -1 do 478 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 479 | for k := p downto 1 do 480 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 481 | if SnakeChrF(delta,offset1,offset2,len1,len2) then exit; 482 | if SnakeChrB(0,offset1,offset2,len1,len2) then exit; 483 | until(false); 484 | end else 485 | begin 486 | repeat 487 | inc(p); 488 | if (p mod 1024 = 1023) then 489 | begin 490 | Application.ProcessMessages; 491 | if FCancelled then exit; 492 | end; 493 | //nb: the Snake order is important here 494 | for k := -p to delta -1 do 495 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 496 | for k := p + delta downto delta +1 do 497 | if SnakeChrF(k,offset1,offset2,len1,len2) then exit; 498 | for k := delta + p downto 1 do 499 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 500 | for k := -p to -1 do 501 | if SnakeChrB(k,offset1,offset2,len1,len2) then exit; 502 | if SnakeChrF(delta,offset1,offset2,len1,len2) then exit; 503 | if SnakeChrB(0,offset1,offset2,len1,len2) then exit; 504 | until(false); 505 | end; 506 | end; 507 | //------------------------------------------------------------------------------ 508 | 509 | function TNPDiff.SnakeChrF(k,offset1,offset2,len1,len2: integer): boolean; 510 | var 511 | x,y: integer; 512 | begin 513 | if DiagF[k+1] > DiagF[k-1] then 514 | y := DiagF[k+1] else 515 | y := DiagF[k-1]+1; 516 | x := y - k; 517 | while (x < len1-1) and (y < len2-1) and CompareChr(FStr1[offset1+x+1], FStr2[offset2+y+1]) do 518 | begin 519 | inc(x); inc(y); 520 | end; 521 | DiagF[k] := y; 522 | Result := (DiagF[k] >= DiagB[k]); 523 | if not Result then exit; 524 | 525 | inc(x); inc(y); 526 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 527 | PushDiff(offset1, offset2, x, y); 528 | end; 529 | //------------------------------------------------------------------------------ 530 | 531 | function TNPDiff.SnakeChrB(k,offset1,offset2,len1,len2: integer): boolean; 532 | var 533 | x,y: integer; 534 | begin 535 | if DiagB[k-1] < DiagB[k+1] then 536 | y := DiagB[k-1] 537 | else 538 | y := DiagB[k+1]-1; 539 | 540 | x := y - k; 541 | while (x >= 0) and (y >= 0) and CompareChr(FStr1[offset1+x], FStr2[offset2+y]) do 542 | begin 543 | dec(x); dec(y); 544 | end; 545 | DiagB[k] := y; 546 | Result := DiagB[k] <= DiagF[k]; 547 | if not Result then exit; 548 | 549 | inc(x); inc(y); 550 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 551 | PushDiff(offset1, offset2, x, y); 552 | end; 553 | //------------------------------------------------------------------------------ 554 | 555 | function TNPDiff.SnakeIntF(k,offset1,offset2,len1,len2: integer): boolean; 556 | var 557 | x,y: integer; 558 | begin 559 | if DiagF^[k+1] > DiagF^[k-1] then 560 | y := DiagF^[k+1] 561 | else 562 | y := DiagF^[k-1]+1; 563 | x := y - k; 564 | while (x < len1-1) and (y < len2-1) and (FList1[offset1+x+1] = FList2[offset2+y+1]) do 565 | begin 566 | inc(x); inc(y); 567 | end; 568 | DiagF^[k] := y; 569 | Result := (DiagF^[k] >= DiagB^[k]); 570 | if not Result then exit; 571 | 572 | inc(x); inc(y); 573 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 574 | PushDiff(offset1, offset2, x, y); 575 | end; 576 | //------------------------------------------------------------------------------ 577 | 578 | function TNPDiff.SnakeIntB(k,offset1,offset2,len1,len2: integer): boolean; 579 | var 580 | x,y: integer; 581 | begin 582 | if DiagB^[k-1] < DiagB^[k+1] then 583 | y := DiagB^[k-1] 584 | else 585 | y := DiagB^[k+1]-1; 586 | x := y - k; 587 | while (x >= 0) and (y >= 0) and (FList1[offset1+x] = FList2[offset2+y]) do 588 | begin 589 | dec(x); dec(y); 590 | end; 591 | DiagB^[k] := y; 592 | Result := DiagB^[k] <= DiagF^[k]; 593 | if not Result then exit; 594 | 595 | inc(x); inc(y); 596 | PushDiff(offset1+x, offset2+y, len1-x, len2-y); 597 | PushDiff(offset1, offset2, x, y); 598 | end; 599 | //------------------------------------------------------------------------------ 600 | 601 | procedure TNPDiff.AddChangeChr(offset1, range: integer; ChangeKind: TChangeKind); 602 | var 603 | i,j: integer; 604 | compareRec: PCompareRec; 605 | begin 606 | //first, add any unchanged items into this list ... 607 | if FLastCompareRec.oldIndex1 < 0 then FLastCompareRec.oldIndex1 := 0; 608 | if FLastCompareRec.oldIndex2 < 0 then FLastCompareRec.oldIndex2 := 0; 609 | while (FLastCompareRec.oldIndex1 < offset1 -1) do 610 | begin 611 | with FLastCompareRec do 612 | begin 613 | chr1 := #0; 614 | chr2 := #0; 615 | Kind := ckNone; 616 | inc(oldIndex1); 617 | inc(oldIndex2); 618 | if (oldIndex1 > 0) and (oldIndex1 <= Length(FStr1)) then 619 | chr1 := FStr1[oldIndex1]; 620 | if (oldIndex2 > 0) and (oldIndex2 <= Length(FStr2)) then 621 | chr2 := FStr2[oldIndex2]; 622 | end; 623 | New(compareRec); 624 | compareRec^ := FLastCompareRec; 625 | FCompareList.Add(compareRec); 626 | inc(FDiffStats.matches); 627 | end; 628 | 629 | case ChangeKind of 630 | ckNone: 631 | for i := 1 to range do 632 | begin 633 | with FLastCompareRec do 634 | begin 635 | Kind := ckNone; 636 | inc(oldIndex1); 637 | inc(oldIndex2); 638 | chr1 := FStr1[oldIndex1]; 639 | chr2 := FStr2[oldIndex2]; 640 | end; 641 | New(compareRec); 642 | compareRec^ := FLastCompareRec; 643 | FCompareList.Add(compareRec); 644 | inc(FDiffStats.matches); 645 | end; 646 | ckAdd : 647 | begin 648 | for i := 1 to range do 649 | begin 650 | with FLastCompareRec do 651 | begin 652 | 653 | //check if a range of adds are following a range of deletes 654 | //and convert them to modifies ... 655 | if Kind = ckDelete then 656 | begin 657 | j := FCompareList.Count -1; 658 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckDelete) do 659 | dec(j); 660 | PCompareRec(FCompareList[j]).Kind := ckModify; 661 | dec(FDiffStats.deletes); 662 | inc(FDiffStats.modifies); 663 | inc(FLastCompareRec.oldIndex2); 664 | PCompareRec(FCompareList[j]).oldIndex2 := FLastCompareRec.oldIndex2; 665 | PCompareRec(FCompareList[j]).chr2 := FStr2[oldIndex2]; 666 | if j = FCompareList.Count-1 then 667 | FLastCompareRec.Kind := ckModify; 668 | continue; 669 | end; 670 | 671 | Kind := ckAdd; 672 | chr1 := #0; 673 | inc(oldIndex2); 674 | chr2 := FStr2[oldIndex2]; //ie what we added 675 | end; 676 | New(compareRec); 677 | compareRec^ := FLastCompareRec; 678 | FCompareList.Add(compareRec); 679 | inc(FDiffStats.adds); 680 | end; 681 | end; 682 | ckDelete : 683 | begin 684 | for i := 1 to range do 685 | begin 686 | with FLastCompareRec do 687 | begin 688 | 689 | //check if a range of deletes are following a range of adds 690 | //and convert them to modifies ... 691 | if Kind = ckAdd then 692 | begin 693 | j := FCompareList.Count -1; 694 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckAdd) do 695 | dec(j); 696 | PCompareRec(FCompareList[j]).Kind := ckModify; 697 | dec(FDiffStats.adds); 698 | inc(FDiffStats.modifies); 699 | inc(FLastCompareRec.oldIndex1); 700 | PCompareRec(FCompareList[j]).oldIndex1 := FLastCompareRec.oldIndex1; 701 | PCompareRec(FCompareList[j]).chr1 := FStr1[oldIndex1]; 702 | if j = FCompareList.Count-1 then 703 | FLastCompareRec.Kind := ckModify; 704 | continue; 705 | end; 706 | 707 | Kind := ckDelete; 708 | chr2 := #0; 709 | inc(oldIndex1); 710 | chr1 := FStr1[oldIndex1]; //ie what we deleted 711 | end; 712 | New(compareRec); 713 | compareRec^ := FLastCompareRec; 714 | FCompareList.Add(compareRec); 715 | inc(FDiffStats.deletes); 716 | end; 717 | end; 718 | end; 719 | end; 720 | //------------------------------------------------------------------------------ 721 | 722 | procedure TNPDiff.AddChangeInt(offset1, range: integer; ChangeKind: TChangeKind); 723 | var 724 | i,j: integer; 725 | compareRec: PCompareRec; 726 | begin 727 | //first, add any unchanged items into this list ... 728 | while (FLastCompareRec.oldIndex1 < offset1 -1) do 729 | begin 730 | with FLastCompareRec do 731 | begin 732 | Kind := ckNone; 733 | inc(oldIndex1); 734 | inc(oldIndex2); 735 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 736 | int1 := Integer(FList1[oldIndex1]); 737 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 738 | int2 := Integer(FList2[oldIndex2]); 739 | end; 740 | New(compareRec); 741 | compareRec^ := FLastCompareRec; 742 | FCompareList.Add(compareRec); 743 | inc(FDiffStats.matches); 744 | end; 745 | 746 | case ChangeKind of 747 | ckNone: 748 | for i := 1 to range do 749 | begin 750 | with FLastCompareRec do 751 | begin 752 | Kind := ckNone; 753 | inc(oldIndex1); 754 | inc(oldIndex2); 755 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 756 | int1 := Integer(FList1[oldIndex1]); 757 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 758 | int2 := Integer(FList2[oldIndex2]); 759 | end; 760 | New(compareRec); 761 | compareRec^ := FLastCompareRec; 762 | FCompareList.Add(compareRec); 763 | inc(FDiffStats.matches); 764 | end; 765 | ckAdd : 766 | begin 767 | for i := 1 to range do 768 | begin 769 | with FLastCompareRec do 770 | begin 771 | 772 | //check if a range of adds are following a range of deletes 773 | //and convert them to modifies ... 774 | if Kind = ckDelete then 775 | begin 776 | j := FCompareList.Count -1; 777 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckDelete) do 778 | dec(j); 779 | PCompareRec(FCompareList[j]).Kind := ckModify; 780 | dec(FDiffStats.deletes); 781 | inc(FDiffStats.modifies); 782 | inc(FLastCompareRec.oldIndex2); 783 | PCompareRec(FCompareList[j]).oldIndex2 := FLastCompareRec.oldIndex2; 784 | PCompareRec(FCompareList[j]).int2 := Integer(FList2[oldIndex2]); 785 | if j = FCompareList.Count-1 then FLastCompareRec.Kind := ckModify; 786 | continue; 787 | end; 788 | 789 | Kind := ckAdd; 790 | int1 := $0; 791 | inc(oldIndex2); 792 | if (oldIndex2 >= 0) and (oldIndex2 < FList2.Count) then 793 | int2 := Integer(FList2[oldIndex2]); //ie what we added 794 | end; 795 | New(compareRec); 796 | compareRec^ := FLastCompareRec; 797 | FCompareList.Add(compareRec); 798 | inc(FDiffStats.adds); 799 | end; 800 | end; 801 | ckDelete : 802 | begin 803 | for i := 1 to range do 804 | begin 805 | with FLastCompareRec do 806 | begin 807 | 808 | //check if a range of deletes are following a range of adds 809 | //and convert them to modifies ... 810 | if Kind = ckAdd then 811 | begin 812 | j := FCompareList.Count -1; 813 | while (j > 0) and (PCompareRec(FCompareList[j-1]).Kind = ckAdd) do 814 | dec(j); 815 | PCompareRec(FCompareList[j]).Kind := ckModify; 816 | dec(FDiffStats.adds); 817 | inc(FDiffStats.modifies); 818 | inc(FLastCompareRec.oldIndex1); 819 | PCompareRec(FCompareList[j]).oldIndex1 := FLastCompareRec.oldIndex1; 820 | PCompareRec(FCompareList[j]).int1 := Integer(FList1[oldIndex1]); 821 | if j = FCompareList.Count-1 then FLastCompareRec.Kind := ckModify; 822 | continue; 823 | end; 824 | 825 | Kind := ckDelete; 826 | int2 := $0; 827 | inc(oldIndex1); 828 | if (oldIndex1 >= 0) and (oldIndex1 < FList1.Count) then 829 | int1 := Integer(FList1[oldIndex1]); //ie what we deleted 830 | end; 831 | New(compareRec); 832 | compareRec^ := FLastCompareRec; 833 | FCompareList.Add(compareRec); 834 | inc(FDiffStats.deletes); 835 | end; 836 | end; 837 | end; 838 | end; 839 | //------------------------------------------------------------------------------ 840 | 841 | procedure TNPDiff.Clear; 842 | var 843 | i: integer; 844 | begin 845 | for i := 0 to FCompareList.Count-1 do 846 | dispose(PCompareRec(FCompareList[i])); 847 | FCompareList.clear; 848 | FLastCompareRec.Kind := ckNone; 849 | FLastCompareRec.oldIndex1 := -1; 850 | FLastCompareRec.oldIndex2 := -1; 851 | FDiffStats.matches := 0; 852 | FDiffStats.adds := 0; 853 | FDiffStats.deletes :=0; 854 | FDiffStats.modifies :=0; 855 | end; 856 | //------------------------------------------------------------------------------ 857 | 858 | function TNPDiff.GetCompareCount: integer; 859 | begin 860 | Result := FCompareList.count; 861 | end; 862 | //------------------------------------------------------------------------------ 863 | 864 | function TNPDiff.GetCompare(index: integer): TCompareRec; 865 | begin 866 | Result := PCompareRec(FCompareList[index])^; 867 | end; 868 | //------------------------------------------------------------------------------ 869 | 870 | procedure TNPDiff.Cancel; 871 | begin 872 | FCancelled := true; 873 | end; 874 | 875 | function TNPDiff.CompareChr(const ch1, ch2: Char): Boolean; 876 | begin 877 | if FIgnoreCase then 878 | Result := (ch1.ToLower = ch2.ToLower) 879 | else 880 | Result := (ch1 = ch2); 881 | end; 882 | 883 | //------------------------------------------------------------------------------ 884 | 885 | end. 886 | -------------------------------------------------------------------------------- /src/HashUnit.pas: -------------------------------------------------------------------------------- 1 | unit HashUnit; 2 | 3 | {$IFDEF FPC} 4 | {$mode delphi}{$H+} 5 | {$ENDIF} 6 | 7 | // ----------------------------------------------------------------------------- 8 | // Application: TextDiff . 9 | // Module: HashUnit . 10 | // Version: 5.0 . 11 | // Date: 18-MAY-2020 . 12 | // Target: Win32, Delphi 10.x . 13 | // Author: Angus Johnson - angusj-AT-myrealbox-DOT-com . 14 | // Updates by: Rickard Johansson (RJ TextEd) . 15 | // Copyright; © 2003-2004 Angus Johnson . 16 | // ----------------------------------------------------------------------------- 17 | 18 | (******************************************************************************* 19 | * History: * 20 | * 18 May 2020 * 21 | * Added Lazarus support * 22 | * Updated comment section for public release of version 5.0 * 23 | * * 24 | * 11 November 2018 * 25 | * - Hashline returns a Cardinal instead of a pointer * 26 | * Updated Hashline (IgnoreBlanks) to handle Unicode white spaces * 27 | * CalcCRC32 updated to handle Unicode string * 28 | *******************************************************************************) 29 | 30 | interface 31 | 32 | uses 33 | SysUtils; 34 | 35 | function HashLine(const line: string; IgnoreCase, IgnoreBlanks: boolean): Cardinal; 36 | 37 | implementation 38 | 39 | uses 40 | {$ifndef fpc} 41 | Winapi.Windows, 42 | System.Character; 43 | {$else} 44 | Character; 45 | {$endif} 46 | 47 | const 48 | table: ARRAY[0..255] OF DWORD = 49 | ($00000000, $77073096, $EE0E612C, $990951BA, 50 | $076DC419, $706AF48F, $E963A535, $9E6495A3, 51 | $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, 52 | $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91, 53 | $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, 54 | $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, 55 | $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, 56 | $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, 57 | $3B6E20C8, $4C69105E, $D56041E4, $A2677172, 58 | $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, 59 | $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, 60 | $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, 61 | $26D930AC, $51DE003A, $C8D75180, $BFD06116, 62 | $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F, 63 | $2802B89E, $5F058808, $C60CD9B2, $B10BE924, 64 | $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, 65 | 66 | $76DC4190, $01DB7106, $98D220BC, $EFD5102A, 67 | $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433, 68 | $7807C9A2, $0F00F934, $9609A88E, $E10E9818, 69 | $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01, 70 | $6B6B51F4, $1C6C6162, $856530D8, $F262004E, 71 | $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, 72 | $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, 73 | $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, 74 | $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, 75 | $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, 76 | $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, 77 | $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9, 78 | $5005713C, $270241AA, $BE0B1010, $C90C2086, 79 | $5768B525, $206F85B3, $B966D409, $CE61E49F, 80 | $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, 81 | $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD, 82 | 83 | $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, 84 | $EAD54739, $9DD277AF, $04DB2615, $73DC1683, 85 | $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, 86 | $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, 87 | $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, 88 | $F762575D, $806567CB, $196C3671, $6E6B06E7, 89 | $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, 90 | $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, 91 | $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, 92 | $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B, 93 | $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, 94 | $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79, 95 | $CB61B38C, $BC66831A, $256FD2A0, $5268E236, 96 | $CC0C7795, $BB0B4703, $220216B9, $5505262F, 97 | $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, 98 | $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D, 99 | 100 | $9B64C2B0, $EC63F226, $756AA39C, $026D930A, 101 | $9C0906A9, $EB0E363F, $72076785, $05005713, 102 | $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, 103 | $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, 104 | $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, 105 | $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, 106 | $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, 107 | $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, 108 | $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, 109 | $A7672661, $D06016F7, $4969474D, $3E6E77DB, 110 | $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, 111 | $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9, 112 | $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, 113 | $BAD03605, $CDD70693, $54DE5729, $23D967BF, 114 | $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, 115 | $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D); 116 | 117 | //CRC algorithm courtesy of Earl F. Glynn ... 118 | //(http://www.efg2.com/Lab/Mathematics/CRC.htm) 119 | function CalcCRC32(const s: string; len: Integer): Cardinal; 120 | var 121 | i,byteLen: integer; 122 | p: PByte; 123 | begin 124 | p := PByte(s); 125 | {$ifndef fpc} 126 | byteLen := 2*len; 127 | {$else} 128 | byteLen := len; 129 | {$endif} 130 | result := $FFFFFFFF; 131 | for i := 0 to byteLen-1 do 132 | begin 133 | result := (result shr 8) xor table[ p^ xor (result and $000000ff) ]; 134 | inc(p); 135 | end; 136 | result := not result; 137 | end; 138 | 139 | function HashLine(const line: string; IgnoreCase, IgnoreBlanks: boolean): Cardinal; 140 | var 141 | i,j,len: integer; 142 | s: string; 143 | begin 144 | s := line; 145 | len := Length(line); 146 | if IgnoreBlanks then 147 | begin 148 | i := 1; 149 | j := 1; 150 | while i <= len do 151 | begin 152 | if not IsWhiteSpace(line[i]) then 153 | begin 154 | s[j] := line[i]; 155 | inc(j); 156 | end; 157 | inc(i); 158 | end; 159 | len := j-1; 160 | setlength(s,len); 161 | end; 162 | if IgnoreCase then 163 | s := s.ToUpper; 164 | result := CalcCRC32(s, len); 165 | end; 166 | 167 | 168 | end. 169 | --------------------------------------------------------------------------------