Witam. Napisałem taką konsolówkę co ma obrabiac baze danych z txt tzn z kilku plików txt powiedzmy po parę MB skleić jeden, zrobić lowecase :D otyrać regexpem czy się zgadza z standardami, posortować i wywalić duplikaty...
wszystko pięknie śmiga poza wątkami, nie wiem czemu ale nie odpalają się równolegle tylko jeden po drugim tzn. jeden skończy prace włącza się drugi i nic nie robi i zamyka się tak jak bym go tam nie potrzebnie włożył. Siedzę nad tym 2h i nie mam pomysłu więc jak by ktoś mnie powiedział co ja źle robię
program dbem;
{$APPTYPE CONSOLE}
uses Messages, Windows, RegExpr, SysUtils, Classes;
const
REGEXPRESSION = '[a-zA-Z]:[\d]'; // marny expr ale do testów zdaje egzamin (Imie Nazwisko:PESEL)
Threads = 2;
type TThreadChecker = class(TThread)
TableID, TableCount, ID:Cardinal;
Data:String;
TID:Byte;
protected
procedure Execute;
public
constructor Create(ThreadID:Byte);
private
procedure NextTable;
end;
type TTRegExpr = class(TThread)
ID:Cardinal;
Data:String;
R:TRegExpr;
TID:Byte;
protected
procedure Execute;
public
constructor Create(ThreadID:Byte);
private
procedure GetData;
procedure SetData;
end;
var
DB, ALL : TStringList;
TBL : array[0..255] of TStringList;
D,I,X : Cardinal;
Found : Integer;
Path : String;
F : TSearchRec;
RE: array of TTRegExpr;
TC: array of TThreadChecker;
//Nie śmiać się ale nie mogłem sobie przypomnieć jak się zapisywało liczbę z zerem wiodącym :D
function PrepareZeros(Value,Count:Integer):String;
var I:Integer;
begin
Result:='';
for I := 1 to (Count - Length(IntToStr(Value))) do Result:=Result+'0';
Result:=Result+IntToStr(Value);
end;
constructor TTRegExpr.Create(ThreadID: Byte);
begin
inherited Create(True);
TID:=ThreadID;
WriteLn('Create ',TID,' Thread');
end;
procedure TTRegExpr.Execute;
begin
WriteLn('Run ',TID,' Thread');
FreeOnTerminate := True;
Synchronize(GetData);
R:=TRegExpr.Create;
while ID < D do begin
Data:=ALL.Strings[ID];
R.Expression:=REGEXPRESSION;
R.ModifierG;
if R.Exec(Data) then begin
Data:=R.Match[0];
Synchronize(SetData);
end;
Synchronize(GetData);
end;
WriteLn('End ',TID,' Thread');
end;
procedure TTRegExpr.GetData;
begin
ID:=I;INC(I);
end;
procedure TTRegExpr.SetData;
begin
DB.Add(Data); ALL.Strings[ID]:='';
end;
constructor TThreadChecker.Create(ThreadID: Byte);
begin
inherited Create(True);
TID:=ThreadID;
WriteLn('Create ',TID,' Thread');
end;
procedure TThreadChecker.Execute;
var Exists:Boolean; Z:Cardinal;
begin
WriteLn('Run ',TID,' Thread');
FreeOnTerminate := True;
NextTable;
while I < 256 do begin
while ID < TableCount do begin
Exists:=False;
for Z := ID+1 to TableCount - 1 do begin
if TBL[TableID].Strings[ID] = TBL[TableID].Strings[Z] then begin
Exists:=True;
Break;
end;
end;
if Exists = False then ALL.Add(TBL[TableID].Strings[ID]);
INC(ID);
end;
Synchronize(NextTable);
end;
WriteLn('End ',TID,' Thread');
end;
procedure TThreadChecker.NextTable;
begin
INC(I);
if (TBL[I-1].Count = 0) AND (I<256) then NextTable else begin
ID:=0;
TableID:=I-1;
TableCount:=TBL[I-1].Count;
WriteLn('Prepare table ',I,' of ',255);
end;
end;
begin
try
Path:=ParamStr(1);
WriteLn(Path);
ReadLN;
Writeln('Start');
DB:=TStringList.Create;
ALL:=TStringList.Create;
for I := 0 to 255 do TBL[I]:=TStringList.Create;
Found := FindFirst(Path+'*', faAnyFile, F);
while Found = 0 do begin
if (F.Name<>'.') and (F.Name<>'..') then begin
DB.LoadFromFile(Path+F.Name);
WriteLn('Form ',F.Name,' load ',DB.Count,' records');
for I := 0 to DB.Count - 1 do if POS('@',DB.Strings[I]) > 0 then ALL.Add(LowerCase(DB.Strings[I]));
DB.Clear;
end;
Found := FindNext(F);
end;
ALL.SaveToFile(ExtractFilePath(ParamStr(0))+'~tmp0.txt');
WriteLn('Save temp data with ',ALL.Count,' records');
I:=0;
D:=ALL.Count;
SetLength(RE,Threads);
for X := 0 to Threads -1 do RE[X]:=TTRegExpr.Create(X);
for X := 0 to Threads -1 do RE[X].Execute;
DB.SaveToFile(ExtractFilePath(ParamStr(0))+'~tmp1.txt');
ALL.Clear;
WriteLn('Making tables by first chars');
for I := 0 to DB.Count -1 do TBL[Ord(DB.Strings[I][1])].Add(DB.Strings[I]);
WriteLn('Sortings records in tables');
DB.Clear;
for I := 0 to 255 do if TBL[I].Count > 1 then TBL[I].Sort;
WriteLn('Saving dumps of tables');
MkDir(ExtractFilePath(ParamStr(0))+'TMP');
Path:=ExtractFilePath(ParamStr(0))+'TMP\';
for I := 0 to 255 do if TBL[I].Count > 0 then begin
TBL[I].SaveToFile(Path+'tbl_'+PrepareZeros(I,3)+'.txt');
WriteLn('Table ',Char(I),' has ',TBL[I].Count,' records');
end;
WriteLn('Cleaning varibles');
for I := 0 to 255 do if TBL[I].Count > 1 then TBL[I].Clear;
Path:=ExtractFilePath(ParamStr(0))+'TMP\';
Found := FindFirst(Path+'*', faAnyFile, F);
while Found = 0 do begin
if (F.Name<>'.') and (F.Name<>'..') then begin
WriteLn('>Load table ',F.Name);
DB.LoadFromFile(Path+F.Name);
for I := 0 to DB.Count - 1 do TBL[Ord(DB.Strings[I][2])].Add(DB.Strings[I]);
WriteLn(' Checking duplicates');
SetLength(TC,Threads);
I:=0;
D:=0;
for X := 0 to Threads - 1 do TC[X]:=TThreadChecker.Create(X);
for X := 0 to Threads - 1 do TC[X].Execute;
WriteLn(' Cleaning varibles');
for I := 0 to DB.Count - 1 do TBL[Ord(DB.Strings[I][2])].Clear;
DB.Clear;
end;
Found := FindNext(F);
end;
ALL.SaveToFile(ExtractFilePath(ParamStr(0))+'db.txt');
WriteLn('Save new db to ',ExtractFilePath(ParamStr(0))+'db.txt');
for I := 0 to 255 do TBL[I].Free;
DB.Free;
ALL.Free;
FindClose(F);
WriteLn('Finish');
ReadLn;
except
on E:Exception do
Writeln(E.Classname, ': ', E.Message);
end;
end.
Sry za temat ale nie wiem jak to inaczej nazwać...