x-MU.net форум

{*******************************************************}
{                                                      }
{      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.

OmniThreadLibrary
https://omnithreadlibrary.googlecode.com/svn/trunk
DUAL CORE
Parallel Loop: 1024; finished in: 26723;
Loop: 1025; finished in: 47003;

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


Ps.
Dev потому что непроверял

копи паст десвеевского кода

Ну дезвей если что то он писал на MFC))) а здесь делфятина.

Кстати догадываюсь кто такой АндИксОр =))

Правда пока что по технологиям достаточно не плох мой   . Он конечно с закрытым исходняком но там юзается только ВинАпи + мнопроцессорная обработка + оптимизирован сам алгоритм.

/index.php?topic=10154.0

Цитата: Goodlike от 2010 Дек. 31, 10:48  копи паст десвеевского кода

чего?! Что вы курите?
Оригинал бил создан мною! релиз "As is OpenSource" зделал на RZ. Вчера переписал на MultiCore!

Copy/Paste - делают моему коду лоллоллоллоллол )))!

Цитата: Killbrum от 2010 Дек. 31, 12:19  Правда пока что по технологиям достаточно не плох мой   . Он конечно с закрытым исходняком но там юзается только ВинАпи + мнопроцессорная обработка + оптимизирован сам алгоритм.

/index.php?topic=10154.0

Да, но у вас походу  .NET )

Цитата: Killbrum от 2010 Дек. 31, 11:19  Ну дезвей если что то он писал на MFC))) а здесь делфятина.

ошибся именем хД

Цитата: Killbrum от 2010 Дек. 31, 11:19  Кстати догадываюсь кто такой АндИксОр =))

я тоже  (smirk)
подпись

ЦитироватьMauka, Gunz, LieRingDelphi, AndOrXor, 6748222 (Человек номер!) ето сцуко всё я ))))

А вот и оригинал, кстати: https://forum.ragezone.com/f197/delphi-sour...hecksum-703997/

 
рад тебя видеть на х-му, дружище!!!
ждем твоего лаунчера хД

Цитата: AndOrXor от 2010 Дек. 31, 11:19  Да, но у вас походу  .NET )

Неее... онли натив. На интерпретаторах не того ... =))

Цитата: 8BitCore от 2010 Дек. 31, 11:40  я тоже  (smirk)
подпись

Да, я просто не увидел =)

Цитата: Killbrum от 2010 Дек. 31, 16:53  Неее... онли натив. На интерпретаторах не того ... =))

Ну вот опять плевок в сторону .net

Или "тру" пишут только на С++ ?

А 4й фрейм и его System.Threading ? С++ в многопоточности отсосет на раз-два.

Мало чего зависит от языка, главное - алгоритм.