アプリケーション インターフェイスに「Transfer Rate : XGb p\min」機能を追加しようとしています。Lazarus 1.2.2 と Freepascal 2.6.4 を使用してミリ秒レベルで計算しています。
ディスクから 64Kb ブロックを読み取り、各 64Kb ブロックを処理し、ディスク全体が読み取られるまで、またはユーザーが中止ボタンをクリックするまで繰り返すループがあります。64Kb の各読み取りにかかる時間を計り、1 分あたりのデータ読み取りの平均速度、つまり「1 分あたり 3Gb」を計算しようとしています。
標準時間をミリ秒単位で計算する「GetTimeInMilliseconds」というカスタム関数があります。
また、インターフェイスがミリ秒単位で更新されるのを避けるために、インターフェイスがループの 50 回ごとにのみ更新されるようにするカウンターがあります。つまり、64Kb チャンクが 50 回読み取られると、カウンターは 0 にリセットされます。
問題は、転送表示が表示されないか、RAID0 デバイスの「234Mb p\min」のような不正確な数字が表示されることです! それ以外の場合は、「3.4Gb p\min」のようにより現実的なものになります。同じ PC と同じディスクで繰り返し実行した場合、一貫して正確である必要があり、一貫して不正確ではありません。
これが、ループを実行する Try...finally ループです。また、整数サイズを計算して XMb、XGb、XTb などに変換するカスタム関数である FormatByteSize とも呼ばれます。
var
ProgressCounter, BytesTransferred, BytesPerSecond : integer;
Buffer : array [0..65535] of Byte; // 65536, 64Kb buffer
ctx : TSHA1Context;
Digest : TSHA1Digest;
NewPos, ExactDiskSize, SectorCount, TimeStartRead, TimeEndRead,
MillisecondsElapsed, BytesPerMillisecond, BytesPerMinute : Int64;
StartTime, EndTime, TimeTaken : TDateTime;
...
begin
... // Various stuff related to handles on disks etc
try
SHA1Init(ctx);
FileSeek(hSelectedDisk, 0, 0);
repeat
ProgressCounter := ProgressCounter + 1; // We use this update the progress display occasionally, instead of every buffer read
TimeStartRead := GetTimeInMilliSeconds(Time); // Starting time, in Ms
// The hashing bit...
FileRead(hSelectedDisk, Buffer, 65536); // Read 65536 = 64kb at a time
NewPos := NewPos + SizeOf(Buffer);
SHA1Update(ctx, Buffer, SizeOf(Buffer));
FileSeek(hSelectedDisk, NewPos, 0);
lblBytesLeftToHashB.Caption := IntToStr(ExactDiskSize - NewPos) + ' bytes, ' + FormatByteSize(ExactDiskSize - NewPos);
// End of the hashing bit...
TimeEndRead := GetTimeInMilliSeconds(Time);; // End time in Ms
MillisecondsElapsed := (TimeEndRead - TimeStartRead); // Record how many Ms's have elapsed
// Only if the loop has gone round a while (50 times?), update the progress display
if ProgressCounter = 50 then
begin
if (TimeStartRead > 0) and (TimeEndRead > 0) and (MillisecondsElapsed > 0) then // Only do the divisions and computations if all timings have computed to a positive number
begin
BytesTransferred := SizeOf(Buffer);
BytesPerMillisecond := BytesTransferred DIV MilliSecondsElapsed; // BytesPerMillisecond if often reported as zero, even though BytesTRansferred and MilliSecondsElapsed are valid numbers? Maybe this is the fault?
BytesPerSecond := BytesPerMillisecond * 1000; // Convert the bytes read per millisecond into bytes read per second
BytesPerMinute := BytesPerSecond * 60; // Convert the bytes read per second into bytes read per minute
lblSpeedB.Caption := FormatByteSize(BytesPerMinute) + ' p\min'; // now convert the large "bytes per minute" figure into Mb, Gb or Tb
// Reset the progress counters to zero for another chunk of looping
ProgressCounter := 0;
BytesPerMillisecond := 0;
BytesPerSecond := 0;
BytesPerMinute := 0;
ProgressCounter := 0;
end;
end;
Application.ProcessMessages;
until (NewPos >= ExactDiskSize) or (Stop = true); // Stop looping over the disk
// Compute the final hash value
SHA1Final(ctx, Digest);
lblBytesLeftToHashB.Caption:= '0';
finally
// The handle may have been released by pressing stop. If not, the handle will still be active so lets close it.
if not hSelectedDisk = INVALID_HANDLE_VALUE then CloseHandle(hSelectedDisk);
EndTime := Now;
TimeTaken := EndTime - StartTime;
lblEndTimeB.Caption := FormatDateTime('dd/mm/yy hh:mm:ss', EndTime);
if not stop then edtComputedHash.Text := SHA1Print(Digest);
Application.ProcessMessages;
...
Function GetTimeInMilliSeconds(theTime : TTime): Int64;
// http://www.delphipages.com/forum/archive/index.php/t-135103.html
var
Hour, Min, Sec, MSec: Word;
begin
DecodeTime(theTime,Hour, Min, Sec, MSec);
Result := (Hour * 3600000) + (Min * 60000) + (Sec * 1000) + MSec;
end;
例：
Form1.Caption := IntToStr( GetTimeInMilliSeconds(Time) );