path: root/UChecksum.pas

(*
    Tux Commander - UChecksum - Checksum dialog
    Copyright (C) 2004 Tomas Bzatek <tbzatek@users.sourceforge.net>
    Check for updates on tuxcmd.sourceforge.net

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)
unit UChecksum;

interface

uses
  SysUtils, Classes, lazglib2, lazgobject2, lazgtk3, lazpango1, GTKControls, GTKForms, GTKStdCtrls, GTKExtCtrls, GTKView, GTKText,
  UEngines;

type
  TFChecksum = class(TGTKDialog)
    BottomBox, HBox: TGTKHBox;
    CheckButton: TGTKButton;
    ProgressBar: TGTKProgressBar;
    HPaned: TGTKHPaned;
    FileList: TGTKListView;
    CommentTextView: TGTKTextView;
    FileListScrolledWindow, CommentTextViewScrolledWindow: TGTKScrolledWindow;
    StatLabel: TGTKLabel;
    procedure FormCreate(Sender: TObject); override;
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; Key: Word; Shift: TShiftState; var Accept: boolean);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormResponse(Sender: TObject; const ResponseID: integer);
    procedure FormShow(Sender: TObject);
    procedure CheckButtonClick(Sender: TObject);
  private
    MD5Present, SFVPresent, CommentOpen, Processing, Stop: boolean;
    procedure ConstructViews;
    procedure ProcessLine(s, Path: string; const IsMD5: boolean);
    procedure ListViewCellDataFunc(Sender: TObject; tree_view: PGtkTreeView; tree_column : PGtkTreeViewColumn; cell : PGtkCellRenderer; tree_model : PGtkTreeModel; iter : PGtkTreeIter);
    function CompareFunc(Sender: TObject; var model: PGtkTreeModel; var a, b: PGtkTreeIter): integer;
    procedure GoProcess;
    procedure MarkAsBad(const FileName: string);
  public
    Engine: TPanelEngine;
    DataList: TList;
    AListView: TGTKListView;
    List: TList;
    function ProcessFile(FileName: string): boolean;
  end;

var
  FChecksum: TFChecksum;

implementation

uses ULocale, UCoreUtils, ULibc, UCore, UError, DateUtils, md5, crc;

type TFileListItem = class
       public
         CRC: LongWord;
         MD5: string;
         Name, FullPath: string;
         Status: byte;
         IsMD5: boolean;
         Size: Int64;
     end;


procedure TFChecksum.FormCreate(Sender: TObject);
begin
  WindowTypeHint := whNormal;
  List := TList.Create;
  MD5Present := False;
  SFVPresent := False;
  CommentOpen := False;
  Processing := False;
  Stop := False;
  OnDestroy := @FormDestroy;
  SetDefaultSize(750, 350);
  Caption := LANGVerifyChecksumsCaption;
  Buttons := [mbClose];
  StatLabel := TGTKLabel.Create(Self);
  StatLabel.Caption := LANGChecksumNotChecked;
  StatLabel.UseMarkup := True;
  BottomBox := TGTKHBox.Create(Self);
  BottomBox.Homogeneous := False;
  CheckButton := TGTKButton.Create(Self);
  CheckButton.Caption := LANGCheckButtonCaptionCheck;
  CheckButton.SetSizeRequest(90, -1);
  ProgressBar := TGTKProgressBar.Create(Self);
  ProgressBar.Text := '0 %';
  BottomBox.AddControlEx(StatLabel, False, False, 5);
  BottomBox.AddControlEx(ProgressBar, True, True, 5);
  BottomBox.AddControlEx(CheckButton, False, False, 5);
  HBox := TGTKHBox.Create(Self);
  HPaned := TGTKHPaned.Create(Self);
  ConstructViews;
  FileListScrolledWindow := TGTKScrolledWindow.Create(Self);
  FileListScrolledWindow.HorizScrollBarPolicy := sbAutomatic;
  FileListScrolledWindow.VertScrollBarPolicy := sbAutomatic;
  FileListScrolledWindow.ShadowType := stShadowIn;
  FileListScrolledWindow.AddControl(FileList);
  CommentTextViewScrolledWindow := TGTKScrolledWindow.Create(Self);
  CommentTextViewScrolledWindow.HorizScrollBarPolicy := sbAutomatic;
  CommentTextViewScrolledWindow.VertScrollBarPolicy := sbAutomatic;
  CommentTextViewScrolledWindow.ShadowType := stShadowIn;
  CommentTextViewScrolledWindow.AddControl(CommentTextView);
  HPaned.Child1 := FileListScrolledWindow;
  HPaned.Child2 := CommentTextViewScrolledWindow;
  ClientArea.AddControlEx(HPaned, True, True, 3);
  ClientArea.AddControlEx(BottomBox, False, True, 0);
  OnKeyDown := @FormKeyDown;
  OnCloseQuery := @FormCloseQuery;
  OnResponse := @FormResponse;
  OnShow := @FormShow;
  CheckButton.OnClick := @CheckButtonClick;

  if CheckButton.Enabled then CheckButton.SetFocus
                         else ActionArea.SetFocus;
