CheckSum.dat文件生成源码

unit uChecksum;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OtlParallel, OtlCommon, StdCtrls;

type
  TForm28 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Open: TOpenDialog;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
 TDWORDS = array[0..1024] of Cardinal;

var
  Form28: TForm28;

implementation

uses
  Generics.Collections, OtlCollections;

{$R *.dfm}

function GetChecksum(Buffer: TBytes; Size: Cardinal; Key: Cardinal): Cardinal;
var
 i: Cardinal;
 FKey: Cardinal;
 FResult: Cardinal;
begin
 i := 0;
 FResult := Key shl 9;
 while i <= (Size - 4) do
  begin
   FKey := PDWORD(@Buffer[i])^;
   case ((( i shr 2 ) + Key) mod 3 ) of
    0: FResult := FResult xor FKey;
    1: FResult := FResult + FKey;
    2: FResult := (FResult shl (FKey mod 11)) xor FKey;
   end;
    if (i mod 4) = 0 then
      FResult := FResult xor (Key + FResult) shr ((i shr 2) mod 16 + 3);
   inc(i,4);
  end;
 Result := FResult;
end;

procedure TForm28.Button1Click(Sender: TObject);
var
 Fs: TStream;
 Buffer: TBytes;
 FResult: TDWORDS;
 numCores, i: integer;
 StartTime: Cardinal;
begin
 if Open.Execute then
  begin
   numCores := Environment.Process.Affinity.Count;

   try
    Fs := TFileStream.Create(Open.FileName,fmOpenRead);
     try
      SetLength(Buffer,Fs.Size);
      Fs.ReadBuffer(Buffer[0],Length(Buffer));
     finally
      Fs.Free;
     end;

     Fs := TFileStream.Create(ExtractFilePath(Open.FileName)+'checksum.dat',fmCreate or fmShareExclusive);
      try
       i := 1024;
       StartTime := GetTickCount;
       Parallel.ForEach(0, i).NumTasks(numCores).Execute
      (
       procedure(const elem: integer)
        begin
        FResult[elem] := GetChecksum(Buffer,Length(Buffer),elem);
       end
      );
      Fs.Write(FResult,Length(FResult));
      finally
       Fs.Free;
      end;

    Memo1.Lines.Add(Format(Parallel Loop: %d; finished in: %d;',[i, (GetTickCount - StartTime)]));
   except
    on E: Exception do
     MessageDlg('Error: '+E.Message, mtError, [mbOK], 0);
   end;
  end;
end;

procedure TForm28.Button2Click(Sender: TObject);
var
 Fs: TStream;
 Buffer: TBytes;
 i: Integer;
 FResult: TDWORDS;
 StartTime: Cardinal;
begin
 if Open.Execute then
  begin
   try
   Fs := TFileStream.Create(Open.FileName,fmOpenRead);
    try
     SetLength(Buffer,Fs.Size);
     Fs.ReadBuffer(Buffer[0],Length(Buffer));
    finally
     Fs.Free;
    end;
    StartTime := GetTickCount;
    Fs := TFileStream.Create(ExtractFilePath(Open.FileName)+'Main.dat',fmCreate or fmShareExclusive);
     try
       for i := 0 to 1024 do
        begin
         FResult[i] := GetChecksum(Buffer,Length(Buffer),i);
        end;
      Fs.Write(FResult,Length(FResult));
     finally
      Fs.Free;
     end;

    Memo1.Lines.Add(Format('Loop: %d; finished in: %d;',[i, (GetTickCount - StartTime)]));
   except
    on E: Exception do
     begin
      MessageDlg('Error: '+E.Message, mtError, [mbOK], 0);
      Exit;
     end;
   end;
  end;
end;

end.