ufrmmain.pas

在exe指定位置写入EXE的CRC校验值

unit ufrmmain;

interface

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

type
  TFrmMain = class(TForm)
    gbox: TGroupBox;
    btnexit: TBitBtn;
    btnrun: TButton;
    btnsel: TSpeedButton;
    edtfile: TLabeledEdit;
    memvalue: TMemo;
    edtaddr: TLabeledEdit;
    OpenDlg: TOpenDialog;
    lblnum: TLabel;
    lblpos: TLabel;
    procedure btnselClick(Sender: TObject);
    procedure btnrunClick(Sender: TObject);
    procedure memvalueChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

function WriteExe(ExeFile: PChar; pos: Integer; value: string): Integer;
  procedure WriteStringToStream(fstream: TStream; str: string);
  var
    MySize: Integer;
  begin
    // 先写入值...
    fstream.WriteBuffer(str[1], Length(str)*SizeOf(Char));
    // 在写入值的偏移...
    MySize := Length(str)*SizeOf(Char) + SizeOf(MySize);
    fstream.WriteBuffer(MySize, SizeOf(MySize));
  end;
var
  fstream: TFileStream;
begin
  Result  := -1;
  fstream := TFileStream.Create(ExeFile, fmOpenWrite or fmShareExclusive);
  try
    if pos = -1 then
      fstream.Seek(0, soFromEnd)
    else
      fstream.Position := pos;
    // 写入Value值....
    WriteStringToStream(fstream, value);
    Result := fstream.Position;
  finally
    fstream.Free;
  end;
end;

procedure TFrmMain.btnselClick(Sender: TObject);
var
  _file: string;
begin
  if OpenDlg.Execute then
  begin
    _file := OpenDlg.FileName;
    if _file <> '' then
    begin
      edtfile.Text := _file;
    end;
  end;
end;

procedure TFrmMain.btnrunClick(Sender: TObject);
var
  _ret: Integer;
begin
  if (edtfile.Text <> '') then
  begin
    if memvalue.Text = '' then
    begin
      MessageBox(Handle, PChar('参数不完整，请您先输入要写入的值。'), '提示', MB_ICONINFORMATION or MB_OK);
      Exit;
    end else
    begin
      _ret := WriteExe(PChar(edtfile.Text), StrToInt(edtaddr.Text), memvalue.Text);
      if _ret <> -1 then
      begin
        lblpos.Caption := '写入结果位置: ' + IntToStr(_ret);
        MessageBox(Handle, PChar('写入文件成功 - [' + IntToStr(_ret) + ']，请查看。。。'), '提示', MB_ICONINFORMATION or MB_OK);
      end;
    end;
  end;
end;

procedure TFrmMain.memvalueChange(Sender: TObject);
begin
  lblnum.Caption := '计：' + IntToStr(Length(memvalue.Text));
end;

end.