program compare;
{$RESOURCE compare32.res}
{$APPTYPE CONSOLE}

uses
  SysUtils,
  math,
  windows,httpapp,
  messages,
  Classes;

type TCompareLog=record
Filename:array[0..max_path]of char;
percent:real;
end;

var hf1,hf2:thandle;
data1,data2:array of byte;
bRead,dw,fs,rs:dword;
datap:real;
//sl:tstringlist;
st2:systemtime;
ft2:filetime;
s:string;

procedure CloseFiles(el:real);
var s:string;
dummy1,rs,n:dword;
hk:hkey;
cl:tcomparelog;
begin
if strpos(getcommandline,' /X')<>nil then  begin
regcreatekeyex(hkey_current_user,'Software\Justin\XCompare\Temp',0,'XCompareLog',
REG_OPTION_VOLATILE,key_all_access,nil,hk,@dummy1);
rs:=4;
n:=0;
regqueryvalueex(hk,'FilesFound',nil,nil,@n,@rs);
inc(n);
strpcopy(cl.filename,paramstr(2));
cl.percent:=el;
regsetvalueex(hk,PChar(inttostr(n)),0,reg_none,@cl,sizeof(cl));
regsetvalueex(hk,'FilesFound',0,reg_dword,@n,4);
regclosekey(hk);
end;
if hf1<>invalid_handle_value then closehandle(hf1);
if hf2<>invalid_handle_value then closehandle(hf2);
if (trunc(el)=100)and(strpos(getcommandline,' /COP')<>nil) then begin
s:=extractfilename(paramstr(2))+'.cop';
if not copyfile(pchar(paramstr(2)),pchar(s),true) then
writeln('CopyError:',syserrormessage(getlasterror))else
writeln(paramstr(2),' copied');
exitprocess(102);
end;
if(paramstr(1)<>paramstr(2))and(trunc(el)=100)and(strpos(getcommandline,' /DEL')<>nil)then begin
if deletefile(Pchar(paramstr(2))) then writeln('File ',paramstR(2),' deleted')else
begin writeln('Couldnt Delete file ',paramstr(2));exitprocess(101);end;
end;
exitprocess(trunc(el));
end;

function ConsoleClose(ctrl:dword):bool;stdcall;
begin
result:=true;
writeln('');
writeln('Scan aborted. Files are about ',Trunc((Datap/dw)*100),
'% same');
if datap/dw>=1 then
closefiles(103) else
closefiles((datap/dw)*100);
end;

function StringInArray(S:AnsiString):pansichar;
var i:integer;
begin
result:=nil;
for i:= 1 to length(data1)-1 do
begin
result:=strpos(@data1[i],PAnsiChar(s));
if result<>nil then exit;
end;
end;

function FindWideString(Const S:String):boolean;
var i:integer;
buff:array[0..2048]of widechar;
begin
stringtowidechar(s,buff,2048);
result:=false;
for i:=0 to fs do
result:=comparemem(@buff,@data1[i],length(s)*2) or result;
end;

function FindBinaryData(bin:pointer;len:integer):boolean;
var i:integer;
begin
result:=false;
for i:= 0 to fs-1 do
result:=comparemem(bin,@data1[i],len)or result;
end;

