Code:
{=======================================================================================]
| |
| _____ _ _ _____ _ _ _____ |
| | __|_|_____| |_ ___ | __|___ ___|_|___| |_ | __|___ ___ ___ ___ ___ ___ |
| |__ | | | . | .'| |__ | _| _| | . | _| |__ | _| .'| | | -_| _| |
| |_____|_|_|_|_|___|__,| |_____|___|_| |_| _|_| |_____|___|__,|_|_|_|_|___|_| |
| |_| |
| |
[=======================================================================================}
{$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.
@