MMBN56MM/unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  Buttons, Grids, IniFiles, Windows;

type
  TWMHotKey = packed record
    MSG: cardinal;
    HotKey: PtrInt;
    Unused: PtrInt;
    Result: PtrInt;
  end;


type

  { TForm1 }

  TForm1 = class(TForm)
    map_stretch_checkbox: TCheckBox;
    plus_spoil: TButton;
    edit_room_button: TButton;
    minus_spoil1: TButton;
    spoils_label: TLabel;
    spoils_listbox: TListBox;
    map_image: TImage;
    room_name_label: TLabel;
    start_stop_button: TSpeedButton;
    Timer1: TTimer;
    procedure edit_room_buttonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure map_imagePaint(Sender: TObject);
    procedure map_stretch_checkboxChange(Sender: TObject);
    procedure minus_spoil1Click(Sender: TObject);
    procedure plus_spoilClick(Sender: TObject);
    procedure spoils_listboxDblClick(Sender: TObject);
    procedure start_stop_buttonClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private

  public

  protected
    procedure WMHotKey(var MSG: TWMHotKey); message WM_HOTKEY;

  end;

var
  Form1: TForm1;

implementation


uses JwaTlHelp32;

function FindProcessID(const ExeFileName: string): DWORD;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
    begin
      Result := FProcessEntry32.th32ProcessID;
      Break;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;

  CloseHandle(FSnapshotHandle);
end;



function ReadMemory(hProcess: THandle; Address: Pointer; var Buffer;
  Size: DWORD): boolean;
var
  NumberOfBytesRead: SIZE_T;
begin
  Result := ReadProcessMemory(hProcess, Address, @Buffer, Size, NumberOfBytesRead) and
    (NumberOfBytesRead = Size);
end;

procedure ListRunningProcesses(ProcList: TStrings);
var
  pProc: TProcessEntry32;
  pSnap: THandle;
  pBool: BOOL;
begin
  ProcList.Clear;
  pProc.dwSize := SizeOf(pProc);
  pSnap := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  pBool := Process32First(pSnap, pProc);
  while integer(pBool) <> 0 do
  begin
    ProcList.Add(pProc.szExeFile);
    pBool := Process32Next(pSnap, pProc);
  end;
  CloseHandle(pSnap);
end;



var
  hProcess: THandle;
  ROOMS: TIniFile; // contains room labels
  process_list: TStrings;
  room: smallint = -1; // contains current room 16-bit value
  last_room: smallint = -1;
  room_name: string;
  new_room: bool;
  spoils_list: string;
  spoils: TStringArray;
  fullscreen_map: bool = False;

var
  x, y, w, h: integer;
  state: TWindowState;

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  // open ini file and create a list to hold processes
  ROOMS := TIniFile.Create('rooms.ini');
  process_list := TStringList.Create();
  spoils_listbox.Height := 0;
  if not RegisterHotKey(Handle, 111000, MOD_WIN, VK_Y) then
    ShowMessage('HotKey registration failed. You won''t be able to press Win+Y to temporarily view map in full screen.');
end;

procedure TForm1.map_imagePaint(Sender: TObject);
begin
  //map_image.Canvas.Brush.Style := bsClear;
  //map_image.Canvas.Rectangle(0, 0, 400, 400);
end;

procedure TForm1.map_stretch_checkboxChange(Sender: TObject);
begin
  map_image.Proportional := not map_stretch_checkbox.Checked;
end;

procedure TForm1.minus_spoil1Click(Sender: TObject);
var
  Txt: string;
  i: integer;
begin
  if (spoils_listbox.ItemIndex > -1) then
  begin
    spoils_listbox.Items.Delete(spoils_listbox.ItemIndex);
    for i := 0 to spoils_listbox.Items.Count - 1 do
    begin
      if i < spoils_listbox.Items.Count - 1 then
        Txt := Txt + spoils_listbox.Items[i] + ','
      else
        Txt := Txt + spoils_listbox.Items[i];
    end;
    ROOMS.WriteString('Spoils', IntToStr(room), Txt);
  end;
  spoils_listbox.ClearSelection;
end;

procedure TForm1.plus_spoilClick(Sender: TObject);
var
  new_spoil_name: string;
var
  Txt: string;
  i: integer;
begin
  if InputQuery('Adding item to Room #' + IntToStr(room), 'Enter item''s name',
    new_spoil_name) then
  begin
    spoils_listbox.Items.Add(new_spoil_name);
    for i := 0 to spoils_listbox.Items.Count - 1 do
    begin
      if i < spoils_listbox.Items.Count - 1 then
        Txt := Txt + spoils_listbox.Items[i] + ','
      else
        Txt := Txt + spoils_listbox.Items[i];
    end;
    ROOMS.WriteString('Spoils', IntToStr(room), Txt);
  end;
  spoils_listbox.ClearSelection;
