program runstringsearch;
uses
Classes, SysUtils
, RegExpr;
//==============================================================================
// Auxiliary Functions
function PCharAtPos(const ssource: String; iposition: Integer): PChar;
begin
if (iposition > -1)
and (iposition < Length(ssource)) then
begin
Result := PChar(ssource) + iposition;
end
else
Result := Nil;
end;
function PCharStartsWith(const ssource: PChar; isourcelength: Cardinal
; const ssearch: PChar; isearchlength: Cardinal): Boolean; (*inline;*)
var
pssrc, psend, pssrh: PChar;
begin
pssrc := ssource;
pssrh := ssearch;
psend := pssrc + isourcelength;
//Shorter Srouce String doesn't match
Result := (isourcelength >= isearchlength);
//Empty Strings don't match
Result := Result
and ((pssrc^ <> #0)
or (pssrc < psend)
or (pssrh^ <> #0));
//First Byte must match
Result := Result and (pssrc^ = pssrh^);
while Result
and (pssrh^ <> #0)
and (pssrc < psend)
and (pssrc^ <> #0) do
begin
if pssrc^ <> pssrh^ then
Result := False
else
begin
inc(pssrc);
inc(pssrh);
end;
end; //while Result do
end;
function PCharSubStringRByChar(const ssource: PChar; const ssearch: Char; const ssearchend: PChar = Nil): PChar;
var
pssrh: PChar;
begin
pssrh := ssearchend;
Result := Nil;
if pssrh = Nil then
begin
pssrh := ssource + strlen(ssource);
end;
while (Result = Nil)
and (pssrh >= ssource) do
begin
if pssrh^ = ssearch then
Result := pssrh
else if pssrh > ssource then
dec(pssrh);
end; //while (Result = Nil) and (pssrh >= ssource) do
end;
function PCharSubStringByString(const ssource: PChar; isourcelength: Cardinal
; const ssearch: PChar; isearchlength: Cardinal): PChar;
var
pssrc, psend: PChar;
isrhps(*, icmpln, imtch*): Cardinal;
bsrhgo: Boolean;
begin
Result := Nil;
pssrc := ssource;
psend := pssrc + isourcelength;
isrhps := 0;
//icmpln := isourcelength;
//Skip on Empty Strings
bsrhgo := (pssrc < psend);
while bsrhgo
and (pssrc < psend) do
begin
if pssrc^ = ssearch^ then
begin
(* icmpln := isourcelength - isrhps;
if icmpln > isearchlength then
icmpln := isearchlength; *)
//if pssrc[0..(icmpln - 1)] = ssearch[0..(isearchlength - 1)] then
//imtch := ;
//if CompareByte(ssearch^, pssrc^, isearchlength) = 0 then
if PCharStartsWith(pssrc, isourcelength - isrhps, ssearch, isearchlength) then
begin
Result := pssrc;
bsrhgo := False;
end;
end; //if pssrc^ = ssearch^ then
inc(pssrc);
inc(isrhps);
//String End reached
//bsrhgo := ;
end; //while bsrhgo do
end;
function StringRPosByChar(const ssource: String; const ssearch: Char): Integer;
var
psstrt, pssrh: PChar;
isrhps: Integer;
begin
psstrt := PChar(ssource);
isrhps := Length(ssource);
pssrh := psstrt + isrhps;
Result := -1;
while (Result = -1)
and (pssrh >= psstrt) do
begin
if pssrh^ = ssearch then
Result := isrhps
else if pssrh > psstrt then
begin
dec(pssrh);
dec(isrhps);
end; //if pssrh^ = ssearch then
end; //while (Result = -1) and (pssrh >= psstrt) do
end;
function BuildPacketList: Integer;
var
chkexp: TRegExpr;
stmfl: TFileStream;
//stmchkpkg: TStringStream;
lstchklns: TStringList;
schkpkg: String;
sflcnk: String;
pschkpkg: PChar;
schklnsrh: String;
pslstln, pschktm, pschktmps, pschktmstrt: PChar;
ichkpkgln, ischktmln(*, ichktmps*), ilstlnps: Integer;
icnksz: Integer;
bchkstrt, bchkend: Boolean;
bdbg: Boolean;
begin
//------------------------------------
//Read the Firewall Log
Result := 0;
bdbg := false;
try
//stmfl := TFileStream.Create('./small_firewall.log', (fmOpenRead or fmShareDenyWrite));
stmfl := TFileStream.Create('./big_firewall.log', (fmOpenRead or fmShareDenyWrite));
except
on e: Exception do
begin
WriteLn('File ', chr(39), stmfl.FileName, chr(39), ': File Open failed with [', e.HelpContext, ']!');
WriteLn('Message: ', chr(39), e.Message, chr(39));
Result := 2;
end
else
begin
WriteLn('File ', chr(39), stmfl.FileName, chr(39), ': File Open failed!');
WriteLn('Message [-1]: ', chr(39), 'Unknown Error', chr(39));
Result := 2;
end;
end; //except
lstchklns := TStringList.Create;
icnksz := 32768;
sflcnk := '';
schkpkg := '';
SetLength(sflcnk, icnksz);
SetLength(schkpkg, icnksz);
//stmchkpkg := TStringStream.Create('');
//stmchkpkg.Size := Self.fl.ChunkSize;
bchkstrt := False;
bchkend := not (Result = 0);
pschktm := PChar(' 11:48:');
ischktmln := Length(' 11:48:') + 1;
schklnsrh := '^.* 11:48:[0-2][0-9] .*[:''][^:'']*(udp in|drop)[^:'']*[:''].*$';
try //except
chkexp := TRegExpr.Create;
chkexp.Expression := schklnsrh;
chkexp.ModifierI := True;
chkexp.ModifierM := True; //allow to work with ^$
chkexp.ModifierS:= False; //don't catch all text by .*
chkexp.ModifierX:= False; //don't ingore spaces
//Build the Regular Expression Control Structure
chkexp.Compile;
except
on e: ERegExpr do
begin
WriteLn('Expression ', chr(39), chkexp.Expression, chr(39), ': Compile failed with [', e.ErrorCode, ']!');
WriteLn('Error at Position ', chr(39), e.CompilerErrorPos, chr(39), ': ', chr(39), e.Message, chr(39));
if Result < 1 then
Result := 1;
//Stop Reading
bchkend:= True;
end;
end; //except
if not bchkend then
begin
WriteLn('file: ', chr(39), stmfl.FileName, chr(39), ': read do ...');
end; //if not bchkend then
try //except
while not bchkend
and (stmfl.Read(sflcnk[1], icnksz - 1) > 0) do
begin
pslstln := Nil;
if sflcnk <> '' then
begin
//Skip the Last Line
ilstlnps := StringRPosByChar(sflcnk, chr(10));
if ilstlnps <> -1 then
begin
schkpkg := schkpkg + sflcnk[1..ilstlnps] + chr(0);
//stmchkpkg.Write(sflcnk[1], ilstlnps);
//Terminate the String for PChar
//stmchkpkg.WriteByte(0);
inc(ilstlnps);
pslstln := PCharAtPos(sflcnk, ilstlnps);
end
else //The Chunk doesn't have a Linebreak
begin
schkpkg := schkpkg + sflcnk;
//stmchkpkg.WriteString(sflcnk);
end; //if pslstln <> nil then
pschkpkg := PChar(schkpkg);
//pschkpkg := PChar(stmchkpkg.DataString);
ichkpkgln := strlen(pschkpkg);
//ichkpkgln := stmchkpkg.Position - 1;
if bdbg then
WriteLn('chk cnk 1: ', chr(39), pschkpkg, chr(39));
//ichktmps := Pos(pschktm, pschkpkg);
pschktmps := strpos(pschkpkg, pschktm);
//pschktmps := PCharSubStringByString(pschkpkg, ichkpkgln, pschktm, ischktmln);
pschktmps := Nil;
if pschktmps <> Nil then
begin
pschktmstrt := PCharSubStringRByChar(pschkpkg, chr(10), pschktmps);
if pschktmstrt <> Nil then
inc(pschktmstrt)
else
pschktmstrt := pschktmps;
//Start Time Check
bchkstrt := True;
if bdbg then
begin
WriteLn('chk cnk 2: ', chr(39), pschktmstrt, chr(39));
Write('exp: ', chr(39), chkexp.Expression, chr(39), ' match - ');
end;
try //except
(*
if chkexp.Exec(pschktmstrt) then
begin
if bdbg then
WriteLn('HIT');
repeat
//Add all Matches for Checking
lstchklns.Add(chkexp.Match[0]);
until not chkexp.ExecNext;
if bdbg then
WriteLn('lst chk lns (cnt: ', chr(39), lstchklns.Count, chr(39), '): '
, chr(39), lstchklns.CommaText, chr(39));
end
else //Regular Expression does not match
begin
if bdbg then
WriteLn('MISS');
end; //if chkexp.Exec(pschktmstrt) then
*)
except
on e: ERegExpr do
begin
if bdbg then
WriteLn('CRASH');
WriteLn('Expression ', chr(39), schklnsrh, chr(39), ': Match failed with [', e.ErrorCode, ']!');
WriteLn('Error at Position ', chr(39), e.CompilerErrorPos, chr(39), ': ', chr(39), e.HelpContext, chr(39));
if Result < 1 then
Result := 1;
//Stop Reading
bchkend:= True;
end;
on e: Exception do
begin
WriteLn('File ', chr(39), stmfl.FileName, chr(39), ': File Read failed with [', e.HelpContext, ']!');
WriteLn('Message: ', chr(39), e.Message, chr(39));
if Result < 1 then
Result := 1;
//Stop Reading
bchkend:= True;
end; //on e: ERegExpr do
end; //except
end
else if bchkstrt then
begin
//Stop Time Check
bchkend := True;
end; //if strpos(pschkpkg, pschktm) <> Nil then
end; //if psrdcnk^ <> '' then
//Reset the Check String
//stmchkpkg.Position := 0;
if pslstln <> Nil then
begin
//Readd the Last Line
schkpkg := pslstln;
//stmchkpkg.WriteString(pslstln);
end
else
begin
schkpkg := '';
end; //if pslstln <> nil then
end; //while not bchkend
// and (stmfl.Read(sflcnk[1], 32768 - 1) > 0) do
except
on e: Exception do
begin
WriteLn('File ', chr(39), stmfl.FileName, chr(39), ': File Read failed with [', e.HelpContext, ']!');
WriteLn('Message [', e.HelpContext, ']: ', e.Message);
Result := 1;
end
else
begin
WriteLn('File ', chr(39), stmfl.FileName, chr(39), ': File Read failed!');
WriteLn('Message [-1]: ', chr(39), 'Unknown Error', chr(39));
Result := 1;
end; //on e: Exception do
end; //except
WriteLn('Expression ', chr(39), schklnsrh, chr(39), ': Match Count ', chr(39), lstchklns.Count, chr(39));
//------------------------
//Clean-Up
chkexp.Free;
//stmchkpkg.Free;
lstchklns.Free;
stmfl.Free;
end;
//==============================================================================
// Executing Section
const
SMETHOD = 'BuildPacketList';
var
ierr: Integer;
begin
try
ierr := BuildPacketList;
except
on e: Exception do
begin
WriteLn(SMETHOD, ' - failed!');
WriteLn('Message [', e.HelpContext, ']: ', e.Message);
end
else
begin
WriteLn(SMETHOD, ' - failed!');
WriteLn('Message [-1]: ', chr(39), 'Unknown Error', chr(39));
end; //on e: Exception do
ierr := 1;
end;
WriteLn(SMETHOD, ' - finished with [', ierr, ']!');
end.