end;

procedure TFChecksum.ConstructViews;
var Column: TGTKTreeViewColumn;
    i: integer;
begin
  FileList := TGTKListView.CreateTyped(Self, True, [lcPointer]);
  FileList.SelectionMode := smSingle;
  FileList.Tooltip := LANGFileListTooltip;
  FileList.CellDataFunc := @ListViewCellDataFunc;
  FileList.CompareFunc := @CompareFunc;
  FileList.RulesHint := True;
  Column := FileList.Columns.Add;
  Column.Caption := LANGFilenameColumnCaption;
  Column.FixedWidth := 350;
  Column.SortID := 0;
  Column := FileList.Columns.Add;
  Column.Caption := 'CRC-32';
  Column.FixedWidth := 80;
  for i := 1 to 2 do begin
    FileList.Columns[i - 1].SizingMode := smAutoSize; // smFixed;
    FileList.Columns[i - 1].Resizable := True;
    FileList.Columns[i - 1].SetProperty('ypad', 0);
    FileList.Columns[i - 1].SetProperty('yalign', 0.5);
  end;
  CommentTextView := TGTKTextView.Create(Self);
  CommentTextView.ReadOnly := True;
  CommentTextView.CursorVisible := True;
// TODO  gtk_widget_modify_font(CommentTextView.FWidget, pango_font_description_from_string('Monospace'))
end;

procedure TFChecksum.FormDestroy(Sender: TObject);
var i: integer;
begin
  Application.ProcessMessages;
  try
    if List.Count > 0 then
      for i := 0 to List.Count - 1 do
        TFileListItem(List[i]).Free;
    List.Free;
  except end;
end;

procedure TFChecksum.FormShow(Sender: TObject);
begin
  CheckButton.Enabled := FileList.Items.Count > 0;
  if MD5Present or {(not SFVPresent) and} (CommentTextView.TextBuffer.CharCount < 1)
    then HPaned.Position := Width - 90;
end;

procedure TFChecksum.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Stop := True;
end;

procedure TFChecksum.FormResponse(Sender: TObject; const ResponseID: integer);
begin
  Stop := True;
end;

procedure TFChecksum.FormKeyDown(Sender: TObject; Key: Word; Shift: TShiftState; var Accept: boolean);
begin
{  case Key of
    GDK_KEY_Return, GDK_KEY_KP_Enter: ModalResult := mbOK;
    GDK_KEY_Escape: ModalResult := mbCancel;
  end; }
end;

function TFChecksum.ProcessFile(FileName: string): boolean;
const ChksumBlockSize = 32768;  //  Maximum of PByteArray
var FD: TEngineFileDes;
    Count, i, Start: integer;
    Buffer: Pointer;
    s: string;
    Stat: PDataItem;
    IsMD5: boolean;
    Error: PGError;