label samesize;
begin
datap:=0;
if extractfileext(paramstr(2))='.cop' then exitprocess(0);
setlength(data1,1);
setlength(data2,1);
if paramcount<2 then begin
writeln('Usage: ',Extractfilename(paramstr(0)),' file1 file2 [options]');
writeln('Options:');
writeln('/M         Performs a 64kb scan instead of a 1-byte scan.');
writeln('/AE        All bytes in the files must be the same');
writeln('/DEL       Delete file2 if 100% same.');
writeln('/COP       Copies file2 to a .cop file if its the same.');
writeln('/SZ        Ignore file size');
writeln('/TXT       Searches for a ANSI string in a file, file1 will be the string');
Writeln('/TWT       Searches for a unicode string in a file, file1 will be the string');
writeln('/URL       Specifies binary data in urlencode data like the ones used on websites like hello world would look like hello%20world file1 would be where the data is.');
writeln('/TN        file2 is newer. See readme file for information on using time options');
writeln('/TO        file2 is older');
writeln('');
writeln('NOTE COMMAND LINE OPTIONS ARE CASE SENTIVE');
writeln('Errorlevel is a percentage of equalness');
writeln('If files are a 100% same and /DEL Option fails errorlevel is 101');
writeln('If files are a 100% same but /COP option fails the errorlevel is 102');
exitprocess(0);
end;
if strpos(getcommandline,' /URL')<>nil then begin
hf1:=invalid_handle_Value;
s:=httpdecode(paramstr(1));
hf2:=createfile(PChar(Paramstr(2)),generic_read,file_share_Read,nil,open_Existing,
file_attribute_normal,0);
if hf2=invalid_handle_Value then begin writeln(SysErrorMessage(getlasterror));
exitprocess(0);end;
fs:=getfilesize(hf2,nil);
if fs=$FFFFFFFF then begin
writeln(syserrormessage(getlasterror));
closehandle(hf2);
exitprocess(0);
end;
setlength(data1,fs+length(s));
zeromemory(@data1[0],fs+length(s));
readfile(hf2,data1[0],fs,bread,nil);
if FindBinaryData(Pointer(s),length(s))then begin writeln('File ',Paramstr(2),
' contains the binary data');closefiles(100);end;
writeln('File ',paramstr(2),' doesnt contain the binary data');
closefiles(0);
end;
if strpos(getcommandline,' /TWT')<>nil then begin
hf1:=invalid_handle_value;
hf2:=createfile(PChar(Paramstr(2)),generic_read,file_share_Read,nil,open_Existing,
file_attribute_normal,0);
if hf2=invalid_handle_Value then begin writeln(SysErrorMessage(getlasterror));
exitprocess(0);end;
fs:=getfilesize(hf2,nil);
if fs=$FFFFFFFF then begin
writeln(syserrormessage(getlasterror));
closehandle(hf2);
exitprocess(0);
end;
setlength(data1,fs+2048);
zeromemory(@data1[0],fs+2048);
readfile(hf2,data1[0],fs,bRead,nil);
if findwidestring(paramstr(1)) then begin
writeln('The string exists in file ',paramstr(2));
closefiles(100);
end;
writeln('The string doesnt exist in the file');
closefiles(0);
end;
if StrPos(GetCommandline,' /TN')<>nil then
begin
hf1:=invalid_handle_value;
hf2:=createfile(PChar(Paramstr(2)),generic_read,file_share_Read,nil,open_Existing,
file_attribute_normal,0);
if not (getfiletime(hf2,nil,nil,@ft2))then
begin
writeln(syserrormessage(getlasterror));
closefiles(0);
end;
filetimetosystemtime(ft2,st2);
if encodedate(st2.wYear,st2.wMonth,st2.wDay)+encodetime(st2.wHour,st2.wMinute,
0,0)>strtodatetime(paramstr(1))then begin
writeln('File ',paramstr(2),' is newer');
closefiles(100);
end;
writeln('File '+paramstr(2)+' is older');
closefiles(0);
end;
if StrPos(GetCommandline,' /TO')<>nil then
begin
hf1:=invalid_handle_value;
hf2:=createfile(PChar(Paramstr(2)),generic_read,file_share_Read,nil,open_Existing,
file_attribute_normal,0);
if not (getfiletime(hf2,nil,nil,@ft2))then
begin
writeln(syserrormessage(getlasterror));
closefiles(0);
end;
filetimetosystemtime(ft2,st2);
if encodedate(st2.wYear,st2.wMonth,st2.wDay)+encodetime(st2.wHour,st2.wMinute,
0,0)<strtodatetime(paramstr(1))then begin
writeln('File ',paramstr(2),' is older');
closefiles(100);
end;
writeln('File '+paramstr(2)+' is newer');
closefiles(0);
end;
if strpos(getcommandline,' /TXT')<>nil then begin
hf1:=invalid_handle_value;
hf2:=createfile(PChar(Paramstr(2)),generic_read,file_share_Read,nil,open_Existing,
file_attribute_normal,0);
if hf2=invalid_handle_Value then begin writeln(SysErrorMessage(getlasterror));
exitprocess(0);end;
fs:=getfilesize(hf2,nil);
if fs=$FFFFFFFF then begin
writeln(syserrormessage(getlasterror));
closehandle(hf2);
exitprocess(0);
end;
setlength(data1,fs+1);
zeromemory(@data1[0],fs+1);
readfile(hf2,data1[0],fs,bRead,nil);
if stringinarray(paramstr(1))<>nil then begin
writeln('The string exists in file ',paramstr(2));
closefiles(100);
end;
writeln('The string doest exist in the file');
closefiles(0);
end;
hf1:=createfile(PChar(Paramstr(1)),generic_read,file_share_Read,nil,open_Existing,
file_attribute_normal,0);
hf2:=createfile(PChar(Paramstr(2)),generic_read,file_share_Read,nil,open_Existing,
file_attribute_normal,0);
if (hf1=invalid_handle_value)or(hf2=invalid_handle_value) then begin
writeln(SysErrorMessage(getlasterror));
closefiles(0);
end;
if(getfilesize(hf1,nil)=getfilesize(hf2,nil))or(strpos(getcommandline,' /SZ')<>nil)
then goto samesize;
writeln('Files dont have the same size');
closefiles(0);
samesize:
fs:= Max(getfilesize(hf1,nil),getfilesize(hf2,nil));
if fs=$FFFFFFFF then begin
writeln(Syserrormessage(getlasterror));
closefiles(0);
end;
if strpos(getcommandline,' /M')<>nil then begin
setlength(data1,64*1024);
setlength(data2,64*1024);
fs:=fs div length(data1);
if getfilesize(hf1,nil) mod length(data1)>0 then inc(fs);
end;
SetConsoleCtrlHandler(@consoleclose,true);
writeln('Scanning');
//if l=0 then l:=fs;
for dw:=1 to fs do begin
zeromemory(@data1[0],length(data1));
zeromemory(@data2[0],length(data2));
readfile(hf1,data1[0],length(data1),bRead,nil);
readfile(hf2,data2[0],length(data2),bRead,nil);
if comparemem(@data1[0],@data2[0],length(data1)) then begin
write('!');datap:=datap+1;end else write('.');
setconsoletitle(PChar('Compare '+paramstr(1)+#32+paramstr(2)+#32+inttostr(trunc(
(dw/fs)*100))+'%'));
end;
writeln('Scan Complete files are ',trunc((datap/fs)*100),'% same');
{if (strpos(getcom-mandline,' /DEL')<>nil)and(trunc(datap/fs)=1) then begin
closehandle(hf1);
closehandle(hf2);
if deletefile(pchar(paramstr(2))) then writeln('File ',paramstr(2),
' deleted successfully')else
begin writeln(paramstr(2),':',SysErrorMessage(getlasterror));exitprocess(101);end;
exitprocess(100);
end;}
if strpos(getcommandline,' /AE')=nil then
closefiles((datap/fs)*100);
closefiles(Int(datap/fs)*100);
end.

