delphi 打开修改其他程序内存

传奇3G大补贴V1.94G破解之本地服务器版源程序 ( 积分：1, 回复：0, 阅读：13 )
分类：Internet/TCPIP ( 版主：luyear, robertcool ) 
来自：scottrayn, 时间：2005-12-30 18:29:00, ID：3314213 [显示：小字体 | 大字体] 

unit Main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, ScktComp;

const
 Head = 'HTTP/1.1 200 OK';
 //Date1 = 'Date: Thu, 12 May 2005 05:16:59 GMT';
 Server = 'Server: Apache/2.0.54 (Win32) PHP/4.3.11';
 Powered = 'X-Powered-By: PHP/4.3.11';
 Len1 = 'Content-Length: 382';
 Content = 'Content-Type: text/html';
 Space = Char(#13) + Char(#10);

const
 Address1 = $471E7E;
 PokeValue1 = $90;
 Address2 = $471E7F;
 PokeValue2 = $90;
 Address3 = $471EAA;
 PokeValue3 = $EB;
 Address4 = $471EB4;
 PokeValue4 = $8E;
 NumberOfBytes = 1;

type
 TFrmMain = class(TForm)
  BTNStart: TButton;
  Label1: TLabel;
  Edit1: TEdit;
  Panel1: TPanel;
  TS1: TServerSocket;
  procedure BTNStartClick(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure TS1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
  procedure TS1ClientError(Sender: TObject; Socket: TCustomWinSocket;
   ErrorEvent: TErrorEvent; var ErrorCode: Integer);
 private
  { Private declarations }
 public
  { Public declarations }
 end;

var
 FrmMain: TFrmMain;
 H: HWND;
 ProcessId: Integer;
 ThreadId: Integer;
 buf: PChar;
 lpNumberOfBytesWrite: Cardinal;
implementation

{$R *.dfm}

procedure TFrmMain.BTNStartClick(Sender: TObject);
var
 X: Integer;
begin
 H := FindWindow(nil, '传奇3大补帖1.94');
 if H = 0 then
 begin
  Application.MessageBox('本程序只适用于传奇3大补帖1.94版，' + #13 + #13 + '请先运行传奇3大补帖1.94。', '错误');
  exit;
 end;

 X := StrtoInt(Edit1.Text);
 if (X >= 65535) or (X <= 1024) then
 begin
  Application.MessageBox('该端口保留，请使用大于1024且小于65535的端口！', '错误');
  exit;
 end;

 TS1.Port := StrtoInt(Edit1.Text);
 try
  begin
   ThreadId := GetWindowThreadProcessId(H, @ProcessId);
   H := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId);
   GetMem(buf, 1);
   buf^ := Chr(PokeValue1);
   WriteProcessMemory(H, ptr(Address1), buf, NumberOfBytes, lpNumberOfBytesWrite);
   buf^ := Chr(PokeValue2);
   WriteProcessMemory(H, ptr(Address2), buf, NumberOfBytes, lpNumberOfBytesWrite);
   buf^ := Chr(PokeValue3);
   WriteProcessMemory(H, ptr(Address3), buf, NumberOfBytes, lpNumberOfBytesWrite);
   buf^ := Chr(PokeValue4);
   WriteProcessMemory(H, ptr(Address4), buf, NumberOfBytes, lpNumberOfBytesWrite);
   FreeMem(buf);
   CloseHandle(H);

   TS1.Active := True;
   Edit1.Enabled := False;
   BTNStart.Enabled := False;
  end;
 except
  begin
   Application.MessageBox('您所选用的端口，有可能系统正在使用，请调整！', '错误');
  end;
 end;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 TS1.Active := False;
end;

procedure TFrmMain.TS1ClientRead(Sender: TObject;
 Socket: TCustomWinSocket);
var
 TmpStr: string;
 Date1: string;
begin
 TmpStr := Socket.ReceiveText;
 Sleep(1000);
 Date1 := 'Date:' + DatetoStr(Date) + ' ' + TimetoStr(Time) + ' GMT';
 Socket.SendText(Head + Space + Date1 + Space + Server + Space + Powered + Space + Len1 + Space + Content + Space + Space + '#999999' + Space + 'WkdGdWJubGphRzkxCjcxMTI1NDA1Ck56RXhNalUwTURZPQowMzdmOGYzYTM1ZmM2ZGRlZmM1NmEyZTUyZDAxNGNmNwo3ZDkyZTI2NzI3MzQyNDNjNTkwZWQ4YmJmZmIxNjE1NQ==' + Space + 'ZDM1ODBjNzQyZjgxZDM0ZTI2NjBjOWUxMmE2Y2Y3ZmU=' + Space + 'Zx/nP1zwtTNR2s5vyJrcDnWthAQ=');
 Application.Terminate;
end;

procedure TFrmMain.TS1ClientError(Sender: TObject;
 Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
 var ErrorCode: Integer);
begin
 ErrorCode := 0;
end;

end.