Initial commitv0.6.36release-0.6.36-dev

1 files changed, 475 insertions, 0 deletions

diff --git a/UChecksum.pas b/UChecksum.pas
new file mode 100644
index 0000000..895f7ec
--- /dev/null
+++ b/UChecksum.pas
@@ -0,0 +1,475 @@
+(*
+    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
+  glib2, gdk2, gtk2, SysUtils, Types, Classes, Variants, GTKControls, GTKForms, GTKStdCtrls, GTKExtCtrls, GTKConsts, 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, Libc, UCore, DateUtils;
+
+type TFileListItem = class
+       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 := 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;
+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 and (not SFVPresent) and (CommentTextView.TextBuffer.LineCount = 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_RETURN, GDK_KP_ENTER: ModalResult := mbOK;
+    GDK_ESCAPE: ModalResult := mbCancel;
+  end; }
+end;
+
+function TFChecksum.ProcessFile(FileName: string): boolean;
+const ChksumBlockSize = 32768;  //  Maximum of PByteArray
+var FD: TEngineFileDes;
+    Error, Count, i, Start: integer;
+    Buffer: Pointer;
+    s: string;
+    Stat: PDataItemSL;
+    IsMD5: boolean;
+begin
+  Result := False;
+  Stat := Engine.GetFileInfoSL(FileName);
+  if (Stat.Size > 128*1024) then begin
+    i := integer(Application.MessageBox(Format(LANGTheFileSYouAreTryingToOpenIsQuiteBig, [ANSIToUTF8(ExtractFileName(FileName))]), [mbYes, mbNo], mbWarning, mbNone, mbNo));
+    if (i = integer(mbNo)) or (i = 251) then Exit;
+  end;
+  IsMD5 := (Pos('MD5', ANSIUpperCase(FileName)) > 0) or ((Pos('SFV', ANSIUpperCase(FileName)) = 0) and (Pos('SUM', ANSIUpperCase(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 := Libc.malloc(ChksumBlockSize);
+    Libc.memset(Buffer, 0, ChksumBlockSize);
+  except
+    Application.MessageBox(LANGAnErrorOccuredWhileInitializingMemoryBlock, [mbOK], mbError, mbNone, mbOK);
+    Exit;
+  end;
+  FD := Engine.OpenFile(FileName, omRead, Error);
+  if Error <> 0 then begin
+    Application.MessageBox(Format(LANGAnErrorOccuredWhileOpeningFileSS, [ANSIToUTF8(ExtractFileName(FileName)), ANSIToUTF8(GetErrorString(Error))]), [mbOK], mbError, mbNone, mbOK);
+    Libc.free(Buffer);
+    Exit;
+  end;
+  s := '';
+  CommentOpen := True;
+  repeat
+    Count := Engine.ReadFile(FD, Buffer, ChksumBlockSize, Error);
+    if Error <> 0 then begin
+      Application.MessageBox(Format(LANGAnErrorOccuredWhileReadingFileSS, [ANSIToUTF8(ExtractFileName(FileName)), ANSIToUTF8(GetErrorString(Error))]), [mbOK], mbError, mbNone, mbOK);
+      Engine.CloseFile(FD);
+      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);
+  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: PDataItemSL;
+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 + Chr($2212);
+        CommentTextView.TextBuffer.InsertText(s1 + #13);
+      end;
+    end;
+    CommentTextView.TextBuffer.InsertText(ANSIToUTF8(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.GetFileInfoSL(Item.FullPath);
+    if Assigned(Stat) then Item.Size := Stat.Size
+                      else Item.Size := 0;
+    List.Add(Item);
+    ListItem := FileList.Items.Add;
+    ListItem.Data := Item;
+    if not Application.GTKVersion_2_0_5_Up then ListItem.SetValue(0, 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
+  if not Application.GTKVersion_2_0_5_Up then gtk_tree_model_get(tree_model, iter, 0, @Data, -1)
+  else begin
+    Path := gtk_tree_model_get_path(tree_model, iter);
+    if not Assigned(Path) then Exit;

+    (Sender as TGTKListView).ConvertPathToChild(Path);

+    Data := List[gtk_tree_path_get_indices(Path)^];

+    gtk_tree_path_free(Path);

+  end;

+  case gtk_tree_view_column_get_sort_column_id(tree_column) of
+    0: g_object_set(cell, 'text', PChar(Format('[%s] %s', [StatusStr[Data.Status], ANSIToUTF8(Data.Name)])), nil);
+    -1: if not Data.IsMD5 then g_object_set(cell, 'text', PChar('0x' + IntToHex(Data.CRC, 8)), nil)
+                          else g_object_set(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;
+  if not Application.GTKVersion_2_0_5_Up then begin
+    gtk_tree_model_get(model, a, 0, @Data1, -1);
+    gtk_tree_model_get(model, b, 0, @Data2, -1);
+  end else begin
+    Path := gtk_tree_model_get_path(model, a);
+    if not Assigned(Path) then Exit;

+    Data1 := 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 := List[gtk_tree_path_get_indices(Path)^];

+    gtk_tree_path_free(Path);
+  end;  
+  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, Error, Count: integer;
+    FD: TEngineFileDes;
+    Buffer: Pointer;
+    MaxSize, OldPos: Int64;
+    Data: TFileListItem;
+    Time1, Time2: TDateTime;
+    CRC: LongWord;
+    MD5Hash: THash_MD5;
+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 := Libc.malloc(ChksumBlockSize);
+    Libc.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 := List[i];
+    CRC := $FFFFFFFF;
+    MD5Hash := nil;
+    if Data.IsMD5 then MD5Hash := THash_MD5.Create;
+    FD := Engine.OpenFile(Data.FullPath, omRead, Error);
+    if Error <> 0 then begin
+      Data.Status := 3;
+      Continue;
+    end;
+    repeat
+      Count := Engine.ReadFile(FD, Buffer, ChksumBlockSize, Error);
+      if Error <> 0 then begin
+        Data.Status := 3;
+        Engine.CloseFile(FD);
+        Continue;
+      end;
+      if not Data.IsMD5 then CRC := CRC32(CRC, Buffer, Count)
+                        else MD5Hash.Calc(Buffer^, Count);
+      ProgressBar.Value := ProgressBar.Value + Count;
+      ProgressBar.Text := Format('%d %%', [Trunc(ProgressBar.Fraction * 100)]);
+      Application.ProcessMessages;
+    until (Count < ChksumBlockSize) or Stop;
+    if Stop then Break;
+    Engine.CloseFile(FD);
+    if not Data.IsMD5 then Data.Status := Ord(not ((not CRC) = Data.CRC)) + 1 else begin
+      MD5Hash.Done;
+      Data.Status := Ord(AnsiCompareText(Data.MD5, MD5Hash.GetKeyStrH) <> 0) + 1;
+      MD5Hash.Free;
+    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 StatLabel.Caption := LANGChecksumInterrupted else begin
+    Error := 0;
+    if List.Count > 0 then
+      for i := 0 to List.Count - 1 do
+        if TFileListItem(List[i]).Status <> 1 then Inc(Error);
+    StatLabel.Caption := Format(LANGChecksumDOK, [Round(100 * (List.Count - Error) / List.Count)]); 
+  end;
+  StatLabel.UseMarkup := True;
+  Stop := False;
+  Processing := False;
+  ActionArea.SetFocus;
+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
+         (AnsiCompareText(Trim(PDataItem(DataList[i])^.AName), ExtractFileName(FileName)) = 0) then
+      begin
+        PDataItem(DataList[i])^.Selected := True;
+        AListView.Items[i].RedrawRow;
+      end;
+end;
+
+end.
+