unit xcompareUnit1;
{$RESOURCE XCOMPARE32.RES}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, ComCtrls, ExtCtrls, Tabnotbk,shellapi, Menus, Spin;

type
  TXCompareWND = class(TForm)
    TabbedNotebook1: TTabbedNotebook;
    GroupBox1: TGroupBox;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    RadioGroup1: TRadioGroup;
    GroupBox2: TGroupBox;
    CheckBox1: TCheckBox;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    GroupBox3: TGroupBox;
    Label2: TLabel;
    Edit1: TEdit;
    GroupBox4: TGroupBox;
    Label3: TLabel;
    Button1: TButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    MainMenu1: TMainMenu;
    Start1: TMenuItem;
    GroupBox5: TGroupBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    Label4: TLabel;
    Edit2: TEdit;
    ListBox1: TListBox;
    PopupMenu1: TPopupMenu;
    Open1: TMenuItem;
    Rename1: TMenuItem;
    Delete1: TMenuItem;
    CopyTo1: TMenuItem;
    Properties1: TMenuItem;
    Label8: TLabel;
    Edit3: TEdit;
    Timer1: TTimer;
    SpinEdit1: TSpinEdit;
    Label5: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Label1Click(Sender: TObject);
    procedure Start1Click(Sender: TObject);
    procedure TabbedNotebook1Change(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TCompareLog=record
Filename:array[0..max_path]of char;
percent:real;
end;
var
  XCompareWND: TXCompareWND;
  hk:hkey;
implementation

{$R *.DFM}

procedure TXCompareWND.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
regclosekey(hk);
end;

procedure TXCompareWND.Label1Click(Sender: TObject);
begin
Shellexecute(handle,'explore',Pchar(label1.caption),nil,nil,sw_show);
end;

procedure TXCompareWND.Start1Click(Sender: TObject);
var command:string;
comspec:Array[0..256]of char;
hres:hinst;
begin
if (opendialog1.FileName='')and(radiogroup1.ItemIndex=0) then begin
messagebox(handle,'You must choose a file for the file comparing task.','XCompare',
mb_iconinformation);
exit;
end;
getenvironmentvariable('ComSpec',comspec,256);
command:= '/C for /R "'+label1.Caption+'" %f in ('+edit3.Text+') do "'+
extractfilepath(application.ExeName)+'compare.exe"';
case radiogroup1.ItemIndex of
0:begin
command:=command+#32+opendialog1.FileName+' "%f"';
if radiobutton2.Checked then command:=command+' /M /AE';
if checkbox4.Checked then command:=command+' /SZ';
end;
1:command:=command+' "'+edit1.Text+'" "%f" /TXT';
2:command:=command+' "'+edit1.Text+'" "%f" /TWT';
3:command:=command+' "'+edit1.Text+'" "%f" /URL';
4:if checkbox1.Checked then command:=command+' "'+datetimetostr(
datetimepicker1.DateTime+datetimepicker2.DateTime)+'" "%f" /TN' else
command:=command+' "'+datetimetostr(datetimepicker1.DateTime+
datetimepicker2.DateTime)+'" "%f" /TO';
end;
if checkbox2.Checked then command:=command+' /DEL';
if checkbox3.checked then command:=command+' /COP';
command:=command+' /X';
tabbednotebook1.PageIndex:=2;
RegDeleteKey(hkey_current_user,'Software\Justin\XCompare\Temp');
if edit2.Text='' then
hres:=shellexecute(handle,nil,comspec,pchar(command),nil,sw_show)else
hres:=shellexecute(handle,nil,comspec,pchar(command),pchar(edit2.text),sw_show);
if hres<33 then
case hres of
0:messagebox(handle,'Out of memory',comspec,mb_iconerror);
error_file_not_found:messagebox(handle,'File not found',comspec,
mb_iconerror);
error_path_not_found:messagebox(handle,'Path not found',comspec,mb_iconerror);
error_bad_format:messagebox(handle,'File is corrupt',comspec,mb_iconerror);
se_err_accessdenied:messagebox(handle,'Access is denied',comspec,mb_iconerror);
else messagebox(handle,PChar('There was a problem executing the command prompt.'+
'Code:'+inttostr(hres)),comspec,mb_iconerror);
end;
timer1.Enabled:=(hres>32);
end;

procedure TXCompareWND.TabbedNotebook1Change(Sender: TObject;
  NewTab: Integer; var AllowChange: Boolean);
begin
//allowchange:=(newtab<>2);
end;

procedure TXCompareWND.Button1Click(Sender: TObject);
begin
opendialog1.Execute;
label3.Caption:='File selected: '+opendialog1.FileName;
end;

procedure TXCompareWND.Timer1Timer(Sender: TObject);
var i:integer;
cl:tcomparelog;
hk:hkey;
rs,ff,dummy1:dword;
begin
listbox1.Items.Clear;
regcreatekeyex(hkey_current_user,'Software\Justin\XCompare\Temp',0,'XCompareLog',
REG_OPTION_VOLATILE,key_all_access,nil,hk,@dummy1);
ff:=0;rs:=4;
regqueryvalueex(hk,'FilesFound',nil,nil,@ff,@rs);
for i:=1 to ff do
begin
rs:=sizeof(cl);
if regqueryvalueex(hk,pchar(inttostr(i)),nil,nil,@cl,@rs)=error_success then
if cl.percent>=spinedit1.Value then listbox1.Items.Add(cl.filename);
end;
regclosekey(hk);
end;

procedure TXCompareWND.FormCreate(Sender: TObject);
begin
RegDeleteKey(hkey_current_user,'Software\Justin\XCompare\Temp');
tabbednotebook1.PageIndex:=0;
end;

end.