[Source Delphi] MultiCore checksum generator

Code:

---

{*******************************************************}
{                                                      }
{      Main.exe checksum generator                    }
{                                                      }
{      Copyright © 2011 Gunz  @ www.cheats.lv        }
{                                                      }
{*******************************************************}

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.

---

get OmniThreadLibrary at : omnithreadlibrary - Revision 881: /trunk

Results on generating checksum with dual core cpu:

Code:

---

Parallel Loop: 1024; finished in: 26723;
Loop: 1025; finished in: 47003;

---

quad core:

Code:

---

Parallel Loop: 1024; finished in: 6375;
Loop: 1025; finished in: 12157;

---

Parallel functions for delphi developers is something new :) so i coded this checksum generator to test it.. its need some small fixes though nothing hard here :)

Approved ;)

Thanks for it

Does this checksum work on the new season 6 korean mains?
Because they changed some shits in there.

There is no changes in algorythm