end;

procedure TForm1.spoils_listboxDblClick(Sender: TObject);
var
  new_spoil_name: string;
var
  Txt: string;
  i: integer;
begin
  if (spoils_listbox.ItemIndex > -1) then
  begin
    new_spoil_name := spoils_listbox.Items[spoils_listbox.ItemIndex];
    if InputQuery('Editing item in Room #' + IntToStr(room),
      'Enter item''s name', new_spoil_name) then
    begin
      spoils_listbox.Items[spoils_listbox.ItemIndex] := new_spoil_name;
      for i := 0 to spoils_listbox.Items.Count - 1 do
      begin
        if i < spoils_listbox.Items.Count - 1 then
          Txt := Txt + spoils_listbox.Items[i] + ','
        else
          Txt := Txt + spoils_listbox.Items[i];
      end;
      ROOMS.WriteString('Spoils', IntToStr(room), Txt);

    end;
  end;
  spoils_listbox.ClearSelection;
end;

procedure TForm1.start_stop_buttonClick(Sender: TObject);
var
  i: integer;
  ProcID: DWORD;

begin
  if start_stop_button.Down = False then
  begin
    start_stop_button.Caption := 'Start';
    Timer1.Enabled := False;
    CloseHandle(hProcess);
  end
  else
  begin
    start_stop_button.Caption := 'Stop';
    ListRunningProcesses(process_list);
    for i := 0 to process_list.Count - 1 do
    begin
      if (process_list[i] = 'MMBN_LC2.exe') then
      begin
        ProcID := FindProcessID(process_list[i]);
        hProcess := OpenProcess(PROCESS_VM_READ, False, ProcID);
        Caption := 'MMBN5M: Reading from process ID ' + IntToStr(ProcID);
        Timer1.Enabled := True;
        break;
      end;
    end;
  end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  spoils_listbox.Height := spoils_listbox.Items.Count * spoils_listbox.ItemHeight;


  if hProcess <> 0 then
  begin
    try
      if ReadMemory(hProcess, Pointer($80205FF4), room, SizeOf(room)) then
      begin
        if (last_room <> room) or (new_room) then
        begin
          new_room := False;
          last_room := room;
          room_name := ROOMS.ReadString('Rooms', IntToStr(room), 'Unknown');
          room_name_label.Caption := 'Room #' + IntToStr(room) + ': ' + room_name;
          spoils_list := ROOMS.ReadString('Spoils', IntToStr(room), '');
          spoils_listbox.Items.Clear;
          if (spoils_list <> '') then
          begin
            spoils := spoils_list.Split(',');
            spoils_listbox.Items.AddStrings(spoils);
          end;

          if FileExists('images/' + room_name + '.png') then
          begin
            map_image.Picture.LoadFromFile('images/' + room_name + '.png');
          end
          else
          begin
            map_image.Picture.Clear;
          end;
        end;
      end
      else
      begin
        room_name_label.Caption := 'Error. Make sure the game is running';
      end;
    except
      on edit_room_button: Exception do
        room_name_label.Caption := 'Error';
    end;
  end;

end;

procedure TForm1.edit_room_buttonClick(Sender: TObject);
var
  new_room_name: string;
begin
  new_room_name := room_name;
  if InputQuery('Editing Room # ' + IntToStr(room), 'Enter this Room''s name',
    new_room_name) then
  begin
    ROOMS.WriteString('Rooms', IntToStr(room), new_room_name);
    new_room := True;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  //  close the process on exit if it's been opened
  if start_stop_button.Down = True then
  begin
    Timer1.Enabled := False;
    CloseHandle(hProcess);
  end;
  // free additionally created objects
  ROOMS.Free;
  process_list.Free;
  UnregisterHotKey(Handle, 111000);
end;


procedure TForm1.WMHotKey(var MSG: TWMHotKey);
begin
  fullscreen_map := not fullscreen_map;
  Form1.Caption := (BoolToStr(fullscreen_map));
  Form1.Visible := False;
  if (fullscreen_map = True) then
  begin
    x := Form1.Left;
    y := Form1.top;
    w := Form1.Width;
    h := Form1.Height;
    state := Form1.WindowState;
    Form1.FormStyle := fsStayOnTop;
    Form1.BorderStyle := bsNone;
    Form1.Left := 0;
    Form1.Top := 0;
    form1.Width := Screen.Width;
    Form1.Height := Screen.Height;
  end
  else
  begin
    Form1.FormStyle := fsNormal;
    Form1.BorderStyle := bsSingle;
    Form1.Left := x;
    Form1.Top := y;
    form1.Width := w;
    Form1.Height := h;
    Form1.WindowState := state;
  end;
  Form1.Visible := True;
  RegisterHotKey(Handle, 111000, MOD_WIN, VK_Y);

end;

end.