begin
  Result := False;
  Error := nil;
  Stat := Engine.GetFileInfo(FileName, True, True, @Error);
  if Stat = nil then begin
    if Error <> nil then begin
      ShowError(Self, Format('An error occured while opening file ''%s''', [StrToUTF8(ExtractFileName(FileName))]), Error);
      g_error_free(Error);
    end;
    Exit;
  end;
  if (Stat <> nil) and (Stat^.Size > 128*1024) then begin
    i := integer(Application.MessageBox(Format(LANGTheFileSYouAreTryingToOpenIsQuiteBig, [StrToUTF8(ExtractFileName(FileName))]), [mbYes, mbNo], mbWarning, mbNone, mbNo));
    FreeDataItem(Stat);
    if (i = integer(mbNo)) or (i = 251) then Exit;
  end;
  IsMD5 := (Pos('MD5', WideUpperCase(ExtractFileName(FileName))) > 0) or ((Pos('SFV', WideUpperCase(ExtractFileName(FileName))) = 0) and (Pos('SUM', WideUpperCase(ExtractFileName(FileName))) > 0));
  if IsMD5 then MD5Present := True
           else SFVPresent := True;
  if MD5Present and SFVPresent then FileList.Columns[1].Caption := 'CRC32/MD5'
  else if MD5Present then FileList.Columns[1].Caption := 'MD5 sum'
  else if SFVPresent then FileList.Columns[1].Caption := 'CRC-32';

  try
    Buffer := malloc(ChksumBlockSize);
    memset(Buffer, 0, ChksumBlockSize);
  except
    Application.MessageBox(LANGAnErrorOccuredWhileInitializingMemoryBlock, [mbOK], mbError, mbNone, mbOK);
    Exit;
  end;
  FD := Engine.OpenFile(FileName, omRead, @Error);
  if FD = nil then begin
    if Error <> nil then begin
      ShowError(Self, Format('An error occured while opening file ''%s''', [StrToUTF8(ExtractFileName(FileName))]), Error);
      g_error_free(Error);
    end;
    libc_free(Buffer);
    Exit;
  end;
  s := '';
  CommentOpen := True;
  repeat
    Count := Engine.ReadFile(FD, Buffer, ChksumBlockSize, @Error);
    if Error <> nil then begin
      ShowError(Self, Format('An error occured while reading file ''%s''', [StrToUTF8(ExtractFileName(FileName))]), Error);
      g_error_free(Error);
      Engine.CloseFile(FD, nil);
      libc_free(Buffer);
      Exit;
    end;
    //  processing begins
    Start := 1;
    if Count > 0 then
      for i := 0 to Count - 1 do
        if (PByteArray(Buffer)^[i] in [13, 10]) or (i = Count - 1) then begin
          s := s + Copy(PChar(Buffer), Start, i - Start + 1 + Ord(i = Count - 1));
          Start := i + 2;
          if PByteArray(Buffer)^[i] in [13, 10] then begin
            ProcessLine(s, ExtractFilePath(FileName), IsMD5);
            s := '';
          end;
        end;
    // processing ends
  until Count < ChksumBlockSize;
  if Length(s) > 0 then ProcessLine(s, ExtractFilePath(FileName), IsMD5);

  CommentOpen := False;
  Engine.CloseFile(FD, nil);
  libc_free(Buffer);
  Result := True;
end;

procedure TFChecksum.ProcessLine(s, Path: string; const IsMD5: boolean);
var Item: TFileListItem;
    ListItem: TGTKListItem;
    S1, S2: string;
    i: integer;
    Stat: PDataItem;
