I use Lazarus 1.2.4 and Freepascal 2.6.4.
I have created a program that reads a disk in buffers of 64Kb (tried various buffer sizes) using a repeat...until loop. Each buffer is hashed using the SHA1 unit, specifically, SHA1Init, SHA1Update and SHA1Final.
The trouble is, is that although it works and the hashes always match that computed by other tools that do the same job, my program is not as fast. On a specific workstation with an 80Gb disk attached, it reads and hashes at about 1.8Gb per minute, and this is as a result of some enhanced compiler directives (and using specific optimisations offered by the Lazarus\FPC compiler). Before those tweaks, it was just 1.22Gb p\min as an average. The other tools do it at about 2.5Gb+ a minute (around 45Mb a second) and some are faster than that.
If I remove the hashing element and just do the disk reading, it reads at about 4Gb per minute, so I am fairly sure my loop structure is actually fairly quick. So I'm almost certain the bottleneck is the hashing aspect and this has been discussed at the Lazarus forum, here where it has been suggested that maybe the library needs to be improved a little for better speed. One poster suggested I re-write the three functions in assembly but I am not that good.
There is a related post HERE regarding SHA256, where the gentlemen concerned experienced similar issues, though with a different language. His implementation was very similar to mine - Init, Update, Final. One suggestion was to use a buffer of 16Mb in that post. I have tried 4Kb, 8Kb, 64Kb, 256Kb, 512Kb and 1Mb. I haven't gone to 16Mb or anywhere near that - might that prove to be worthwhile? I read that once you go above about 1Mb programs usually go backward?
Is there an obvious way to improve speed?
I have included only the relevant parts in the hope it will make the task easier to read.
// Main parts of my code responsible for loop. // The SHA1 functions from the SHA1 Freepascal unit follow hSelectedDisk := CreateFileW(PWideChar(DiskName), FILE_READ_DATA, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0); // please note I have also tried FILE_FLAG_NO_BUFFER but that made no apparant difference // We need the exact disk size in bytes to know when to stop reading ExactDiskSize := GetDiskLengthInBytes(hSelectedDisk); SectorCount := ExactDiskSize DIV 512; // Now read the disk FROM START TO END and hash it until completion or the user aborts it 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 := Now; // The hashing bit...read the disk in buffers, hash each buffer and then // finalise the finished hash. If there's a read error, abort. // Step 1 : Check we are not at the end of the disk where bytes remaining // could be less than the size of the buffer if (ExactDiskSize - TotalBytesRead) < SizeOf(Buffer) then begin BytesRead := FileRead(hSelectedDisk, Buffer, (ExactDiskSize - TotalBytesRead)); // Read 65535 or less bytes end else begin BytesRead := FileRead(hSelectedDisk, Buffer, SizeOf(Buffer)); // Read 65536 (64kb) at a time end; if BytesRead = -1 then begin ShowMessage('There was a read error encountered. Aborting'); exit; end else // Step 2 : No read errors, so now we hash ... // Update positions, update hash sequence, and update GUI begin inc(TotalBytesRead, BytesRead); NewPos := NewPos + BytesRead; SHA1Update(ctx, Buffer, BytesRead); lblBytesLeftToHashB.Caption := IntToStr(ExactDiskSize - NewPos) + ' bytes, ' + FormatByteSize(ExactDiskSize - NewPos); until (TotalBytesRead = ExactDiskSize) or (Stop = true); // Compute the final hash value SHA1Final(ctx, Digest); lblHash.Caption := SHA1Print(Digest); end; end; // End of main looping cycle. Following code is the FPC procedures procedure SHA1Init(out ctx: TSHA1Context); begin FillChar(ctx, sizeof(TSHA1Context), 0); ctx.State := $67452301; ctx.State := $efcdab89; ctx.State := $98badcfe; ctx.State := $10325476; ctx.State := $c3d2e1f0; end; procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt); var Src: PByte; Num: PtrUInt; begin if BufLen = 0 then Exit; Src := @Buf; Num := 0; // 1. Transform existing data in buffer if ctx.BufCnt > 0 then begin // 1.1 Try to fill buffer up to block size Num := 64 - ctx.BufCnt; if Num > BufLen then Num := BufLen; Move(Src^, ctx.Buffer[ctx.BufCnt], Num); Inc(ctx.BufCnt, Num); Inc(Src, Num); // 1.2 If buffer is filled, transform it if ctx.BufCnt = 64 then begin SHA1Transform(ctx, @ctx.Buffer); ctx.BufCnt := 0; end; end; // 2. Transform input data in 64-byte blocks Num := BufLen - Num; while Num >= 64 do begin SHA1Transform(ctx, Src); Inc(Src, 64); Dec(Num, 64); end; // 3. If there's less than 64 bytes left, add it to buffer if Num > 0 then begin ctx.BufCnt := Num; Move(Src^, ctx.Buffer, Num); end; end; const PADDING: array[0..63] of Byte = ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ); procedure SHA1Final(var ctx: TSHA1Context; out Digest: TSHA1Digest); var Length: QWord; Pads: Cardinal; begin // 1. Compute length of the whole stream in bits Length := 8 * (ctx.Length + ctx.BufCnt); // 2. Append padding bits if ctx.BufCnt >= 56 then Pads := 120 - ctx.BufCnt else Pads := 56 - ctx.BufCnt; SHA1Update(ctx, PADDING, Pads); // 3. Append length of the stream (8 bytes) Length := NtoBE(Length); SHA1Update(ctx, Length, 8); // 4. Invert state to digest Invert(@ctx.State, @Digest, 20); FillChar(ctx, sizeof(TSHA1Context), 0); end;