The file comparer program compares two binary files and tells whether they are identical or not. In the latter case, the first difference is pointed out.
To select the two files to compare, simply drag them (one at a time) from Windows Explorer to either of the panels in the File Comparer GUI. You can also right-click a panel and select "Select file...", or double-click an empty panel (double-clicking a panel that has already been assigned a file will ask you to open the file). Alternatively, you may assign one or both of the panels using command-line arguments. The optional flag "/C", when used after two files have been specified, will close the program as soon as the result of the comparison has been presented, as in
fileCompare fileA.bin fileB.bin /C
unit mainWin; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, CommCtrl, BinaryComparer, StdCtrls, ComCtrls, Themes, RejbrandCommon, ShellAPI, ShLwAPI, Menus, Clipbrd; const SC_ABOUT = WM_USER + 1; const SHIL_LARGE = $00; SHIL_SMALL = $01; SHIL_EXTRALARGE= $02; SHIL_SYSSMALL = $03; SHIL_JUMBO = $04; IID_IImageList: TGUID = '{46EB5926-582E-4017-9FDF-E8998DAA0950}'; function SHGetImageList(iImageList: integer; const riid: TGUID; var ppv: pointer): HRESULT; stdcall; external shell32; type PCompareResult = ^TCompareResult; TCompareResult = record Equal: boolean; SizeA, SizeB: Int64; Offset: Int64; ByteA, ByteB: byte; end; TFileIndex = 1..2; TmainFrm = class(TForm) leftPn: TPanel; rightPn: TPanel; leftIcon: TImage; leftTextPn: TPanel; rightTextPn: TPanel; rightIcon: TImage; pbComparing: TProgressBar; lblComparing: TLabel; btnCancel: TButton; pnRelOp: TPanel; btnCompare: TButton; textPanelBlinkTimer: TTimer; filePopup: TPopupMenu; mnuOpen: TMenuItem; mnuOpenDir: TMenuItem; mnuProperties: TMenuItem; mnuCopyFileName: TMenuItem; mnuCommandPrompt: TMenuItem; N1: TMenuItem; mnuSelectFile: TMenuItem; lblDetails: TLinkLabel; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btnCancelClick(Sender: TObject); procedure btnCompareClick(Sender: TObject); procedure textPanelBlinkTimerTimer(Sender: TObject); procedure iconDblClick(Sender: TObject); procedure filePopupPopup(Sender: TObject); procedure mnuOpenClick(Sender: TObject); procedure mnuOpenDirClick(Sender: TObject); procedure mnuPropertiesClick(Sender: TObject); procedure mnuCopyFileNameClick(Sender: TObject); procedure mnuCommandPromptClick(Sender: TObject); procedure mnuSelectFileClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure lblDetailsLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); private FFileA, FFileB, FContextFileName: TFileName; FCompareResult: TCompareResult; bc: TBinaryComparer; FExitWhenDone: boolean; procedure SetFile(const FileName: TFileName; const Index: TFileIndex); procedure StartCompare; procedure StopCompare; procedure ShowStats; procedure ShowAboutDialog; procedure TaskDialogHyperLinkClicked(Sender: TObject); procedure AnimateTextPanel(Panel: TPanel); procedure OpenFile(const FileName: TFileName); procedure OpenFolder(const FileName: TFileName); procedure ShowPropertiesDialog(const FileName: TFileName); procedure CommandPrompt(const FileName: TFileName); procedure SelectFile(FileIndex: TFileIndex); procedure ShowDetails(AllDetails: boolean = false); protected procedure WMDropFiles(var Message: TWMDropFiles); message WM_DROPFILES; procedure WMCompareResult(var Message: TMessage); message WM_COMPARE_RESULT; procedure WMShowStats(var Message: TMessage); message WM_SHOW_STATS; procedure WMThreadExit(var Message: TMessage); message WM_THREAD_EXIT; procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; { Private declarations } public { Public declarations } end; var mainFrm: TmainFrm; implementation {$R *.dfm} resourcestring SCompare = 'Compare'; SCompareAgain = 'Compare Again'; STooManyFiles = 'You can only drop a single file onto a slot.'; SFileNotExists = 'The file does not exist or is a directory.'; SComparing = 'Comparing...'; SAbout = 'About'; SOpenFile = 'Do you wish to open/execute the file named "%s" that you double-clicked?'; SEqualResult = 'The files "%s" and "%s" contain IDENTICAL data.'; SNotEqualResult = 'The files "%s" and "%s" contain DIFFERENT data.'; SWillCauseAbort = 'This will abort the current comparison. Do you wish to continue?'; procedure TmainFrm.btnCancelClick(Sender: TObject); begin StopCompare; end; procedure TmainFrm.btnCompareClick(Sender: TObject); begin StartCompare; end; procedure TmainFrm.filePopupPopup(Sender: TObject); begin FContextFileName := ''; if (filePopup.PopupComponent = leftIcon) or (filePopup.PopupComponent = leftTextPn) then begin FContextFileName := FFileA; filePopup.Tag := 1; end else if (filePopup.PopupComponent = rightIcon) or (filePopup.PopupComponent = rightTextPn) then begin FContextFileName := FFileB; filePopup.Tag := 2; end; mnuOpen.Enabled := FContextFileName <> ''; mnuOpenDir.Enabled := FContextFileName <> ''; mnuProperties.Enabled := FContextFileName <> ''; mnuCopyFileName.Enabled := FContextFileName <> ''; mnuCommandPrompt.Enabled := FContextFileName <> ''; mnuCopyFileName.Visible := IsKeyDown(VK_SHIFT); mnuCommandPrompt.Visible := IsKeyDown(VK_SHIFT); mnuSelectFile.Enabled := not ThreadRunning; end; procedure TmainFrm.FormClose(Sender: TObject; var Action: TCloseAction); begin if ThreadRunning then begin bc.Terminate; Sleep(100); end; end; procedure TmainFrm.FormCreate(Sender: TObject); var mnu: HMENU; sfi: TSHFileInfo; begin FExitWhenDone := false; FFileA := ''; FFileB := ''; DragAcceptFiles(Handle, true); mnu := GetSystemMenu(Handle, false); AppendMenu(mnu, MF_SEPARATOR, 0, ''); AppendMenu(mnu, MF_STRING, SC_ABOUT, PChar(SAbout)); SHGetFileInfo('C:\file', FILE_ATTRIBUTE_NORMAL, sfi, SizeOf(sfi), SHGFI_USEFILEATTRIBUTES or SHGFI_ICON); leftIcon.Picture.Icon.Handle := sfi.hIcon; rightIcon.Picture.Icon.Handle := sfi.hIcon; end; procedure TmainFrm.FormShow(Sender: TObject); var i: integer; begin for i := 1 to 2 do if (ParamCount >= i) and FileExists(ParamStr(i)) then SetFile(ParamStr(i), i); if (ParamCount = 3) and (ParamStr(3) = '/C') then FExitWhenDone := true; if (FFileA <> '') and (FFileB <> '') then StartCompare; end; procedure TmainFrm.iconDblClick(Sender: TObject); var fn: TFileName; ndx: TFileIndex; begin fn := ''; if (Sender = leftIcon) or (Sender = leftTextPn) then begin fn := FFileA; ndx := 1; end else if (Sender = rightIcon) or (Sender = rightTextPn) then begin fn := FFileB; ndx := 2; end; if not FileExists(fn) then begin SelectFile(ndx); Exit; end; if MessageBox(Handle, PChar(Format(SOpenFile, [ExtractFileName(fn)])), PChar(Caption), MB_ICONQUESTION or MB_YESNO) = ID_YES then OpenFile(fn); end; procedure TmainFrm.lblDetailsLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); begin ShowDetails(true); end; procedure TmainFrm.mnuCommandPromptClick(Sender: TObject); begin CommandPrompt(FContextFileName); end; procedure TmainFrm.mnuCopyFileNameClick(Sender: TObject); begin Clipboard.AsText := FContextFileName; end; procedure TmainFrm.mnuOpenClick(Sender: TObject); begin OpenFile(FContextFileName); end; procedure TmainFrm.mnuOpenDirClick(Sender: TObject); begin OpenFolder(FContextFileName); end; procedure TmainFrm.mnuPropertiesClick(Sender: TObject); begin ShowPropertiesDialog(FContextFileName); end; procedure TmainFrm.mnuSelectFileClick(Sender: TObject); begin if filePopup.Tag in [1,2] then SelectFile(filePopup.Tag); end; procedure TmainFrm.SelectFile(FileIndex: TFileIndex); begin with TOpenDialog.Create(nil) do try InitialDir := ExtractFilePath(FContextFileName); FileName := FContextFileName; Title := 'Select file to compare'; Options := [ofPathMustExist, ofFileMustExist, ofDontAddToRecent]; if Execute(Handle) then begin SetFile(FileName, FileIndex); if (FFileA <> '') and (FFileB <> '') then StartCompare; end; finally Free; end; end; procedure TmainFrm.SetFile(const FileName: TFileName; const Index: TFileIndex); var textPn: TPanel; image: TImage; DC: HDC; S: string; sfi: TSHFileInfo; il: HIMAGELIST; icon: HICON; begin case Index of 1: begin textPn := leftTextPn; image := leftIcon; FFileA := FileName; end; 2: begin textPn := rightTextPn; image := rightIcon; FFileB := FileName; end; end; if SHGetFileInfo(PChar(FileName), FILE_ATTRIBUTE_NORMAL, sfi, SizeOf(sfi), SHGFI_SYSICONINDEX) = 0 then RaiseLastOSError; if SHGetImageList(SHIL_JUMBO, IID_IImageList, pointer(il)) <> S_OK then RaiseLastOSError; icon := ImageList_GetIcon(il, sfi.iIcon, ILD_NORMAL); if icon = 0 then RaiseLastOSError; image.Picture.Icon.Handle := icon; DC := GetDC(textPn.Handle); try S := FileName; UniqueString(S); // SIC!! PathCompactPath(DC, PChar(S), textPn.ClientWidth); textPn.Caption := S; finally ReleaseDC(textPn.Handle, DC); end; textPn.Hint := FileName; textPn.ShowHint := S <> FileName; AnimateTextPanel(textPn); end; procedure TmainFrm.AnimateTextPanel(Panel: TPanel); var i: Integer; begin Panel.ParentBackground := false; Panel.Color := clHighlight; textPanelBlinkTimer.Tag := integer(Panel); textPanelBlinkTimer.Interval := 500; textPanelBlinkTimer.Enabled := true; end; function PrettyFileSize(const Size: Int64): string; const Prefixes: array[0..8] of string = ('', 'k', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'); var S: extended; n: integer; begin S := Size; n := 0; while (S >= 1024) and (n < 8) do begin S := S / 1024; inc(n); end; PrettyFileSize := FormatFloat('#.00', s) + ' ' + Prefixes[n] + 'B'; end; procedure TmainFrm.ShowDetails(AllDetails: boolean = false); var S, FN, S2: string; begin FN := 'First file: ' + FFileA + sLineBreak + 'Second file: ' + FFileB + sLineBreak + sLineBreak; if FCompareResult.Equal then begin S := Format(SEqualResult, [ExtractFileName(FFileA), ExtractFileName(FFileB)]); S2 := FN + Format('The size of the data stream is %s.', [PrettyFileSize(FCompareResult.SizeA)]); end else begin S := Format(SNotEqualResult, [ExtractFileName(FFileA), ExtractFileName(FFileB)]); if FCompareResult.SizeA <> FCompareResult.SizeB then S2 := FN + Format('The sizes of the data streams are %s and %s, respectively.', [PrettyFileSize(FCompareResult.SizeA), PrettyFileSize(FCompareResult.SizeB)]) else S2 := FN + Format('Both files contain %s data.', [PrettyFileSize(FCompareResult.SizeA)]) + sLineBreak + Format('The data streams first differ at offset %x.', [FCompareResult.Offset]) + sLineBreak + Format('The bytes at this offset are %x and %x, respectively.', [FCompareResult.ByteA, FCompareResult.ByteB]); end; if (Win32MajorVersion >= 6) and ThemeServices.ThemesEnabled then with TTaskDialog.Create(Self) do try Caption := Self.Caption; Title := 'Result'; Text := S; CommonButtons := [tcbClose]; Flags := [tfExpandFooterArea]; if AllDetails then Flags := Flags + [tfExpandedByDefault]; ExpandButtonCaption := 'Details'; ExpandedText := S2; Execute; finally Free; end else MessageBox(Handle, PChar(S + sLineBreak + sLineBreak + S2), PChar(Caption), MB_ICONINFORMATION or MB_OK); end; procedure TmainFrm.WMCompareResult(var Message: TMessage); begin FCompareResult := PCompareResult(Message.LParam)^; Dispose(PCompareResult(Message.LParam)); if FExitWhenDone then begin Hide; ShowDetails; Application.Terminate; Exit; end; if Boolean(Message.WParam) then pnRelOp.Caption := '=' else pnRelOp.Caption := '≠'; pnRelOp.Show; btnCompare.Caption := SCompareAgain; btnCompare.Default := false; btnCompare.Show; lblDetails.Show; end; procedure TmainFrm.WMDropFiles(var Message: TWMDropFiles); var c: integer; fn: array[0..MAX_PATH-1] of char; DropPoint: TPoint; begin if ThreadRunning then begin if MessageBox(Handle, PChar(SWillCauseAbort), PChar(Caption), MB_ICONQUESTION or MB_OKCANCEL) = mrOk then while ThreadRunning do begin StopCompare; Sleep(100); end else Exit; end; c := DragQueryFile(Message.Drop, $FFFFFFFF, fn, MAX_PATH); if c <> 1 then begin MessageBox(Handle, PChar(STooManyFiles), PChar(Caption), MB_ICONERROR); Exit; end; if DragQueryFile(Message.Drop, 0, fn, MAX_PATH) = 0 then Exit; if not FileExists(fn) then begin MessageBox(Handle, PChar(SFileNotExists), PChar(Caption), MB_ICONERROR); Exit; end; DragQueryPoint(Message.Drop, DropPoint); if DropPoint.X < ClientWidth div 2 then SetFile(fn, 1) else SetFile(fn, 2); DragFinish(Message.Drop); if (FFileA <> '') and (FFileB <> '') then StartCompare; end; procedure TmainFrm.WMShowStats(var Message: TMessage); begin if not lblComparing.Visible then ShowStats; end; procedure TmainFrm.WMSysCommand(var Message: TWMSysCommand); begin case Message.CmdType of SC_ABOUT: ShowAboutDialog; else inherited; end; end; procedure TmainFrm.WMThreadExit(var Message: TMessage); begin btnCancel.Hide; pbComparing.Hide; lblComparing.Hide; if pnRelOp.Visible then pnRelOp.Repaint; end; procedure TmainFrm.StartCompare; begin pnRelOp.Hide; pnRelOp.Caption := ''; btnCompare.Hide; lblDetails.Hide; bc := TBinaryComparer.Create(Handle, pbComparing.Handle, FFileA, FFileB); end; procedure TmainFrm.ShowStats; begin pnRelOp.Hide; pnRelOp.Caption := ''; btnCompare.Hide; lblDetails.Hide; lblComparing.Caption := SComparing; lblComparing.Show; pbComparing.Show; btnCancel.Show; end; procedure TmainFrm.StopCompare; begin if ThreadRunning then begin BC.Terminate; btnCancel.Hide; pbComparing.Hide; lblComparing.Hide; btnCompare.Caption := SCompare; btnCompare.Default := true; if (FFileA <> '') and (FFileB <> '') then btnCompare.Show; end; end; procedure TmainFrm.TaskDialogHyperLinkClicked(Sender: TObject); begin if Sender is TTaskDialog then with Sender as TTaskDialog do ShellExecute(Handle, 'open', PChar(URL), nil, nil, SW_SHOWNORMAL); end; procedure TmainFrm.textPanelBlinkTimerTimer(Sender: TObject); begin textPanelBlinkTimer.Enabled := false; leftTextPn.Color := clWhite; leftTextPn.ParentBackground := true; rightTextPn.Color := clWhite; rightTextPn.ParentBackground := true; end; procedure TmainFrm.ShowAboutDialog; begin if (Win32MajorVersion >= 6) and ThemeServices.ThemesEnabled then with TTaskDialog.Create(self) do try Caption := 'About File Comparer'; Title := 'File Comparer'; CommonButtons := [tcbClose]; Text := 'File Version: ' + GetFileVer(Application.ExeName) + #13#10#13#10'Copyright © 2012 Andreas Rejbrand'#13#10#13#10'<a href="http://english.rejbrand.se">http://english.rejbrand.se</a>'; Flags := [tfUseHiconMain, tfEnableHyperlinks]; CustomMainIcon := Application.Icon; OnHyperlinkClicked := TaskDialogHyperlinkClicked; Execute; finally Free; end else // Windows XP Compatibility Code MessageBox(Handle, PChar('File Version: ' + GetFileVer(Application.ExeName) + #13#10#13#10 + 'Copyright © 2012 Andreas Rejbrand' + #13#10#13#10 + 'http://english.rejbrand.se' + #13#10#13#10 + 'File Comparer is running in Windows XP Compatibility Mode.'), PChar('File Comparer'), MB_ICONINFORMATION); end; procedure TmainFrm.OpenFile(const FileName: TFileName); begin ShellExecute(Handle, nil, PChar(FileName), nil, nil, SW_SHOWNORMAL); end; procedure TmainFrm.OpenFolder(const FileName: TFileName); begin ShellExecute(Handle, nil, PChar(ExtractFilePath(FileName)), nil, nil, SW_SHOWNORMAL); end; procedure TmainFrm.ShowPropertiesDialog(const FileName: TFileName); var ei: TShellExecuteInfo; begin FillChar(ei, sizeof(ei), 0); ei.fMask := SEE_MASK_INVOKEIDLIST; ei.cbSize := sizeof(ei); ei.Wnd := Handle; ei.lpVerb := 'properties'; ei.lpFile := PChar(FileName); ei.nShow := SW_SHOWNORMAL; ShellExecuteEx(@ei); end; procedure TmainFrm.CommandPrompt(const FileName: TFileName); begin ShellExecute(0, nil, 'cmd.exe', nil, PChar(ExtractFilePath(FileName)), SW_SHOWNORMAL); end; end. unit BinaryComparer; interface uses Windows, Messages, Classes, SysUtils, CommCtrl; const WM_COMPARE_RESULT = WM_APP + 1; WM_SHOW_STATS = WM_APP + 2; WM_THREAD_EXIT = WM_APP + 3; var ThreadRunning: boolean = false; type TBinaryComparer = class(TThread) private { Private declarations } FParentHandle: HWND; FPBHandle: HWND; FFileA, FFileB: string; procedure Conclude(AEqual: boolean; ASizeA: Int64 = 0; ASizeB: Int64 = 0; AOffset: Int64 = 0; AByteA: byte = 0; AByteB: byte = 0); protected procedure Execute; override; public constructor Create(ParentHandle: HWND; PBHandle: HWND; const FileA, FileB: string); destructor Destroy; override; end; implementation uses mainWin; { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure TBinaryComparer.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; } { TBinaryComparer } constructor TBinaryComparer.Create(ParentHandle: HWND; PBHandle: HWND; const FileA, FileB: string); begin inherited Create(false); FreeOnTerminate := true; FParentHandle := ParentHandle; FPBHandle := PBHandle; FFileA := FileA; FFileB := FileB; end; destructor TBinaryComparer.Destroy; begin ThreadRunning := false; SendMessage(FParentHandle, WM_THREAD_EXIT, 0, 0); inherited; end; procedure TBinaryComparer.Conclude(AEqual: boolean; ASizeA, ASizeB: int64; AOffset: Int64; AByteA, AByteB: byte); var CompareResult: PCompareResult; begin New(CompareResult); with CompareResult^ do begin Equal := AEqual; SizeA := ASizeA; SizeB := ASizeB; Offset := AOffset; ByteA := AByteA; ByteB := AByteB; end; SendMessage(FParentHandle, WM_COMPARE_RESULT, integer(AEqual), integer(CompareResult)); end; procedure TBinaryComparer.Execute; var f1, f2: TFileStream; b1, b2: array[0..1023] of byte; amt, i: integer; tc, oldtc: cardinal; begin ThreadRunning := true; oldtc := GetTickCount; f1 := TFileStream.Create(FFileA, fmOpenRead or fmShareDenyWrite); try f2 := TFileStream.Create(FFileB, fmOpenRead or fmShareDenyWrite); try if f1.Size <> f2.Size then begin Conclude(false, f1.Size, f2.Size); Exit; end; FillChar(b1, length(b1), 0); FillChar(b2, length(b2), 0); while f1.Position < f1.Size do begin f1.Read(b1, sizeof(b1)); amt := f2.Read(b2, sizeof(b2)); if not CompareMem(@b1[0], @b2[0], amt) then begin // Determine precise offset of first mismatch for i := 0 to amt - 1 do if b1[i] <> b2[i] then begin Conclude(false, f1.Size, f2.Size, f1.Position - amt + i, b1[i], b2[i]); Exit; end; Assert(true, 'Not equal but no difference.') end; tc := GetTickCount; if Terminated then Exit; if tc - oldtc > 1000 then begin SendMessage(FParentHandle, WM_SHOW_STATS, 0, 0); SendMessage(FPBHandle, PBM_SETPOS, (100 * f1.Position div f1.Size), 0); oldtc := tc; end; end; Conclude(true, f1.Size); finally f2.Free; end; finally f1.Free; end; end; end.