begin
  TrimCRLFESC(s);
  if Length(s) < 1 then Exit;
  if s[1] = ';' then begin
    if CommentOpen then begin
      CommentOpen := False;
      if CommentTextView.TextBuffer.LineCount > 1 then begin
        s1 := '';
        for i := 1 to 50 do s1 := s1 + '-'  {  TODO Chr($2212) };
        CommentTextView.TextBuffer.InsertText(StrToUTF8(s1 + #13));
      end;
    end;
    CommentTextView.TextBuffer.InsertText(StrToUTF8(Copy(s, 2, Length(s) - 1) + #13));
  end else begin
    Trim(s);
    if Pos(' ', s) = 0 then Exit;
    Item := TFileListItem.Create;
    Item.Status := 0;
    Item.IsMD5 := IsMD5;
    if not IsMD5 then begin   //  CRC32
      s1 := Trim(Copy(s, 1, LastDelimiter(' ', s) - 1));
      s2 := Trim(Copy(s, LastDelimiter(' ', s) + 1, Length(s) - LastDelimiter(' ', s)));
      try
        Item.CRC := StrToInt64('$' + s2);
      except
        Exit;
      end;
      Item.Name := ExtractFileName(s1);
      Item.FullPath := IncludeTrailingPathDelimiter(Path) + s1;
    end else begin   //  MD5
      s1 := Trim(Copy(s, 1, Pos(' ', s) - 1));
      s2 := Trim(Copy(s, Pos(' ', s) + 1, Length(s) - Pos(' ', s)));
      try
        Item.MD5 := LowerCase(s1);
      except
        Exit;
      end;
      s2 := ExcludeTrailingPathDelimiter(s2);
      if Pos('/', s2) > 0 then s2 := Copy(s2, LastDelimiter('/', s2) + 1, Length(s2) - LastDelimiter('/', s2)); 
      Item.Name := ExtractFileName(s2);
      Item.FullPath := IncludeTrailingPathDelimiter(Path) + s2;
    end;
    Stat := Engine.GetFileInfo(Item.FullPath, True, True, nil);
    if Assigned(Stat) then begin
      Item.Size := Stat^.Size;
      FreeDataItem(Stat);
    end else Item.Size := 0;
    List.Add(Item);
    ListItem := FileList.Items.Add;
    ListItem.Data := Item;
  end;
end;

procedure TFChecksum.ListViewCellDataFunc(Sender: TObject; tree_view: PGtkTreeView; tree_column : PGtkTreeViewColumn; cell : PGtkCellRenderer; tree_model : PGtkTreeModel; iter : PGtkTreeIter);
const StatusStr : array[0..3] of string = ('?', 'OK', 'BAD', 'N/A');
var Data: TFileListItem;
    Path: PGtkTreePath;
begin
  Path := gtk_tree_model_get_path(tree_model, iter);
  if not Assigned(Path) then Exit;
  (Sender as TGTKListView).ConvertPathToChild(Path);
  Data := TFileListItem(List[gtk_tree_path_get_indices(Path)^]);
  gtk_tree_path_free(Path);
  case gtk_tree_view_column_get_sort_column_id(tree_column) of
    0: g_object_set(PGObject(cell), 'text', [StrToUTF8(PChar(Format('[%s] %s', [StatusStr[Data.Status], Data.Name]))), nil]);
    -1: if not Data.IsMD5 then g_object_set(PGObject(cell), 'text', [PChar('0x' + IntToHex(Data.CRC, 8)), nil])
                          else g_object_set(PGObject(cell), 'text', [PChar(Data.MD5), nil]);
  end;
end;

function TFChecksum.CompareFunc(Sender: TObject; var model: PGtkTreeModel; var a, b: PGtkTreeIter): integer;
var Data1, Data2: TFileListItem;
    Path: PGtkTreePath;
begin
  Result := 0;
  Path := gtk_tree_model_get_path(model, a);
  if not Assigned(Path) then Exit;
  Data1 := TFileListItem(List[gtk_tree_path_get_indices(Path)^]);
  gtk_tree_path_free(Path);
  Path := gtk_tree_model_get_path(model, b);
  if not Assigned(Path) then Exit;
  Data2 := TFileListItem(List[gtk_tree_path_get_indices(Path)^]);
  gtk_tree_path_free(Path);
  if (Sender as TGTKView).SortColumnID = 0 then Result := CompareTextsEx(PChar(Data1.Name), PChar(Data2.Name));
end;

procedure TFChecksum.CheckButtonClick(Sender: TObject);
begin
  if not Processing then GoProcess
                    else Stop := True;
end;

procedure TFChecksum.GoProcess;
const ChksumBlockSize = 65536*4;
var i, ErrNum, Count: integer;
    FD: TEngineFileDes;
    Buffer: Pointer;
    MaxSize, OldPos: Int64;
    Data: TFileListItem;
    Time1, Time2: TDateTime;
    CRC: LongWord;
    MDContext: TMDContext;
    MDDigest: TMDDigest;
    Error: PGError;
begin
  if List.Count = 0 then Exit;
  CheckButton.Caption := LANGCheckButtonCaptionStop;
  Stop := False;
  Processing := True;
  UnselectAll(AListView, DataList);
  StatLabel.Caption := LANGChecksumChecking;
  StatLabel.UseMarkup := True;

  MaxSize := 0;
  OldPos := 0;  
  for i := 0 to List.Count - 1 do Inc(MaxSize, TFileListItem(List[i]).Size);
  ProgressBar.Max := MaxSize;
  ProgressBar.Value := 0;
  Application.ProcessMessages;
  try
    Buffer := malloc(ChksumBlockSize);
    memset(Buffer, 0, ChksumBlockSize);
  except
    Application.MessageBox(LANGAnErrorOccuredWhileInitializingMemoryBlock, [mbOK], mbError, mbNone, mbOK);
    Exit;
  end;

  Time1 := Now;
  for i := 0 to List.Count - 1 do begin
    if Stop then Break;
    if i > 0 then Inc(OldPos, TFileListItem(List[i - 1]).Size);
    ProgressBar.Value := OldPos;
    ProgressBar.Text := Format('%d %%', [Trunc(ProgressBar.Fraction * 100)]);
    FileList.Items[i].Selected := True;
    FileList.Items[i].SetCursor(0, False, False, 0, 0);
    Application.ProcessMessages;
    Data := TFileListItem(List[i]);
    CRC := 0;
    if Data.IsMD5 then MDInit(MDContext, MD_VERSION_5);
    Error := nil;
    FD := Engine.OpenFile(Data.FullPath, omRead, @Error);
    if Error <> nil then begin
      Data.Status := 3;
      g_error_free(Error);
      Continue;
    end;
    repeat
      Error := nil;
      Count := Engine.ReadFile(FD, Buffer, ChksumBlockSize, @Error);
      if Error <> nil then begin
        Data.Status := 3;
        g_error_free(Error);
        Engine.CloseFile(FD, nil);
        Break;
      end;
      if not Data.IsMD5 then CRC := CRC32(CRC, Buffer, Count)
                        else MDUpdate(MDContext, Buffer^, Count);
      ProgressBar.Value := ProgressBar.Value + Count;
      ProgressBar.Text := Format('%d %%', [Trunc(ProgressBar.Fraction * 100)]);
      Application.ProcessMessages;
    until (Count < ChksumBlockSize) or Stop;
    Engine.CloseFile(FD, nil);
    if Stop then Break;
    if not Data.IsMD5 then Data.Status := Ord(not (CRC = Data.CRC)) + 1 else begin
      MDFinal(MDContext, MDDigest);
      Data.Status := Ord(AnsiCompareText(Data.MD5, MDPrint(MDDigest)) <> 0) + 1;
    end;
    if Data.Status in [2, 3] then MarkAsBad(Data.FullPath);
  end;
  Time2 := Now;
  DebugMsg([Format('Checksum processing: %d:%3d = %.3f MB/s', [SecondOf(Time2 - Time1), MillisecondOf(Time2 - Time1),
                                                             (MaxSize / (SecondOf(Time2 - Time1) + MillisecondOf(Time2 - Time1) / 1000)) / (1024 * 1024)])]);
  FileList.Items[List.Count - 1].RedrawRow;
  libc_free(Buffer);
  ProgressBar.Fraction := 1;
  CheckButton.Caption := LANGCheckButtonCaptionCheck;
  if Stop then begin
    StatLabel.Caption := LANGChecksumInterrupted;
    CheckButton.SetFocus;
  end else begin
    ErrNum := 0;
    if List.Count > 0 then
      for i := 0 to List.Count - 1 do
        if TFileListItem(List[i]).Status <> 1 then Inc(ErrNum);
    StatLabel.Caption := Format(LANGChecksumDOK, [Round(100 * (List.Count - ErrNum) / List.Count)]);
    ActionArea.SetFocus;
  end;
  StatLabel.UseMarkup := True;
  Stop := False;
  Processing := False;
end;

procedure TFChecksum.MarkAsBad(const FileName: string);
var i: integer;
begin
  if DataList.Count > 0 then
    for i := 0 to DataList.Count - 1 do
      if (not PDataItem(DataList[i])^.IsDir) and (not PDataItem(DataList[i])^.UpDir) and
         (WideCompareText(Trim(PDataItem(DataList[i])^.FDisplayName), ExtractFileName(FileName)) = 0) then
      begin
        PDataItem(DataList[i])^.Selected := True;
        AListView.Items[i].RedrawRow;
      end;
end;

end.