MMBN56MM/unit1.pas

309 lines
7.6 KiB
ObjectPascal
Raw Normal View History

2024-01-11 14:31:18 +03:00
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
Buttons, Grids, IniFiles;
2024-01-11 14:31:18 +03:00
type
{ TForm1 }
TForm1 = class(TForm)
plus_spoil: TButton;
2024-01-11 14:31:18 +03:00
edit_room_button: TButton;
minus_spoil1: TButton;
spoils_label: TLabel;
spoils_listbox: TListBox;
2024-01-11 14:31:18 +03:00
map_image: TImage;
room_name_label: TLabel;
start_stop_button: TSpeedButton;
Timer1: TTimer;
procedure edit_room_buttonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure map_imagePaint(Sender: TObject);
procedure minus_spoil1Click(Sender: TObject);
procedure plus_spoilClick(Sender: TObject);
procedure spoils_listboxDblClick(Sender: TObject);
2024-01-11 14:31:18 +03:00
procedure start_stop_buttonClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
uses Windows, 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
2024-01-11 14:31:18 +03:00
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
2024-01-11 14:31:18 +03:00
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;
2024-01-11 14:31:18 +03:00
var
NumberOfBytesRead: SIZE_T;
begin
Result := ReadProcessMemory(hProcess, Address, @Buffer, Size, NumberOfBytesRead) and
(NumberOfBytesRead = Size);
2024-01-11 14:31:18 +03:00
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
2024-01-11 14:31:18 +03:00
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;
2024-01-11 14:31:18 +03:00
{$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;
2024-01-11 14:31:18 +03:00
end;
procedure TForm1.FormDestroy(Sender: TObject);
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;
2024-01-11 14:31:18 +03:00
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.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;
2024-01-11 14:31:18 +03:00
end;
procedure TForm1.start_stop_buttonClick(Sender: TObject);
var
i: integer;
ProcID: DWORD;
2024-01-11 14:31:18 +03:00
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;
2024-01-11 14:31:18 +03:00
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
spoils_listbox.Height := spoils_listbox.Items.Count * spoils_listbox.ItemHeight;
2024-01-11 14:31:18 +03:00
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;
2024-01-11 14:31:18 +03:00
end;
end
else
begin
room_name_label.Caption := 'Error. Make sure the game is running';
2024-01-11 14:31:18 +03:00
end;
except
on edit_room_button: Exception do
room_name_label.Caption := 'Error';
2024-01-11 14:31:18 +03:00
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;
2024-01-11 14:31:18 +03:00
end;
end.