📄 screenfilecheck.pas
字号:
DriveComboBox.Drive := SaveDrive;
TMyDirectoryListBox(DirectoryListBox).BuildList;
{$IFDEF DEBUG}
CASE Msg.Event OF
$8000: s := 'Device Arrival ';
$8004: s := 'Device Gone ';
ELSE s := 'Device Change (' + IntToStr(Msg.Event) + ')';
END;
p := Msg.dwData;
s := s + ', size = ' + IntToStr(p^.dbcv_size);
s := s + ', devicetype = ' + IntToStr(p^.dbcv_devicetype);
s := s + ', reserved = ' + IntToHex(p^.dbcv_reserved,8);
s := s + ', unitmask = ' + IntToStr(p^.dbcv_unitmask);
s := s + ', flags = ' + IntToStr(p^.dbcv_flags);
MemoErrorLog.Lines.Add(s);
{$ENDIF}
Msg.Result := 1
END {WmDeviceChange};
procedure TFormFileList.BitBtnPrintLogClick(Sender: TObject);
VAR
i : INTEGER;
iFromLeft: INTEGER;
jDelta : INTEGER;
jFromTop : INTEGER;
Memo : TMemo;
begin
CASE (Sender AS TBitBtn).Tag OF
1: Memo := MemoScanLog;
2: Memo := MemoVerifyLog;
ELSE Memo := NIL; // should never happen; avoid compiler warning
END;
IF Memo.Lines.Count > 0 // avoid blank pages if nothing to print
THEN BEGIN
Printer.BeginDoc;
TRY
Printer.Canvas.Font.Name := 'Arial';
Printer.Canvas.Font.Height :=
MulDiv(GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY), 8 {point}, 72);
Printer.Canvas.Font.Style := [];
iFromLeft := MulDiv(Printer.PageWidth, 2, 100); // 2% from left
jFromTop := MulDiv(Printer.PageHeight, 2, 100); // 2% from top
jDelta := Printer.Canvas.TextHeight('X');
FOR i := 0 TO Memo.Lines.Count-1 DO
BEGIN
Printer.Canvas.TextOut(iFromLeft, jFromTop, Memo.Lines[i]);
INC(jFromTop, jDelta)
END;
FINALLY
Printer.EndDoc
END
END
end;
procedure TFormFileList.SpeedButtonVerifyVerifyListClick(Sender: TObject);
begin
OpenDialog.Filename := EditVerifyCRCVerifyFile.Text;
IF OpenDialog.Execute
THEN EditVerifyCRCVerifyFile.Text := OpenDialog.Filename
end;
// In general, separate, local variables are used in this method in case
// scanning and verifying is occurring at the same time.
procedure TFormFileList.BitBtnVerifyFileClick(Sender: TObject);
TYPE
TDirectoryMode = (dmFilesAndDirectories, dmOnlyDirectories);
VAR
AllByteCount : TInteger8;
AllCRC32 : DWORD;
AllDirCount : INTEGER;
AllFileCount : INTEGER;
CRCTemp : DWORD;
CRCValueHex : STRING;
DirByteCount : TInteger8;
DirCRC32 : DWORD;
DirFileCount : INTEGER;
DirectoryMode : TDirectoryMode;
Error : WORD;
ErrorCount : INTEGER;
FileCRCvalue : DWORD;
FileBytes : TInteger8;
Line : STRING;
LineCount : INTEGER;
MismatchCount : INTEGER;
StartTime : DWORD;
VerifyFile : TextFile;
PROCEDURE ParseAndProcessLine;
VAR
Code : CHAR;
DirCountString : STRING;
DirectoryName : STRING;
FileBytesString: STRING;
FileCountString: STRING;
FileName : STRING;
MetaCRCValueHex: STRING;
SumBytesString : STRING;
Tokens : TTokens;
BEGIN
IF LENGTH(Line) > 0
THEN BEGIN
// Tokenize each line for convenience
// Quotes were used to enclose any filename/directory name with
// embedded blanks
Tokens := TTokens.Create(Line, ' ', '"', '"', #$00, FALSE);
TRY
Code := Line[1]; // Should be same as Tokens.Token(1)
// Use '//' as comments in these files only in column 1-2
IF (LENGTH(Line) >= 2) AND ( (Line[1] <> '/') OR (Line[2] <> '/') )
THEN BEGIN
CASE Code OF
'*': BEGIN
// For now, this statement sets "OnlyDirectories" mode which
// was used during scanning. This means separate 'F' records
// will NOT exist before encountering a 'D' record.
DirectoryMode := dmOnlyDirectories;
END;
'D': BEGIN
// Directory: D SumBytes MetaCRC DirName FileCount
// Token: 1 2 3 4 5
// Cannot use INC on COMPs in D3
AllByteCount := AllByteCount + DirByteCount;
INC (AllDirCount, 1);
INC (AllFileCount, DirFileCount);
// Use Strings instead of comparing COMPs in D3
SumBytesString := FormatFloat(FormatBytesString, DirByteCount);
FileCountString := Format('%d', [DirFileCount]);
MetaCRCValueHex := IntToHex(NOT DirCRC32,8);
DirectoryName := Tokens.Token(4);
IF (SumBytesString <> Tokens.Token(2)) OR
(MetaCRCValueHex <> Tokens.Token(3)) OR
(FileCountString <> Tokens.Token(5))
THEN BEGIN
INC(MismatchCount);
MemoVerifyLog.Lines.Add('Directory ' + DirectoryName + ' does NOT match.');
MemoVerifyLog.Lines.Add(' OldBytes = ' + Tokens.Token(2) +
', NewBytes = ' + SumBytesString);
MemoVerifyLog.Lines.Add(' OldFileCount = ' + Tokens.Token(5) +
', NewFileCount = ' + FileCountString);
MemoVerifyLog.Lines.ADd(' OldMetaCRC = ' + Tokens.Token(3) +
', NewMetaCRC = ' + MetaCRCValueHex)
END;
DirByteCount := 0;
DirCRC32 := $FFFFFFFF;
DirFileCount := 0;
END;
'F': BEGIN
// File: F Bytes CRC FileName
// Token 1 2 3 4
FileName := Tokens.Token(4);
LabelVerifyFileName.Caption := 'Filename: ' + FileName;
CalcFileCRC32 (FileName, FileCRCvalue, FileBytes, Error);
IF Error <> 0 // Ignore errors
THEN BEGIN
INC (ErrorCount);
MemoVerifyLog.Lines.Add(IntToStr(ErrorCount) + '. ' + 'Error Code ' +
IntToStr(Error) +
' reading file ' + FileName);
FileCRCValue := 0; // but make CRC-32 predictable
END;
CRCValueHex := IntToHex(FileCRCvalue, 8);
// Use Strings instead of comparing COMPs in D3
FileBytesString := FormatFloat(FormatBytesString, FileBytes);
IF (FileBytesString <> Tokens.Token(2)) OR
(CRCValueHex <> Tokens.Token(3))
THEN BEGIN
INC(MismatchCount);
MemoVerifyLog.Lines.Add('File ' + FileName + ' does NOT match.');
MemoVerifyLog.Lines.Add(' OldBytes = ' + Tokens.Token(2) +
', NewBytes = ' + FileBytesString +
', OldCRC = ' + Tokens.Token(3) +
', NewCRC = ' + CRCValueHex)
END;
// Update Directory "CRC"
CRCTemp := DirCRC32;
CalcCRC32 (@CRCValueHex[1], Length(CRCValueHex), CRCTemp); // 1 Apr 2001
DirCRC32 := CRCTemp;
// Update All "CRC"
CRCTemp := AllCRC32;
CalcCRC32 (@CRCValueHex[1], Length(CRCValueHex), CRCTemp); // 1 Apr 2001
AllCRC32 := CRCTemp;
DirByteCount := DirByteCount + FileBytes;
INC (DirFileCount);
// Any file resets this mode. Should only happen if "Append"
// is used in a Scan with a switch between Files and Directories
// Scan Details.
DirectoryMode := dmFilesAndDirectories;
END;
'P': BEGIN
// Path: P PrefixPath
// Do nothing with the path for now
END;
'S': BEGIN
// Summary: S SumBytes MetaCRC FileCount DirCount
// Token: 1 2 3 4 5
// Use Strings instead of comparing COMPs in D3
SumBytesString := FormatFloat(FormatBytesString, AllByteCount);
DirCountString := Format('%d', [AllDirCount]);
FileCountString := Format('%d', [AllFileCount]);
MetaCRCValueHex := IntToHex(NOT AllCRC32,8);
IF (SumBytesString <> Tokens.Token(2)) OR
(MetaCRCValueHex <> Tokens.Token(3)) OR
(FileCountString <> Tokens.Token(4)) OR
(DirCountString <> Tokens.Token(5))
THEN BEGIN
INC (MismatchCount);
MemoVerifyLog.Lines.Add('Summary does not match.');
MemoVerifyLog.Lines.Add(' OldBytes = ' + Tokens.Token(2) +
', NewBytes = ' + SumBytesString);
MemoVerifyLog.Lines.Add(' OldFileCount = ' + Tokens.Token(4) +
', NewFileCount = ' + FileCountString);
MemoVerifyLog.Lines.Add(' OldDirCount = ' + Tokens.Token(5) +
', NewDirCount = ' + DirCountString);
MemoVerifyLog.Lines.Add(' OldMetaCRC = ' + Tokens.Token(3) +
', NewMetaCRC = ' + MetaCRCValueHex);
END;
IF MismatchCount = 0
THEN MemoVerifyLog.Lines.Add('Everything Matches: Files, Directories, Summary');
AllByteCount := 0;
AllCRC32 := $FFFFFFFF;
AllDirCount := 0;
AllFileCount := 0;
MismatchCount := 0;
END;
'V': BEGIN
// Do nothing with a volume record for now
END;
ELSE
// Do nothing with other records (for now)
END
END
FINALLY
Tokens.Free
END
END
END {ParseAndProcessLine};
begin
MemoVerifyLog.Lines.Clear;
IF FileExists(EditVerifyCRCVerifyFile.Text)
THEN BEGIN
AnimateVerify.Active := TRUE;
AnimateVerify.Visible := TRUE;
BitBtnCancelVerify.Enabled := TRUE;
TRY
MemoVerifyLog.Lines.Add('Verifying CRCs in file ' + EditVerifyCRCVerifyFile.Text + ' ...');
AssignFile(VerifyFile, EditVerifyCRCVerifyFile.Text);
Reset(VerifyFile);
// Count lines in file to use in progress bar
LineCount := 0;
ErrorCount := 0;
WHILE NOT EOF(VerifyFile) DO
BEGIN
READLN(VerifyFile, Line);
INC(LineCount);
END;
CloseFile(VerifyFile);
Reset(VerifyFile);
ContinueVerify := TRUE;
// These initializations are here in case there is a corruption of the
// CRC file.
AllByteCount := 0;
AllCRC32 := $FFFFFFFF;
AllDirCount := 0;
AllFileCount := 0;
DirByteCount := 0;
DirCRC32 := $FFFFFFFF;
DirFileCount := 0;
MismatchCount := 0;
ProgressBar.Position := 0;
ProgressBar.Max := LineCount;
ProgressBar.Visible := TRUE;
LineCount := 0;
StartTime := GetTickCount;
WHILE (NOT EOF(VerifyFile)) AND ContinueVerify DO
BEGIN
READLN(VerifyFile, Line);
ParseAndProcessLine;
// Update elapsed time after every line is processed
LabelVerifyElapsedTime.Caption := Format('%.1f', [0.001*(GetTickCount-StartTime)]);
INC(LineCount);
ProgressBar.Position := LineCount;
Application.ProcessMessages; // all cancel click to register
END;
CloseFile(VerifyFile);
MemoVerifyLog.Lines.Add('Verify time = ' + LabelVerifyElapsedTime.Caption +
' sec (' +
FormatDateTime('d mmm yyyy h:nn:ss', Now) + ')');
ProgressBar.Visible := FALSE;
FINALLY
AnimateVerify.Active := FALSE;
AnimateVerify.Visible := FALSE;
BitBtnCancelVerify.Enabled := FALSE
END
END
ELSE MemoVerifyLog.Lines.Add('Cannot find file ' + EditVerifyCRCVerifyFile.Text)
end;
procedure TFormFileList.BitBtnCancelVerifyClick(Sender: TObject);
begin
ContinueVerify := FALSE
end;
procedure TFormFileList.RadioGroupShowClick(Sender: TObject);
begin
// For now, FORCE no CRCs if Directories only selected
IF RadioGroupShow.ItemIndex = 0
THEN CheckBoxCRCClick(Sender);
end;
procedure TFormFileList.LabelLabURL2Click(Sender: TObject);
begin
ShellExecute(0, 'open', pchar('http://www.efg2.com/lab'),
NIL, NIL, SW_NORMAL)
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -