(* Tux Commander - UChecksum - Checksum dialog Copyright (C) 2004 Tomas Bzatek 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, pango, 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, ULibc, 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; 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 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, [StrToUTF8(ExtractFileName(FileName))]), [mbYes, mbNo], mbWarning, mbNone, mbNo)); if (i = integer(mbNo)) or (i = 251) then Exit; end; IsMD5 := (Pos('MD5', WideUpperCase(FileName)) > 0) or ((Pos('SFV', WideUpperCase(FileName)) = 0) and (Pos('SUM', WideUpperCase(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; Error := 0; FD := Engine.OpenFile(FileName, omRead, Error); if Error <> 0 then begin Application.MessageBox(Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(ExtractFileName(FileName)), 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, [StrToUTF8(ExtractFileName(FileName)), 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(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.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', StrToUTF8(PChar(Format('[%s] %s', [StatusStr[Data.Status], 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 := 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 := List[i]; CRC := $FFFFFFFF; MD5Hash := nil; if Data.IsMD5 then MD5Hash := THash_MD5.Create; Error := 0; 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 (WideCompareText(Trim(PDataItem(DataList[i])^.FDisplayName), ExtractFileName(FileName)) = 0) then begin PDataItem(DataList[i])^.Selected := True; AListView.Items[i].RedrawRow; end; end; end.