Janilabo | ItemDB (Simba)

const
  NAME_SEARCH = VK_F10;
  ID_SEARCH = VK_F11;
  STOP = VK_F12; // Doesn't stop script if search is in process.

type
  TItem = record
    name, description: string;
    basePrice: Integer;
    wieldable, stackable: Boolean;
  end;
  TItemDatabase = array of TItem;

var
  ItemDB: TItemDatabase;
  IDs: TIntegerArray;
  t, item_count: Integer;

function Expand(trgt_pos: Integer; s1, s2, str: string): string;
var
  l, p, start, finish, s1L, s2L: Integer;
  tmp: string;
begin
  l := Length(str);
  s1L := Length(s1);
  s2L := Length(s2);
  if ((s1L > l) or (s2L > l) or (trgt_pos > l) or (trgt_pos < 1)) then
    Exit;
  finish := PosEx(s2, str, trgt_pos);
  if ((finish < 1) or (finish = trgt_pos)) then
    Exit;
  tmp := Copy(str, 1, trgt_pos);
  repeat
    p := PosEx(s1, tmp, (p + 1));
    if (p > 0) then
      start := p;
  until (p <= 0);
  if ((start <> trgt_pos) and (start > 0) and (finish > 0) and (start < finish)) then
    Result := Copy(str, (start + s1L), ((finish - start) - s2L));
  tmp := '';
end;

function LoadXMLItemDB(file_path: string): TItemDatabase;
var
  i, xmlF: Integer;
  xmlFD, tmp: string;
begin
  if (Lowercase(Copy(file_path, (Length(file_path) - 3), 4)) <> '.xml') then
    Exit;
  if FileExists(file_path) then
  begin
    xmlF := OpenFile(file_path, False);
    ReadFileString(xmlF, xmlFD, FileSize(xmlF));
    CloseFile(xmlF);
    xmlFD := Between('<ItemDef-array>', '</ItemDef-array>', xmlFD);
    if (xmlFD <> '') then
    begin
      SetLength(Result, 439);
      for i := 0 to 438 do
      begin
        tmp := Expand(Pos(('<sprite>' + IntToStr(i) + '</sprite>'), xmlFD), '<ItemDef>', '</ItemDef>', xmlFD);
        with Result[i] do
        begin
          name := Between('<name>', '</name>', tmp);
          description := Between('<description>', '</description>', tmp);
          basePrice := StrToIntDef(Between('<basePrice>', '</basePrice>', tmp), 0);
          wieldable := StrToBoolDef(Between('<wieldable>', '</wieldable>', tmp), False);
          stackable := StrToBoolDef(Between('<stackable>', '</stackable>', tmp), False);
        end;
        tmp := '';
      end;
    end;
    xmlFD := '';
  end;
end;

function SearchItemsByID: TIntegerArray;
var
  h, i, c: Integer;
  s: string;
  tmp: TStringArray;
begin
  if InputQuery('Search Items with ID', 'Please enter Item IDs below, separate with comma (,).', s) then
    if (s <> '') then
    begin
      s := Replace(s, ' ', '', [rfReplaceAll]);
      if (s <> '') then
      begin
        tmp := Explode(',', s);
        h := High(tmp);
        SetLength(Result, (h + 1));
        for i := 0 to h do
          if (StrToIntDef(tmp[i], -1) <> -1) then
          begin
            Result[c] := StrToInt(tmp[i]);
            Inc(c);
          end;
        SetLength(tmp, 0);
        SetLength(Result, c);
      end else
        SetLength(Result, 0);
    end else
      SetLength(Result, 0);
end;

function SearchItemsByName: TIntegerArray;
var
  s: string;
  i, r: Integer;
begin
  if InputQuery('Search Items with Name', 'Please enter name (part) of the item below.', s) then
    if (s <> '') then
    begin
      s := Trim(Lowercase(s));
      SetLength(Result, item_count);
      for i := 0 to (item_count - 1) do
        if (Pos(s, Lowercase(ItemDB[i].name)) > 0) then
        begin
          Result[r] := i;
          Inc(r);
        end;
      SetLength(Result, r);
    end else
      SetLength(Result, 0);
end;

procedure PrintNames(IDs: TIntegerArray);
var
  h, i, c: Integer;
  tmp: TStringArray;
begin
  ClearDebug;
  h := High(IDs);
  if (h < 0) then
  begin
    WriteLn('Search found 0 items.');
    Exit;
  end;
  ClearSameIntegers(IDs);
  h := High(IDs);
  SetLength(tmp, (h + 1));
  for i := 0 to h do
    if InRange(IDs[i], 0, item_count) then
    begin
      tmp[c] := ('Item[' + IntToStr(IDs[i]) + '] - ' + ItemDB[IDs[i]].name);
      Inc(c);
    end;
  SetLength(tmp, c);
  if (c = 1) then
    WriteLn('Search found 1 item:')
  else
    WriteLn('Search found ' + IntToStr(c) + ' items:');
  if (c > 0) then
  begin
    for i := 0 to (c - 1) do
      WriteLn(tmp[i]);
    SetLength(tmp, 0);
  end else
    WriteLn('Search found 0 items.');
end;

procedure PrintItems(IDs: TIntegerArray);
var
  h, i: Integer;
begin
  ClearDebug;
  h := High(IDs);
  if (h < 0) then
    Exit;
  ClearSameIntegers(IDs);
  h := High(IDs);
  for i := 0 to h do
    if InRange(IDs[i], 0, item_count) then
    begin
      WriteLn('Item[' + IntToStr(IDs[i]) + ']' + #13#10 +
              'Name: ' + ItemDB[IDs[i]].name + #13#10 +
              'Description: ' + ItemDB[IDs[i]].description);
      if ItemDB[IDs[i]].wieldable then
        WriteLn('Wieldable: Yes')
      else
        WriteLn('Wieldable: No');
      if ItemDB[IDs[i]].stackable then
        WriteLn('Stackable: Yes')
      else
        WriteLn('Stackable: No');
      if (i < h) then
        WriteLn('');
    end;
end;

begin
  ClearDebug;
  WriteLn('Loading Item Database - Please wait...');
  t := GetSystemTime;
  ItemDB := LoadXMLItemDB(ScriptPath + 'ItemDef.xml');
  item_count := Length(ItemDB);
  WriteLn('Loaded ' + IntToStr(item_count) + ' items in ' + IntToStr(GetSystemTime - t) + ' ms!');
  WriteLn('READY TO GO!');
  if (item_count < 1) then
  begin
    WriteLn('Failed to load Item Database.');
    TerminateScript;
  end;
  repeat
    if IsKeyDown(NAME_SEARCH) then
    begin
      IDs := SearchItemsByName;
      PrintNames(IDs);
      Wait(250);
    end;
    if IsKeyDown(ID_SEARCH) then
    begin
      IDs := SearchItemsByID;
      PrintItems(IDs);
      Wait(250);
    end;
    Wait(10);
  until IsKeyDown(STOP);
  SetLength(ItemDB, 0);
end.