// WT, WTS и start/stoptime для подсчета времени - заменить как кому нравится......
uses System.Threading, System.SyncObjs, System.IOUtils;
type RecMD5uint64 = record
MD5Hi: uint64;
MD5Lo: uint64;
end;
type
TDataSection = record
Data: TBytes;
MD5: RecMD5uint64;
PRuleN: uint32;
NumBlock: byte;
BtLen: word; //byte;
SectUse: byte;
end;
..........
// TForm1 //
public
FDDataSect: TArray<TArray<TDataSection>>;
OutFDDataSect: TArray<TArray<TDataSection>>;
Ts2OutFDDataSect: TArray<TArray<TDataSection>>;
FindResult: integer;
TasksEnd: TBytes;
...........
procedure CreateTasksV2(DataArr, RuleArr:TArray<TArray<TDataSection>>; min, max: uint32; Pn: uint32; PNTask: byte; PtasksEnd: TBytes; var Wtasks: TArray<ITask>);
begin
Wtasks[PNTask] := TTask.Create(procedure()
var
PNumRule: uint32;
PnBt: uint32;
N1arr: array[0..2] of uint64; // calc xor sect
N2arr: array[0..2] of uint64;
NOutarr: array[0..2] of uint64;
n1arrB: array[0..23] of byte absolute n1arr;
n2arrB: array[0..23] of byte absolute n2arr;
nOutarrB: array[0..23] of byte absolute nOutarr;
BsectSet: set of byte;
OutxorArr: TBytes;
PacLenSect: uint32;
Px: uint32;
SectLen: uint32;
MinLenUse: uint32;
begin
Px := 0;
SectLen := 24;
MinLenUse := 12;
for PNumRule := min to max do begin
setlength(OutxorArr, 24);
Move((Pointer(DataArr[Px,Pn].Data))^, n1arrB[0], 24);
Move((Pointer(RuleArr[Px,PNumRule].Data))^, n2arrB[0], 24);
NOutarr[0] := N1arr[0] xor N2arr[0];
NOutarr[1] := N1arr[1] xor N2arr[1];
NOutarr[2] := N1arr[2] xor N2arr[2];
Move(nOutarrB, (Pointer(OutxorArr))^, 24);
// tmp1 := CalcSectByteLen3T4(tmp);
PacLenSect := 0;
BsectSet := [];
for PnBt := 0 to SectLen - 1 do begin
if OutxorArr[PnBt] in BSectSet = false then begin
include(BSectSet, OutxorArr[PnBt]);
inc(PacLenSect, 1);
end;
end;
if (PacLenSect <= MinLenUse) then begin
PtasksEnd[PNTask] := 1;
if PNTask = 1 then begin
PacLenSect := 1;
end;
end;
end;
end);
end;
procedure TForm1.Button7Click(Sender: TObject);
var
Tasks: TArray<ITask>;
task: ITask;
FStart, FEnd: uint32;
FSectCount, FSectLen: uint32;
FTrNum: uint32;
FIn: TMemoryStream;
NLoadRule, x, n: uint32;
wt, wts, oldwts: RecTime;
Ndata, Nrule: uint32;
nresfind, nresnofind: uint32;
s: string;
NumRule: uint32;
SectLen: uint32;
OutFDLen: uint32;
MinLenUse: uint32;
NMinLen, allFindNMinLen: uint32;
PacLen: uint32;
FS: tstringlist;
TaskRes: uint32;
TasksecLen, TasksecLenEnd: uint32;
BTasksEnd: uint32;
Zt: uint32;
begin
starttime(wt);
x := 0;
SectLen := 24;
MinLenUse := 12;
NMinLen := 0;
allFindNMinLen := 0;
setlength(FDDataSect, 0); // clear
setlength(OutFDDataSect, 0); // clear
FIn := TMemoryStream.Create;
FIn.LoadFromFile(Memo1.Lines[0]);
FIn.Seek(0, soBeginning);
NLoadRule := FIn.Size div 24;
setlength(FDDataSect, x + 1);
setlength(FDDataSect[x], NLoadRule);
for n := 0 to NLoadRule - 1 do begin
setlength(FDDataSect[x,n].Data, 24);
FIn.ReadData(FDDataSect[x,n].Data, 24);
end;
FIn.Free;
setlength(OutFDDataSect, x + 1);
OutFDLen := length(OutFDDataSect[x]);
if OutFDLen = 0 then begin
Setlength(OutFDDataSect[x], OutFDlen + 1);
OutFDDataSect[x, OutFDLen] := FDDataSect[x, 0];
end;
Ndata := length(FDDataSect[x]);
PBar1.Max := Ndata;
TaskRes := 0;
starttime(wts);
for n := 0 to Ndata - 1 do begin // WORK
NLoadRule := length(OutFDDataSect[x]);
setlength(Tasks, 0);
setlength(TasksEnd, 0);
// создаем потоки
if NLoadRule <= 1000 then begin // 1 potok
setlength(Tasks, 1);
setlength(TasksEnd, 1);
for BTasksEnd := 0 to Length(tasksEnd) - 1 do tasksEnd[BTasksEnd] := 0;
// procedure CreateTasksV2(DataArr, RuleArr:TArray<TArray<TDataSection>>; min, max: uint32; Pn: uint32; PNTask: byte;
// var PtasksEnd: TBytes; var Wtasks: TArray<ITask>);
CreateTasksV2(FDDataSect, OutFDDataSect, 0, NLoadRule -1, n, 0, TasksEnd, tasks);
end;
if NLoadRule > 1000 then begin
setlength(Tasks, 4);
setlength(TasksEnd, 4);
for BTasksEnd := 0 to Length(tasksEnd) - 1 do tasksEnd[BTasksEnd] := 0;
TasksecLen := NLoadRule div 4;
TasksecLenEnd := NLoadRule - TasksecLen;
CreateTasksV2(FDDataSect, OutFDDataSect, 0, TasksecLen - 1, n, 0, TasksEnd, Tasks);
CreateTasksV2(FDDataSect, OutFDDataSect, TasksecLen, (TasksecLen * 2) - 1, n, 1, TasksEnd, Tasks);
CreateTasksV2(FDDataSect, OutFDDataSect, (TasksecLen * 2), (TasksecLen * 3) - 1 , n, 2, TasksEnd, Tasks);
CreateTasksV2(FDDataSect, OutFDDataSect, (TasksecLen * 3), NLoadRule - 1 , n, 3, TasksEnd, Tasks);
end;
FindResult := 0;
for BTasksEnd := 0 to Length(tasksEnd) - 1 do tasksEnd[BTasksEnd] := 0;
for task in tasks do
task.Start;
FindResult := 0;
// for BTasksEnd := 0 to Length(tasksEnd) - 1 do tasksEnd[BTasksEnd] := 0;
//Ждём выполнение всех задач.
TTask.WaitForAll(tasks);
FindResult := 0;
for BTasksEnd := 0 to Length(tasksEnd) - 1 do begin
if tasksEnd[BTasksEnd] = 1 then FindResult := 1;;
end;
if (FindResult > 0) then begin
inc(NMinLen, 1);
end;
if (FindResult = 0) and (n > 0) then begin
OutFDLen := length(OutFDDataSect[x]);
Setlength(OutFDDataSect[x], OutFDlen + 1);
OutFDDataSect[x, OutFDLen] := FDDataSect[x, n];
inc(allFindNMinLen, 1);
end;
if (n mod 1000) = 0 then begin
PBar1.Position := n;
stoptime(wts);
oldwts.start := wts.stop - wts.start;
s := DecodeRecTime(oldwts);
oldwts.stop := oldwts.start;
memo1.Lines.Add(n.ToString +' '+ s +' '+ DecodeRecTime(wts));
application.ProcessMessages;
starttime(wts);
end;
end;
stoptime(wt);
memo1.Lines.Add(Zt.ToString + ' Dup '+ NMinLen.ToString +' Add '+ allFindNMinLen.ToString +' '+ DecodeRecTime(wt));
Memo1.Lines.SaveToFile('LogTime');
end;