Results 1 to 2 of 2

Thread: Error: Exception: List index exceeds bounds (0)

  1. #1
    Join Date
    Sep 2010
    Posts
    5,762
    Mentioned
    136 Post(s)
    Quoted
    2739 Post(s)

    Default Error: Exception: List index exceeds bounds (0)

    Never gotten this error before:

    Code:
    Error: Exception: List index exceeds bounds (0)
    I get it at this line:

    Simba Code:
    procedure SafeInitForm;
    var
      v: TVariantArray;
    begin
      SetLength(V, 0);
      ThreadSafeCall('InitForm', v);
    end;

    The threadsafecall

    Whole script:

    Simba 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;
      Memos: Array[0..1] of TMemo;
      TitleLabel: Array[0..1] of TLabel;
      Buttons: Array[0..1] of TButton;
      CheckBoxs : Array[0..4] of TCheckBox;
      originalScriptText, filteredScriptText, displayScriptText: string;
      HTTPThreats, WebThreats, BadCode, threats, FishyCode: Integer;
      msgHTTP, msgWeb, msgBad, msgFishy: string;
      pressed, HTTPscan, webScan, codeScan:boolean;
      _threats: TThreatArray;
      linePositions: TIntegerArray;
      Tab1, Tab2, Tab3, tab4, tab5: TTabSheet;
      P: TPageControl;

    (*
      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], memos[0].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;
      pressed := true;
      if (CheckBoxs[0].Checked) then HTTPscan := true;
      if (CheckBoxs[1].Checked) then webScan := true;
      if (CheckBoxs[2].Checked) then codeScan := true;
      DsgnForm.CLOSE;
    end;
    (*
      Auther: Officer Barbrady
      Description: Starts the form.
    *)

    procedure InitForm;
    Var
      i, c, k, g:Integer;
      Strings:TStringArray;
      Points, Sizes:TPointArray;
      Parents:TIntegerArray;
    begin
      DsgnForm:=TForm.Create(nil);
      with DsgnForm do
        begin
          Caption:='Simba script scanner';
          Left:=377;
          Top:=380;
          Width:=750;
          Height:=460;
          Font.Name:=default;
          Font.Color:=clDefault;
          Font.Size:=0;
        end;
        begin
          P := TPageControl.Create(DsgnForm);
          P.Parent := DsgnForm;
          P.SetBounds(0, 0, 750, 460);
          Tab1 := TTabSheet.Create(P);
          Tab1.Caption := 'Script input';
          Tab1.Visible := true;
          Tab1.PageControl := P;
          Tab2 := TTabSheet.Create(P);
          Tab2.Caption := 'Scan settings';
          Tab2.Visible := true;
          Tab2.PageControl := P;
          tab2.PageControl := P;
          Tab3 := TTabSheet.Create(P);
          Tab3.Caption := 'Results';
          tab3.PageControl := P;
          Tab3.Visible := true;
          Tab3.PageControl := P;
        End;
      Strings := ['Paste script into this box, it will look for suspicious lines of code',''];
      Points := [Point(120,80),Point(160,90)];
      Sizes := [Point(481,177),Point(160,90)];
      Parents := [0, 1];
      for g:=0 to high(memos) do
      begin
        memos[g] := TMemo.Create(DsgnForm);
        memos[g].Parent:=P.Pages[(Parents[k])];
        memos[g].Left := Points[k].x;
        memos[g].Top := Points[k].y;
        memos[g].Width := Sizes[k].x;
        memos[g].Height := Sizes[k].y;
        memos[g].Font.Name := default;
        with memos[g].Lines do Add(Strings[g]);
        memos[g].ScrollBars := ssBoth;
        memos[g].TabOrder := 0;
      end;

      Strings := ['Script scanner version 2.0','Scan settings'];
      Points := [Point(225,20),Point(265,20)];
      Parents := [0, 1];
      for k:=0 to high(TitleLabel) do
      begin
        TitleLabel[k]:=TLabel.Create(DsgnForm);
        TitleLabel[k].Parent:=P.Pages[(Parents[k])];
        TitleLabel[k].Caption:=Strings[k];
        TitleLabel[k].Left:=Points[k].x;
        TitleLabel[k].Top:=Points[k].y;
        TitleLabel[k].Width:=43;
        TitleLabel[k].Height:=14;
        TitleLabel[k].Font.Name:=default;
        TitleLabel[k].Font.Color:=clDefault;
        TitleLabel[k].Font.Size:=17;
      end;
      Strings := ['Scan','Update'];
      Points := [Point(175,300),Point(400,300)];
      for i:= 0 to high(Buttons) do
        begin
          Buttons[i] := TButton.Create(DsgnForm);
          Buttons[i].Parent:=P.Pages[0];
          Buttons[i].Caption := Strings[i];
          Buttons[i].Left := Points[i].x;
          Buttons[i].Top := Points[i].y;
          Buttons[i].Width:=150;
          Buttons[i].Height:=25;
          Buttons[i].Font.Size:=12;
          case (i) of
            0: Buttons[i].OnClick:=@SaveFormInfo;
            1: Buttons[1].OnClick:=@OpenThread;
          end;
        end;
      Strings := ['Scan for HTTP threats','Scan for Webthreats','Scan for Bad code','Debug filtered script','Save filter script to file'];
      Points := [Point(80,350),Point(300,350),Point(500,350),Point(1,1),Point(30,30)];
      for c := 0 to high(CheckBoxs) do
      begin
        CheckBoxs[c] := TCheckBox.Create(DsgnForm);
        CheckBoxs[c].Parent:=P.Pages[1];
        CheckBoxs[c].Left := Points[c].x;
        CheckBoxs[c].Top  := Points[c].y;
        CheckBoxs[c].Width := 97;
        CheckBoxs[c].Caption := Strings[c];
      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.

  2. #2
    Join Date
    Mar 2008
    Posts
    426
    Mentioned
    1 Post(s)
    Quoted
    116 Post(s)

    Default

    I might be wrong.. But i had something similar.. n it was because i had

    Memos: Array[0..1] of TMemo;

    But i had multiple cases

    1:

    2:

    It would take me forever to decode your script so i thought id just post lol



Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •