Lingo Trainer+3 :D

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.