Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit UMain;
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ExtCtrls, StdCtrls, TlHelp32;
- type
- TFrmMain = class(TForm)
- TmrFader: TTimer;
- LblB1: TLabel;
- LblB2: TLabel;
- LblB3: TLabel;
- LblB4: TLabel;
- LblB5: TLabel;
- BtnBAll: TButton;
- BtnB2: TButton;
- BtnB3: TButton;
- BtnB4: TButton;
- BtnB5: TButton;
- BtnGod: TButton;
- ChkGod: TCheckBox;
- TmrLife: TTimer;
- procedure FormCreate(Sender: TObject);
- procedure TmrFaderTimer(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure BtnBAllClick(Sender: TObject);
- procedure BtnB2Click(Sender: TObject);
- procedure BtnB3Click(Sender: TObject);
- procedure BtnB4Click(Sender: TObject);
- procedure BtnB5Click(Sender: TObject);
- procedure ChkGodClick(Sender: TObject);
- procedure TmrLifeTimer(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- function OpenPokeProcess: boolean;
- function ClosePokeProcess: boolean;
- function ReadWord: string;
- function WriteLife: boolean;
- end;
- var
- FrmMain: TFrmMain;
- g_bFadeUp: boolean = true;
- g_hProcess: THandle;
- g_sPoke: string = '';
- const
- POKE_WORD = $0040ACF0;
- POKE_LIFE = $0040B02C;
- POKE_PROCESS = 'LINGO.EXE';
- implementation
- {$R *.dfm}
- function TFrmMain.OpenPokeProcess: boolean;
- var
- dwPID: DWORD;
- oPEntry: TProcessEntry32;
- oPSnap: THandle;
- sExeFile: string;
- begin
- dwPID := 0;
- Result := true;
- oPSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
- oPEntry.dwSize := SizeOf(oPEntry);
- try
- if Process32First(oPSnap, oPEntry) then
- repeat
- sExeFile := UpperCase(ExtractFileName(StrPas(oPEntry.szExeFile)));
- if sExeFile = POKE_PROCESS then
- begin
- dwPID := oPEntry.th32ProcessID;
- Break;
- end;
- until not Process32Next(oPSnap, oPEntry);
- if dwPID = 0 then
- Result := false;
- except
- CloseHandle(oPSnap);
- Result := false;
- Exit;
- end;
- if not Result then
- Exit;
- g_hProcess := OpenProcess(PROCESS_VM_READ or PROCESS_VM_WRITE or PROCESS_VM_OPERATION, false, dwPID);
- if g_hProcess = INVALID_HANDLE_VALUE then
- begin
- Result := false;
- Exit;
- end;
- end;
- function TFrmMain.ClosePokeProcess: boolean;
- begin
- if g_hProcess <> 0 then
- CloseHandle(g_hProcess);
- Result := true;
- end;
- function TFrmMain.ReadWord: string;
- var
- acPoke: array[0..4] of char;
- dwBytes: DWORD;
- begin
- if not OpenPokeProcess then
- begin
- MessageBox(0, 'Lingo is not running!', 'FAIL', MB_OK or MB_ICONSTOP);
- Application.Terminate;
- end
- else
- begin
- ReadProcessMemory(g_hProcess, Ptr(POKE_WORD), @acPoke, SizeOf(acPoke), dwBytes);
- g_sPoke := acPoke;
- ClosePokeProcess;
- end;
- end;
- function TFrmMain.WriteLife: boolean;
- var
- byPoke: byte;
- dwBytes: DWORD;
- begin
- if not OpenPokeProcess then
- begin
- ChkGod.Checked := false;
- TmrLife.Enabled := false;
- MessageBox(0, 'Lingo is not running!', 'FAIL', MB_OK or MB_ICONSTOP);
- Application.Terminate;
- end
- else
- begin
- ReadProcessMemory(g_hProcess, Ptr(POKE_LIFE), @byPoke, SizeOf(byPoke), dwBytes);
- if byPoke <= 1 then
- byPoke := 1;
- WriteProcessMemory(g_hProcess, Ptr(POKE_LIFE), @byPoke, SizeOf(byPoke), dwBytes);
- ClosePokeProcess;
- end;
- Result := true;
- end;
- procedure TFrmMain.FormCreate(Sender: TObject);
- begin
- Application.Title := FrmMain.Caption;
- if not OpenPokeProcess then
- begin
- MessageBox(0, 'Lingo is not running!', 'FAIL', MB_OK or MB_ICONSTOP);
- Application.Terminate;
- end;
- TmrFader.Enabled := true;
- end;
- procedure TFrmMain.TmrFaderTimer(Sender: TObject);
- var
- byAlpha: byte;
- begin
- byAlpha := FrmMain.AlphaBlendValue;
- if g_bFadeUp then
- begin
- if byAlpha < 220 then
- Inc(byAlpha, 10)
- else
- begin
- TmrFader.Enabled := false;
- g_bFadeUp := false;
- end;
- end
- else
- begin
- if byAlpha > 0 then
- Dec(byAlpha, 10)
- else
- begin
- TmrFader.Enabled := false;
- ClosePokeProcess;
- Application.Terminate;
- end;
- end;
- FrmMain.AlphaBlendValue := byAlpha;
- end;
- procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- Action := caNone;
- if not TmrFader.Enabled then
- TmrFader.Enabled := true;
- end;
- procedure TFrmMain.BtnBAllClick(Sender: TObject);
- begin
- ReadWord;
- LblB1.Color := clRed;
- LblB2.Color := clRed;
- LblB3.Color := clRed;
- LblB4.Color := clRed;
- LblB5.Color := clRed;
- LblB1.Caption := g_sPoke[1];
- LblB2.Caption := g_sPoke[2];
- LblB3.Caption := g_sPoke[3];
- LblB4.Caption := g_sPoke[4];
- LblB5.Caption := g_sPoke[5];
- end;
- procedure TFrmMain.BtnB2Click(Sender: TObject);
- begin
- ReadWord;
- LblB1.Color := clSilver;
- LblB2.Color := clRed;
- LblB3.Color := clSilver;
- LblB4.Color := clSilver;
- LblB5.Color := clSilver;
- LblB1.Caption := '?';
- LblB2.Caption := g_sPoke[2];
- LblB3.Caption := '?';
- LblB4.Caption := '?';
- LblB5.Caption := '?';
- end;
- procedure TFrmMain.BtnB3Click(Sender: TObject);
- begin
- ReadWord;
- LblB1.Color := clSilver;
- LblB3.Color := clRed;
- LblB2.Color := clSilver;
- LblB4.Color := clSilver;
- LblB5.Color := clSilver;
- LblB1.Caption := '?';
- LblB3.Caption := g_sPoke[3];
- LblB2.Caption := '?';
- LblB4.Caption := '?';
- LblB5.Caption := '?';
- end;
- procedure TFrmMain.BtnB4Click(Sender: TObject);
- begin
- ReadWord;
- LblB1.Color := clSilver;
- LblB4.Color := clRed;
- LblB3.Color := clSilver;
- LblB2.Color := clSilver;
- LblB5.Color := clSilver;
- LblB1.Caption := '?';
- LblB4.Caption := g_sPoke[4];
- LblB3.Caption := '?';
- LblB2.Caption := '?';
- LblB5.Caption := '?';
- end;
- procedure TFrmMain.BtnB5Click(Sender: TObject);
- begin
- ReadWord;
- LblB1.Color := clSilver;
- LblB5.Color := clRed;
- LblB3.Color := clSilver;
- LblB4.Color := clSilver;
- LblB2.Color := clSilver;
- LblB1.Caption := '?';
- LblB5.Caption := g_sPoke[5];
- LblB3.Caption := '?';
- LblB4.Caption := '?';
- LblB2.Caption := '?';
- end;
- procedure TFrmMain.ChkGodClick(Sender: TObject);
- begin
- TmrLife.Enabled := ChkGod.Checked;
- end;
- procedure TFrmMain.TmrLifeTimer(Sender: TObject);
- begin
- WriteLife;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement