EDIT: 1.53:
-Removed some unneeded lines - by replacing functions that weren't really needed anymore
-Added a little bit more eye-candy in (should be enough now!)
-Tweaks here and there
MAD PROGRESS!
Doing another bump here now (sorry!), because I think these improvements, that I added in today, definitely deserves/requires some extra attention.. :p
So, I am releasing unofficial version "1.50"! Contains line-based scanning - debugs the malicious/bad lines including their kind (HTTP, Web, Fishy, Bad) and the threat-"message" itself.
Scanning works still the same way as earlier, so its still based on the same regexes, that means any multiline tricks/attempts will be detected just like they have been in the last 3-6 releases (can't remember exactly for which version I added in the regex-based scanning + I am too lazy to check, haha).
NOTE: Those debugged threats will be reported from the line where each threat start from (so its always debugging the starting position for em).
Scan example for the script itself (ScannerV1.53):
*************************************************
* _ _ _ _ _ _ _ _ __ *
* /_`/ `/_//|/ /_//_`/_// //_// *
* ._//_,/ // | / \/_,/ /_// \/ *
* *
*************************************************
=================Filtered Script=================
*SNIP*
=================================================
============Looking for HTTP Threats=============
=================================================
=============Looking for Web Threats=============
Found "OpenWebPage" [Risk level: HIGH]
=================================================
==============Looking for Fishy Code=============
=================================================
==============Looking for Bad Code===============
Found no randomness in script [Risk level: MEDIUM], potential ban.
=================================================
===============Lines with Threats================
LINE | KIND | THREAT
-------------------------------------------------
1236 | Web Threat | OpenWebPage(*)
=================================================
==================Scan Results===================
HTTP threats: 0
Web threats: 1
Fishy code: 0
Bad code: 1
Overall threats: 2
Over Script Risk: High
=================================================
=====================FINISHED====================
Remember to visit the thread for latest updates.
Thank you for using!
=================================================
..and the source code for 1.53:
{=======================================================================================]
| |
| _____ _ _ _____ _ _ _____ |
| | __|_|_____| |_ ___ | __|___ ___|_|___| |_ | __|___ ___ ___ ___ ___ ___ |
| |__ | | | . | .'| |__ | _| _| | . | _| |__ | _| .'| | | -_| _| |
| |_____|_|_|_|_|___|__,| |_____|___|_| |_| _|_| |_____|___|__,|_|_|_|_|___|_| |
| |_| |
| |
[=======================================================================================}
{$i SRL/SRL.simba}
const
VERSION = '1.53'; // Don't touch... Script version.
FILTER_COMMENTS = True; // Doesn't pay attention to stuff inside comments
// Recommended to keep this feature enabled, a lot less false positives!
COMMENT_FILTER = '@'; // CHAR, NOT STRING! Used in debug box for displaying the filtered comments (doesn't effect scan, as these will be empty chars in filteredScriptText for scan).
FILTER_STRINGS = True; // Doesn't pay attention to stuff INSIDE string signs.
// So, this feature still detects stuff that falls outside those '' signs! :)
STRING_FILTER = '%'; // CHAR, NOT STRING! Used in debug box for displaying the filtered strings (doesn't effect scan, these will be empty chars in filteredScriptText for scan).
DEBUG_FILTERED_SCRIPT = True; // Debug the script, that was filtered (used for most script parts), before scan statistics (displays empty chars with COMMENT_FILTER & STRING_FILTER).
DEFAULT = 'Times New Roman';
type
TMatchMethod = (mmAll, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW);
TMatchMethods = set of TMatchMethod;
TRegexMatch = record
position, size: Integer;
text: string;
end;
TRegexMatchArray = array of TRegexMatch;
T2DRegexMatchArray = array of TRegexMatchArray;
TRange = record
minimum, maximum: Integer;
end;
TRangeArray = array of TRange;
TThreat = record
line: Integer;
threat: string;
kind: (tk_HTTP, tk_Web, tk_Fishy, tk_Bad);
end;
TThreatArray = array of TThreat;
var
DsgnForm: TForm;
ScriptEdit: TMemo;
TitleLabel: TLabel;
ScanButton, UpdateButton: TButton;
originalScriptText, filteredScriptText, displayScriptText: string;
HTTPThreats, WebThreats, BadCode, threats, FishyCode: Integer;
msgHTTP, msgWeb, msgBad, msgFishy: string;
pressed: Boolean;
_threats: TThreatArray;
linePositions: TIntegerArray;
(*
Auther: Officer Barbrady
*)
procedure PrintReport;
var
Points: Integer;
h, i: Integer;
li, th, kd: string;
begin
WriteLn('*************************************************');
WriteLn('* _ _ _ _ _ _ _ _ __ *');
WriteLn('* /_`/ `/_//|/ /_//_`/_// //_// *');
WriteLn('* ._//_,/ // | / \/_,/ /_// \/ *');
WriteLn('* *');
WriteLn('*************************************************');
WriteLn(' ');
WriteLn('=================Filtered Script=================');
if DEBUG_FILTERED_SCRIPT then
WriteLn(displayScriptText);
WriteLn('=================================================');
WriteLn(' ');
WriteLn('============Looking for HTTP Threats=============');
if (msgHTTP <> '') then
WriteLn(msgHTTP);
WriteLn('=================================================');
WriteLn(' ');
WriteLn('=============Looking for Web Threats=============');
if (msgWeb <> '') then
WriteLn(msgWeb);
WriteLn('=================================================');
WriteLn(' ');
WriteLn('==============Looking for Fishy Code=============');
if (msgFishy <> '') then
WriteLn(msgFishy);
WriteLn('=================================================');
WriteLn(' ');
WriteLn('==============Looking for Bad Code===============');
if (msgBad <> '') then
WriteLn(msgBad);
WriteLn('=================================================');
WriteLn(' ');
WriteLn('===============Lines with Threats================');
h := High(_threats);
if (h > -1) then
begin
WriteLn(' LINE | KIND | THREAT ');
WriteLn('-------------------------------------------------');
for i := 0 to h do
begin
li := IntToStr(_threats[i].line);
case _threats[i].kind of
tk_Bad: kd := 'Bad Code';
tk_Fishy: kd := 'Fishy Code';
tk_HTTP: kd := 'HTTP Threat';
tk_Web: kd := 'Web Threat';
end;
th := _threats[i].threat;
WriteLn(' ' + (li + Padr(' ', (Length(' LINE |') - Length(li)) - 2)) + '| ' + (kd + Padr(' ', (Length(' KIND |') - Length(kd)) - 2)) + '| ' + th);
end;
end;
Points := (HTTPthreats + WebThreats + BadCode + FishyCode);
WriteLn('=================================================');
WriteLn(' ');
WriteLn('==================Scan Results===================');
WriteLn('HTTP threats: ' + ToStr(HTTPThreats));
WriteLn('Web threats: ' + ToStr(WebThreats));
WriteLn('Fishy code: ' + ToStr(FishyCode));
WriteLn('Bad code: ' + ToStr(BadCode));
WriteLn('Overall threats: ' + ToStr(Points))
case threats of
0: WriteLn('Over Script Risk: None');
1..2: WriteLn('Over Script Risk: Low');
3: WriteLn('Over Script Risk: Medium');
4..8: WriteLn('Over Script Risk: High');
end;
WriteLn('=================================================');
WriteLn(' ');
WriteLn('=====================FINISHED====================');
WriteLn(' Remember to visit the thread for latest updates.');
WriteLn(' Thank you for using! ');
WriteLn('=================================================');
end;
procedure NewThreat(var TTA: TThreatArray; line: Integer; threat: string; kind: (tk_HTTP, tk_Web, tk_Fishy, tk_Bad));
var
index, i, l: Integer;
begin
l := Length(TTA);
while (index < l) do
begin
if (line < TTA[index].line) then
Break;
Inc(index);
end;
SetLength(TTA, (l + 1));
if (l > index) then
for i := (l - 1) downto index do
TTA[(i + 1)] := TTA[i];
TTA[index].line := line;
TTA[index].threat := threat;
TTA[index].kind := kind;
end;
procedure TIAInsert(var TIA: TIntegerArray; index: Integer; int: Integer);
var
i, l: Integer;
begin
l := Length(TIA);
SetLength(TIA, (l + 1));
if (index < 0) then
index := 0;
if (index > l) then
index := l;
if (l > index) then
for i := (l - 1) downto index do
TIA[(i + 1)] := Integer(TIA[i]);
TIA[index] := Integer(int);
end;
{==============================================================================]
Explanation: Returns string of all TSA items binded together. Places glue between the indexes.
[==============================================================================}
function TSAConcatEx(TSA: TStringArray; glue: string): string;
var
h, i: Integer;
begin
Result := '';
h := High(TSA);
if (h > -1) then
begin
for i := 0 to (h - 1) do
Result := (Result + string(TSA[i]) + string(glue));
Result := (Result + string(TSA[i]));
end;
end;
{==============================================================================]
Explanation: Explodes str with multiple separators/delimiters (d).
The importance order for d items is from left to right (=>).
So place the important ones first and then less important after those.
[==============================================================================}
function ExplodeMulti(d: TStringArray; str: string): TStringArray;
var
p, h, i, x, o, m, l, y, z: Integer;
begin
h := High(d);
if ((h > -1) and (str <> '')) then
begin
o := 1;
SetLength(Result, Length(str));
repeat
l := 0;
for x := 0 to h do
begin
p := Pos(d[x], str);
case (p < 1) of
True:
begin
z := High(d);
if ((x <= z) and (x > -1)) then
begin
for y := x to (z - 1) do
d[y] := d[(y + 1)];
SetLength(d, z);
end;
Dec(x);
Dec(h);
end;
False:
if ((l = 0) or (p < l)) then
begin
m := x;
l := p;
end;
end;
end;
if (l > 0) then
begin
Result[i] := Copy(str, 1, (l - 1));
Delete(str, 1, ((l + Length(d[m])) - 1));
Inc(i);
end else
Result[i] := Copy(str, 1, Length(str));
until (l = 0);
SetLength(Result, (i + 1));
end else
Result := [string(str)];
end;
{==============================================================================]
Explanation: Finds position from s items in str. Stores the ID of the found s item to index variable.
The importance order for d items is from left to right (=>).
So place the important ones first and then less important after those.
Contains field for offset.
[==============================================================================}
function PosMultiIDEx(s: TStringArray; str: string; var index: Integer; offset: Integer): Integer;
var
h, i, p, t: Integer;
begin
if (offset < 1) then
offset := 1;
Result := -1;
index := -1;
h := High(s);
if ((h > -1) and (str <> '')) then
begin
t := (Length(str) + 1);
Result := t;
for i := 0 to h do
begin
p := PosEx(s[i], str, offset);
if ((p > 0) and (p < Result)) then
begin
Result := p;
index := i;
end;
end;
if (Result = t) then
Result := 0;
end;
end;
function PosAll(s, str: string): TIntegerArray;
var
sL, strL, o, p, r: Integer;
begin
sL := Length(s);
strL := Length(str);
if (sL <= strL) then
begin
SetLength(Result, strL);
repeat
p := PosEx(s, str, (o + 1));
if (p > 0) then
begin
Result[r] := p;
o := p;
Inc(r);
end;
until (p <= 0);
end;
SetLength(Result, r);
end;
function ToRange(minimum, maximum: Integer): TRange;
begin
Result.minimum := Integer(minimum);
Result.maximum := Integer(maximum);
end;
procedure TRAAppend(var TRA: TRangeArray; x: TRange);
var
aL: Integer;
begin
aL := (Length(TRA) + 1);
SetLength(TRA, aL);
TRA[(aL - 1)] := TRange(x);
end;
function TrackCaS(str: string; var comments, strings: TRangeArray): Boolean;
var
s, i, o, e, x, l, a, ls: Integer;
t: TStringArray;
begin
Result := False;
SetLength(comments, 0);
SetLength(strings, 0);
l := Length(str);
ls := -1;
if (l > 0) then
begin
o := 1;
t := ['//', '(*', '{', ''''];
repeat
s := PosMultiIDEx(t, str, i, o);
case (s <= ls) of
True: Exit;
False: ls := s;
end;
if (s > 0) then
begin
o := (s + 1);
a := 0;
case i of
0, 1, 2:
begin
case i of
0:
begin
e := PosMultiIDEx([#13#10, #13, #10], str, x, o);
if (x = 0) then
a := 1;
if (e = 0) then
e := l;
TRAAppend(comments, ToRange(s, e));
end;
1, 2:
begin
case i of
1:
begin
e := PosEx('*)', str, o);
a := 1;
end;
2: e := PosEx('}', str, o);
end;
if (e = 0) then
e := l;
TRAAppend(comments, ToRange(s, (e + a)));
end;
end;
end;
3:
begin
e := PosMultiIDEx([#13#10, #13, #10, ''''], str, x, o);
if (x = 0) then
a := 1;
case (e = 0) of
True:
begin
e := l;
TRAAppend(strings, ToRange(s, e));
end;
False:
case x of
0, 1, 2: TRAAppend(strings, ToRange(s, e));
3: TRAAppend(strings, ToRange(s, (e + a)));
end;
end;
end;
end;
o := ((e + 1) + a);
end;
until ((s = 0) or (x = -1) or (o > l));
end;
end;
{==============================================================================]
Explanation: Trims all TSA items.
[==============================================================================}
procedure TSATrim(var TSA: TStringArray);
var
h, i: Integer;
begin
h := High(TSA);
for i := 0 to h do
TSA[i] := Trim(TSA[i]);
end;
{==============================================================================]
Explanation: Returns all the positions by items from s array in str. Place s items in importance order (=>)
If overlap is set to true, strings can overlap.
(['aa'], 'baaaah', False) => [2,3,4]
(['aa'], 'baaaah', True) => [2,4]
[==============================================================================}
function PosAllMulti(s: TStringArray; str: string; overlap: Boolean): TIntegerArray;
var
h, l, p, o, x, i, t, r, y, d: Integer;
begin
h := High(s);
y := Length(str);
if ((y > 0) and (h > -1)) then
begin
SetLength(Result, y);
o := 1;
repeat
p := 0;
for x := 0 to h do
begin
t := PosEx(s[x], str, (l + o));
case (t < 1) of
True:
begin
for d := x to (h - 1) do
s[d] := s[(d + 1)];
SetLength(s, h);
Dec(x);
Dec(h);
end;
False:
if ((p = 0) or (t < p)) then
begin
p := t;
i := x;
end;
end;
end;
if (p > 0) then
begin
Result[r] := p;
Inc(r);
l := p;
if not overlap then
o := Length(s[i]);
end;
until (p <= 0);
end;
SetLength(Result, r);
end;
procedure FillStrRangeEx(var str: string; fillWith: Char; range: TRange; exceptions: TIntegerArray);
var
i, l, c: Integer;
begin
l := Length(str);
if ((l > 0) and not (range.minimum > range.maximum)) then
begin
if (range.minimum < 1) then
range.minimum := 1;
if (range.maximum > l) then
range.maximum := l;
if (range.minimum > l) then
Exit;
c := iAbs(range.maximum - range.minimum);
for i := range.minimum to range.maximum do
if not InIntArray(exceptions, i) then
str[i] := fillWith;
end;
end;
function FilterScriptData(data: string): string;
var
h, i, l: Integer;
newLines: TIntegerArray;
comments, strings: TRangeArray;
tmp: TStringArray;
begin
Result := string(data);
displayScriptText := string(Result);
l := Length(Result);
if (Result <> '') then
begin
if (FILTER_STRINGS or FILTER_COMMENTS) then
begin
newLines := PosAllMulti([#13, #10], Result, False);
TrackCaS(data, comments, strings);
h := High(comments);
if FILTER_COMMENTS then
for i := 0 to h do
begin
FillStrRangeEx(Result, '!', comments[i], newLines);
FillStrRangeEx(displayScriptText, COMMENT_FILTER, comments[i], newLines);
end;
h := High(strings);
if FILTER_COMMENTS then
for i := 0 to h do
begin
FillStrRangeEx(Result, '!', strings[i], newLines);
FillStrRangeEx(displayScriptText, STRING_FILTER, strings[i], newLines);
end;
SetLength(newLines, 0);
SetLength(comments, 0);
SetLength(strings, 0);
Result := ReplaceWrap(Result, '!', '', [rfReplaceAll]);
end;
tmp := ExplodeMulti([#13#10, #13, #10], Result);
TSATrim(tmp);
Result := TSAConcatEx(tmp, #13#10);
SetLength(tmp, 0);
end;
end;
{==============================================================================]
Explanation: Returns all the positions of found/matching strings (findStr) in text.
Uses a set of TMatchMethod (methods) for string matching.
Contains field for offset.
If regex field is set as true, then this function searches for the regex you use.
[==============================================================================}
function FindEx(text, findStr: string; methods: TMatchMethods; offset: Integer; regex: Boolean): TIntegerArray;
var
rmArr: TRegexMatchArray;
rmArr2D: T2DRegexMatchArray;
sb, sa: string;
r, i, l, f, p, d, o, x, y, abL, abR, abX, abP, spA, spB, spH, spL, spI, spR, spD: Integer;
re: TRegExp;
ma, mb, a, s, ol: Boolean;
c: TIntegerArray;
t: T2DIntegerArray;
begin
l := Length(text);
f := Length(findStr);
if ((l > 0) and (f > 0) and (offset <= (l - f))) then
begin
if (offset < 1) then
offset := 1;
if not regex then
begin
for i := f downto 1 do
if (Pos(findStr[i], '.\+*?[^]$(){}=!<>|:-') > 0) then
Insert('\', findStr, i);
SetLength(Result, l);
re := TRegExp.Create;
re.InputString := text;
re.Expression := findStr;
if (mmIgnoreCase in methods) then
re.ModifierI := True;
a := (mmAll in methods);
case a of
False: re.ModifierG := True;
True: re.ModifierG := False;
end;
re.ModifierM := True;
ol := (mmOverlap in methods);
if not ol then
o := (Length(findStr) - 1);
Inc(o);
p := offset;
while re.ExecPos(p) do
begin
Result[r] := re.MatchPos[0];
p := (Result[r] + o);
Inc(r);
end;
p := Offset;
re.Free;
SetLength(Result, r);
if ((r > 0) and (mmWholeWords in methods)) then
begin
s := (mmStrictWW in methods);
if not s then
c := [65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, // A-Z
97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, // a-z
48, 49, 50, 51, 52, 53, 54, 55, 56, 57]; // 0-9
case ol of
True:
begin
spH := High(Result);
if (spH > -1) then
begin
SetLength(t, (spH + 1));
t[0] := [Integer(Result[0])];
if (spH > 0) then
begin
spR := 1;
for spI := 1 to spH do
begin
for spA := 0 to (spR - 1) do
begin
spL := Length(t[spA]);
for spB := 0 to (spL - 1) do
begin
spD := IAbs(Result[spI] - t[spA][spB]);
if (spD <= f) then
begin
SetLength(t[spA], (spL + 1));
t[spA][spL] := Integer(Result[spI]);
Break;
end;
end;
if (spB < spL) then
Break;
end;
if (spA >= spR) then
begin
t[spR] := [Integer(Result[spI])];
Inc(spR);
end;
end;
end;
SetLength(t, spR);
spH := High(t);
for spI := spH downto 0 do
begin
spB := Low(t[spI]);
spA := High(t[spI]);
abX := 1;
abP := t[spI][spB];
abL := Length(text);
case ((abL > 0) and (abP > 1)) of
True:
begin
if ((abP - abX) < 1) then
abX := ((abP - abX) + (abX - 1));
if (abP > (abL + 1)) then
begin
abR := ((abP - abL) - 1);
abX := (abX - abR);
end;
sb := Copy(text, ((abP - abX) - abR), abX);
end;
False: sb := '';
end;
abX := 1;
abP := (t[spI][spA] + f);
abL := Length(text);
case ((abL > 0) and (abP <= abL)) of
True:
begin
if (abP < 1) then
begin
abX := (abX - iAbs(abP - 1));
abP := 1;
end;
if ((abX > 0) and ((abP + abX) > abL)) then
abX := (abX - (((abP + abX) - abL) - 1));
sa := Copy(text, abP, abX);
end;
False: sa := '';
end;
case s of
True:
begin
mb := ((sb = '') or (sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
ma := ((sa = '') or (sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
end;
False:
begin
mb := ((sb = '') or not InIntArray(c, Ord(sb[1])));
ma := ((sa = '') or not InIntArray(c, Ord(sa[1])));
end;
end;
if not (mb and ma) then
begin
for spD := spI to (spH - 1) do
t[spD] := t[(spD + 1)];
SetLength(t, spH);
Dec(spH);
end;
end;
spH := High(t);
if (spH > -1) then
begin
for spI := 0 to spH do
IncEx(spR, (High(t[spI]) + 1));
SetLength(Result, spR);
spR := 0;
for spI := 0 to spH do
begin
spL := High(t[spI]);
for spA := 0 to spL do
begin
Result[spR] := Integer(t[spI][spA]);
Inc(spR);
end;
end;
SetLength(Result, spR);
end else
SetLength(Result, 0);
end else
r := 0;
end;
False:
begin
for x := (r - 1) downto 0 do
begin
abX := 1;
abP := Result[x];
abL := Length(text);
case ((abL > 0) and (abP > 1)) of
True:
begin
if ((abP - abX) < 1) then
abX := ((abP - abX) + (abX - 1));
if (abP > (abL + 1)) then
begin
abR := ((abP - abL) - 1);
abX := (abX - abR);
end;
sb := Copy(text, ((abP - abX) - abR), abX);
end;
False: sb := '';
end;
abX := 1;
abP := (Result[x] + f);
abL := Length(text);
case ((abL > 0) and (abP <= abL)) of
True:
begin
if (abP < 1) then
begin
abX := (abX - iAbs(abP - 1));
abP := 1;
end;
if ((abX > 0) and ((abP + abX) > abL)) then
abX := (abX - (((abP + abX) - abL) - 1));
sa := Copy(text, abP, abX);
end;
False: sa := '';
end;
case s of
True:
begin
mb := ((sb = '') or (sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
ma := ((sa = '') or (sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
end;
False:
begin
mb := ((sb = '') or not InIntArray(c, Ord(sb[1])));
ma := ((sa = '') or not InIntArray(c, Ord(sa[1])));
end;
end;
if not (mb and ma) then
begin
y := (r - 1);
for d := x to (y - 1) do
Result[d] := Result[(d + 1)];
SetLength(Result, y);
Dec(r);
end;
end;
end;
end;
end;
if (not a and (r > 0)) then
SetLength(Result, 1);
end else
begin
SetLength(rmArr, l);
re := TRegExp.Create;
re.InputString := text;
re.Expression := findStr;
if (mmIgnoreCase in methods) then
re.ModifierI := True;
a := (mmAll in methods);
case a of
False: re.ModifierG := True;
True: re.ModifierG := False;
end;
re.ModifierM := True;
ol := (mmOverlap in methods);
p := offset;
while re.ExecPos(p) do
begin
rmArr[r].position := re.MatchPos[0];
rmArr[r].text := re.Match[0];
rmArr[r].size := re.MatchLen[0];
if ol then
p := (rmArr[r].position + 1)
else
p := (rmArr[r].position + rmArr[r].size);
Inc(r);
end;
p := Offset;
re.Free;
SetLength(rmArr, r);
if ((r > 0) and (mmWholeWords in methods)) then
begin
s := (mmStrictWW in methods);
if not s then
c := [65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, // A-Z
97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, // a-z
48, 49, 50, 51, 52, 53, 54, 55, 56, 57]; // 0-9
case ol of
True:
begin
spH := High(rmArr);
if (spH > -1) then
begin
SetLength(rmArr2D, (spH + 1));
rmArr2D[0] := [TRegexMatch(rmArr[0])];
if (spH > 0) then
begin
spR := 1;
for spI := 1 to spH do
begin
for spA := 0 to (spR - 1) do
begin
spL := Length(rmArr2D[spA]);
for spB := 0 to (spL - 1) do
begin
spD := IAbs(rmArr[spI].position - rmArr2D[spA][spB].position);
if (spD <= rmArr2D[spA][spB].size) then
begin
SetLength(rmArr2D[spA], (spL + 1));
rmArr2D[spA][spL] := TRegexMatch(rmArr[spI]);
Break;
end;
end;
if (spB < spL) then
Break;
end;
if (spA >= spR) then
begin
rmArr2D[spR] := [TRegexMatch(rmArr[spI])];
Inc(spR);
end;
end;
end;
SetLength(rmArr2D, spR);
spH := High(rmArr2D);
for spI := spH downto 0 do
begin
spB := Low(rmArr2D[spI]);
spA := High(rmArr2D[spI]);
abX := 1;
abP := rmArr2D[spI][spB].position;
abL := Length(text);
case ((abL > 0) and (abP > 1)) of
True:
begin
if ((abP - abX) < 1) then
abX := ((abP - abX) + (abX - 1));
if (abP > (abL + 1)) then
begin
abR := ((abP - abL) - 1);
abX := (abX - abR);
end;
sb := Copy(text, ((abP - abX) - abR), abX);
end;
False: sb := '';
end;
abX := 1;
abP := (rmArr2D[spI][spA].position + rmArr2D[spI][spA].size);
abL := Length(text);
case ((abL > 0) and (abP <= abL)) of
True:
begin
if (abP < 1) then
begin
abX := (abX - iAbs(abP - 1));
abP := 1;
end;
if ((abX > 0) and ((abP + abX) > abL)) then
abX := (abX - (((abP + abX) - abL) - 1));
sa := Copy(text, abP, abX);
end;
False: sa := '';
end;
case s of
True:
begin
mb := ((sb = '') or (sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
ma := ((sa = '') or (sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
end;
False:
begin
mb := ((sb = '') or not InIntArray(c, Ord(sb[1])));
ma := ((sa = '') or not InIntArray(c, Ord(sa[1])));
end;
end;
if not (mb and ma) then
begin
for spD := spI to (spH - 1) do
rmArr2D[spD] := rmArr2D[(spD + 1)];
SetLength(rmArr2D, spH);
Dec(spH);
end;
end;
spH := High(rmArr2D);
if (spH > -1) then
begin
for spI := 0 to spH do
IncEx(spR, (High(rmArr2D[spI]) + 1));
SetLength(rmArr, spR);
spR := 0;
for spI := 0 to spH do
begin
spL := High(rmArr2D[spI]);
for spA := 0 to spL do
begin
rmArr[spR] := TRegexMatch(rmArr2D[spI][spA]);
Inc(spR);
end;
end;
SetLength(rmArr, spR);
r := spR;
end else
SetLength(rmArr, 0);
end else
r := 0;
end;
False:
begin
for x := (r - 1) downto 0 do
begin
abX := 1;
abP := rmArr[x].position;
abL := Length(text);
case ((abL > 0) and (abP > 1)) of
True:
begin
if ((abP - abX) < 1) then
abX := ((abP - abX) + (abX - 1));
if (abP > (abL + 1)) then
begin
abR := ((abP - abL) - 1);
abX := (abX - abR);
end;
sb := Copy(text, ((abP - abX) - abR), abX);
end;
False: sb := '';
end;
abX := 1;
abP := (rmArr[x].position + rmArr[x].size);
abL := Length(text);
case ((abL > 0) and (abP <= abL)) of
True:
begin
if (abP < 1) then
begin
abX := (abX - iAbs(abP - 1));
abP := 1;
end;
if ((abX > 0) and ((abP + abX) > abL)) then
abX := (abX - (((abP + abX) - abL) - 1));
sa := Copy(text, abP, abX);
end;
False: sa := '';
end;
case s of
True:
begin
mb := ((sb = '') or (sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
ma := ((sa = '') or (sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
end;
False:
begin
mb := ((sb = '') or not InIntArray(c, Ord(sb[1])));
ma := ((sa = '') or not InIntArray(c, Ord(sa[1])));
end;
end;
if not (mb and ma) then
begin
y := (r - 1);
for d := x to (y - 1) do
rmArr[d] := rmArr[(d + 1)];
SetLength(rmArr, y);
Dec(r);
end;
end;
end;
end;
end;
case (r > 0) of
True:
begin
if not a then
r := 1;
SetLength(Result, r);
for i := 0 to (r - 1) do
Result[i] := rmArr[i].position;
end;
False: SetLength(Result, 0);
end;
end;
end else
SetLength(Result, 0);
end;
function CountString(s, str: string): Integer;
begin
Result := Length(FindEx(str, s, [mmAll, mmIgnoreCase, mmWholeWords], 1, False));
end;
function CountStringEx(s, str: string; regex: Boolean): Integer;
begin
Result := Length(FindEx(str, s, [mmAll, mmIgnoreCase, mmWholeWords], 1, regex));
end;
function CountStringMulti(s: TStringArray; str: string): Integer;
var
tmp, all: TIntegerArray;
h, i, l, f, a: Integer;
begin
h := High(s);
if ((str <> '') and (h > -1)) then
begin
for i := 0 to h do
begin
tmp := FindEx(str, s[i], [mmAll, mmIgnoreCase, mmWholeWords], 1, False);
f := High(tmp);
if (h > -1) then
begin
l := Length(all);
SetLength(all, (l + (f + 1)));
for a := 0 to f do
all[(a + l)] := Integer(tmp[a]);
SetLength(tmp, 0);
end;
end;
ClearSameIntegers(all);
Result := Length(all);
SetLength(all, 0);
end;
end;
function CountStringMultiEx(s: TStringArray; str: string; regex: Boolean): Integer;
var
tmp, all: TIntegerArray;
h, i, l, f, a: Integer;
begin
h := High(s);
if ((str <> '') and (h > -1)) then
begin
for i := 0 to h do
begin
tmp := FindEx(str, s[i], [mmAll, mmIgnoreCase, mmWholeWords], 1, regex);
f := High(tmp);
if (h > -1) then
begin
l := Length(all);
SetLength(all, (l + (f + 1)));
for a := 0 to f do
all[(a + l)] := Integer(tmp[a]);
SetLength(tmp, 0);
end;
end;
ClearSameIntegers(all);
Result := Length(all);
SetLength(all, 0);
end;
end;
function PositionToLine(position: Integer): Integer;
var
h: Integer;
begin
Result := 1;
h := High(linePositions);
if (h > -1) then
case (h > 0) of
True:
for Result := 1 to (h + 1) do
if (position < linePositions[(Result - 1)]) then
Break;
False:
if (position >= linePositions[0]) then
Result := 2;
end;
Dec(Result);
end;
procedure AddMessage(var msgs: string; msg: string);
begin
case (msgs <> '') of
True: msgs := (msgs + #13#10 + msg);
False: msgs := msg;
end;
end;
(*
Auther: Officer Barbrady
*)
procedure FindBadCode;
var
h, i, x: Integer;
bc: TStringArray;
tmp: TIntegerArray;
s: string;
begin
msgBad := '';
bc := ['mmouse (\() x , y , 1 , 1 (\))', 'mouse (\() x , y , 1 , 1 ,(.*)(\))'];
for x := 0 to 1 do
begin
tmp := FindEx(filteredScriptText, ReplaceWrap(bc[x], ' ', '(\s*)', [rfReplaceAll]), [mmAll, mmIgnoreCase, mmWholeWords], 1, True);
h := High(tmp);
if (h > -1) then
begin
case x of
0: s := 'MMouse(x, y, 1, 1)';
1: s := 'Mouse(x, y, 1, 1, *)';
end;
for i := 0 to h do
NewThreat(_threats, PositionToLine(tmp[i]), s, tk_Bad);
AddMessage(msgBad, 'Found "' + s + '" [Risk level: MEDIUM], potential ban.');
Inc(BadCode);
threats := (threats + 1);
SetLength(tmp, 0);
end;
end;
SetLength(bc, 0);
tmp := FindEx(filteredScriptText, ReplaceWrap('(random (\()(.*)(\))|randomrange (\()(.*)(\)))', ' ', '(\s*)', [rfReplaceAll]), [mmAll, mmIgnoreCase, mmWholeWords], 1, True);
h := High(tmp);
case (h = -1) of
True:
begin
AddMessage(msgBad, 'Found no randomness in script [Risk level: MEDIUM], potential ban.');
Inc(BadCode)
Inc(threats);
end;
False: SetLength(tmp, 0);
end;
end;
(*
Auther: Officer Barbrady
*)
procedure FindFishyCode;
var
ac: TStringArray;
h, i, x: Integer;
tmp: TIntegerArray;
begin
msgFishy := '';
ac := ['Name', 'Pass', 'Pin'];
for x := 0 to 2 do
begin
tmp := FindEx(filteredScriptText, ReplaceWrap(('players (\[) (.*) (\]) (\.) ' + Lowercase(ac[x])), ' ', '(\s*)', [rfReplaceAll]), [mmAll, mmIgnoreCase, mmWholeWords], 1, True);
h := High(tmp);
if (h > 0) then
begin
for i := 0 to h do
NewThreat(_threats, PositionToLine(tmp[i]), ('Players[*].' + ac[x]), tk_Fishy);
IncEx(FishyCode, (h + 1));
AddMessage(msgFishy, 'The variable "' + ac[x] + '" is used more then once [Risk level: MEDIUM]');
Inc(threats);
end;
SetLength(tmp, 0);
end;
tmp := FindEx(filteredScriptText, ReplaceWrap('ToStr (\() players (\[) (.*) (\]) (\))', ' ', '(\s*)', [rfReplaceAll]), [mmAll, mmIgnoreCase, mmWholeWords], 1, True);
h := High(tmp);
if (h > -1) then
begin
for i := 0 to h do
NewThreat(_threats, PositionToLine(tmp[i]), 'ToStr(Players[*])', tk_Fishy);
IncEx(FishyCode, (h + 1));
AddMessage(msgFishy, 'Player data sent to ToStr() [Risk level: MEDIUM]');
Inc(threats);
SetLength(tmp, 0);
end;
SetLength(ac, 0);
end;
(*
Auther: Officer Barbrady
*)
procedure FindHTTPThreats;
var
ht: TStringArray;
h, i, x: Integer;
tmp: TIntegerArray;
begin
msgHTTP := '';
ht := ['AddPostVariable', 'GetPage', 'PostHTTPPage', 'PostHTTPPageEx'];
for x := 0 to 3 do
begin
tmp := FindEx(filteredScriptText, (Lowercase(ht[x]) + ReplaceWrap(' (\()(.*)(\))', ' ', '(\s*)', [rfReplaceAll])), [mmAll, mmIgnoreCase, mmWholeWords], 1, True);
h := High(tmp);
if (h > -1) then
begin
for i := 0 to h do
NewThreat(_threats, PositionToLine(tmp[i]), (ht[x] + '(*)'), tk_HTTP);
IncEx(HTTPThreats, (h + 1));
AddMessage(msgHTTP, 'Found "' + ht[x] + '" [Risk level: HIGH]');
IncEx(threats, 4);
end;
SetLength(tmp, 0);
end;
SetLength(ht, 0);
end;
(*
Auther: Officer Barbrady
*)
procedure FindWebThreats;
var
h, i: Integer;
tmp: TIntegerArray;
begin
msgWeb := '';
tmp := FindEx(filteredScriptText, ('openwebpage' + ReplaceWrap(' (\()(.*)(\))', ' ', '(\s*)', [rfReplaceAll])), [mmAll, mmIgnoreCase, mmWholeWords], 1, True);
h := High(tmp);
if (h > -1) then
begin
for i := 0 to h do
NewThreat(_threats, PositionToLine(tmp[i]), 'OpenWebPage(*)', tk_Web);
IncEx(WebThreats, (h + 1));
AddMessage(msgWeb, 'Found "OpenWebPage" [Risk level: HIGH]');
IncEx(threats, 4);
SetLength(tmp, 0);
end;
end;
(*
Auther: Officer Barbrady
*)
procedure Scan;
begin
FindHTTPThreats;
FindWebThreats;
FindFishyCode;
FindBadCode;
PrintReport;
end;
(*
Auther: Officer Barbrady
*)
procedure OpenThread(Sender: TObject);
begin
OpenWebPage('http://villavu.com/forum/showthread.php?t=103408');
end;
(*
Auther: Officer Barbrady
*)
procedure SaveFormInfo(Sender: TObject);
var
tmp: TStringArray;
begin
DsgnForm.ModalResult := mrOk;
tmp := ExplodeMulti([#13#10, #13, #10], ScriptEdit.Text);
originalScriptText := TSAConcatEx(tmp, #13#10);
SetLength(tmp, 0);
filteredScriptText := FilterScriptData(originalScriptText);
linePositions := PosAll(#13#10, filteredScriptText);
TIAInsert(linePositions, 0, 1);
pressed := True;
DsgnForm.Close;
end;
(*
Auther: Officer Barbrady
*)
procedure InitForm;
begin
DsgnForm := TForm.Create(nil);
with DsgnForm do
begin
Caption := ('Simba Script Scanner v' + VERSION);
Left := 377;
Top := 380;
Width := 750;
Height := 460;
Font.Name := default;
Font.Color := clDefault;
Font.Size := 0;
end;
ScriptEdit := TMemo.Create(DsgnForm);
with ScriptEdit do
begin
Parent := DsgnForm;
Left := 120;
Top := 80;
Width := 481;
Height := 177;
Font.Name := default;
with ScriptEdit.Lines do
Add('Paste script into this box, it will look for suspicious lines of code!');
ScrollBars := ssBoth;
TabOrder := 0;
end;
TitleLabel := TLabel.Create(DsgnForm);
with TitleLabel do
begin
Parent := DsgnForm;
Caption := ('Simba Script Scanner v' + VERSION);
Left := 225;
Top := 20;
Width := 43;
Height := 14;
Font.Name := default;
Font.Color := clDefault;
Font.Size := 17;
end;
ScanButton := TButton.Create(DsgnForm);
with ScanButton do
begin
Parent := DsgnForm;
Caption := 'Scan';
Left := 175;
Top := 300;
Width := 150;
Height := 25;
Font.Size := 12;
OnClick := @SaveFormInfo;
end;
UpdateButton := TButton.Create(DsgnForm);
with UpdateButton do
begin
Parent := DsgnForm;
Caption := 'Update';
Left := 400;
Top := 300;
Width := 150;
Height := 25;
Font.Size := 12;
OnClick := @OpenThread;
end;
end;
procedure SafeInitForm;
var
v: TVariantArray;
begin
SetLength(V, 0);
ThreadSafeCall('InitForm', v);
end;
procedure ShowFormModal;
begin
DsgnForm.ShowModal;
end;
procedure SafeShowFormModal;
var
v: TVariantArray;
begin
SetLength(V, 0);
ThreadSafeCall('ShowFormModal', v);
end;
begin
ClearDebug;
SafeInitForm;
SafeShowFormModal;
if pressed then
Scan;
originalScriptText := '';
filteredScriptText := '';
displayScriptText := '';
end.
@Officer BarbradyI wonder, if this unofficial 1.42 should be official version "1.50" (when you'll do some merging with your latest form improvements first) and then this new unofficial 1.50 could be the official version "2.00" (with those same form improvements for GUI part)
Because, this version 1.50 doesn't have adult content detection anymore…
Also, these both have PRO's and CON's (1.42 is probably a lot faster, whereas 1.50 is a little more advanced with its features and that way slower)
So, I'd say they are both pretty good.. With different kind of structures, of course. :)
Script is attached!
Regards,
-Jani
