リソースの書き換えについて (ID:41263)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

正攻法は私が知るかぎり無いです。
トリッキーな方法で実現させた事があったので、もう一度書いて見ました。
要は、リソースを変更した自分自身を作成して、元の自分は削除してしまうというプログラムです。今回はテキストにしていますが、Streamでまとめてますので、改変は楽だと思います。
アイディアは面白いですが、これを配布するのは相当チャレンジャーだと思います。
リソースは当然サイズ固定ですので、想定されるデータの最大値を予め確保して、
書き込み位置はリソースデータの相同性から判別しています。
（サイズが小さいと失敗する恐れあり）
コンパイルの回数が少なければ、決め打ちの方が良いと思います。
当方XE2なのでusesは適宜変更してください。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, UnitSpy;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;
  SpyHandle:HWND;

implementation

{$R *.dfm}
{$R mydata.res}
//mydata.res
//
//DATA BINARY "DATA.DAT"
//

procedure TForm1.Button1Click(Sender: TObject);
var
  aMS:TMemoryStream;
begin
  //リソース作成用
  aMS:=TMemoryStream.Create;
  SetStreamText(TStream(aMS),'初期設定');
  aMS.Size:=ResSize;
  aMS.SaveToFile('data.dat');
  aMS.Free;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  aDataStream:TMemoryStream;
  aMS:TMemoryStream;
begin
  aDataStream:=TMemoryStream.Create;
  GetDataResource(aDataStream);
  aMS:=TMemoryStream.Create;
  SetStreamText(TStream(aMS),Memo1.Text);
  aMS.Size:=ResSize;
  aMS.Position:=0;
  WriteCode(Application.ExeName,
            Application.ExeName + '_',
            aDataStream, aMS);
  Suicide(Application.ExeName, ExtractFileName(Application.ExeName) + '_');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Text := GetResText;
end;

end.

//--------------------------------------------------------
unit UnitSpy;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes;

const
  ResSize = 1000;

function GetStreamText(var aStream:TStream):string;
procedure SetStreamText(var aStream:TStream; aText:string);
function FindResDataInMS(aMS1,aMS2:TMemoryStream):Integer;
procedure WriteCode(aPath,aNewPath:string; aOriginalData,aData:TMemoryStream);
function GetResText:string;
procedure GetDataResource(var aMS:TMemoryStream);
procedure Suicide(aAppPath,aCopyName:string);

implementation

function GetStreamText(var aStream:TStream):string;
var
  i:Integer;
begin
  aStream.Read(i,SizeOf(i));
  SetLength(Result,i);
  aStream.Read(Result[1],i*SizeOf(Char));
end;

procedure SetStreamText(var aStream:TStream; aText:string);
var
  i:Integer;
begin
  i:=Length(aText);
  aStream.Write(i,SizeOf(i));
  aStream.Write(aText[1],i*SizeOf(Char));
end;

procedure GetDataResource(var aMS:TMemoryStream);
var
  aRS:TResourceStream;
begin
  aRS:=TResourceStream.Create(hinstance,'DATA','BINARY');
  aMS.LoadFromStream(aRS);
  aRS.Free;
end;

function FindResDataInMS(aMS1,aMS2:TMemoryStream):Integer;
var
  aSize:Integer;
  s1,s2:AnsiString;
begin
  aSize := aMS1.Size div SizeOf(AnsiChar);
  SetLength(s1,aSize);
  aMS1.Position:=0;
  aMS1.Read(s1[1],aMS1.Size);
  aSize := aMS2.Size div SizeOf(AnsiChar);
  SetLength(s2,aSize);
  aMS2.Position:=0;
  aMS2.Read(s2[1],aMS2.Size);

Result := Pos(s2,s1);
end;

procedure WriteCode(aPath,aNewPath:string; aOriginalData,aData:TMemoryStream);
var
  i:Integer;
  mStream:TMemoryStream;
begin
  mStream:=TMemoryStream.Create;
  mStream.LoadFromFile(aPath);
  i:= FindResDataInMS(mStream,aOriginalData);
  if i>=1 then
  begin
    mStream.Position:=i-1;
    mStream.Write(aData.Memory^,aData.Size);
    mStream.SaveToFile(aNewPath);
  end;
  mStream.Free;
end;

function GetResText:string;
var
  aMS:TMemoryStream;
begin
  aMS:=TMemoryStream.Create;
  GetDataResource(aMS);
  aMS.Position:=0;
  Result:=GetStreamText(TStream(aMS));
  aMS.Free;
end;

//http://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/samples/00578.html
procedure Suicide(aAppPath,aCopyName:string);
var
  aCommand:TStringList;
  aBatName,aAppName:string;

SI: TStartupInfo;
  PI: TProcessInformation;
  CommandLineStr: String;
begin
  aBatName:='del.bat';
  aAppName:=ExtractFileName(aAppPath);
  aCommand:=TStringList.Create;
  aCommand.Add('@ECHO OFF');
  aCommand.Add(':loop');
  aCommand.Add('del ' + aAppName);
  aCommand.Add('if exist '+aAppName+' goto :loop');
  aCommand.Add(':loop2');
  aCommand.Add('ren ' + aCopyName + ' ' + aAppName);
  aCommand.Add('if exist '+aCopyName+' goto :loop2');
  aCommand.Add('del ' + aBatName);
  aCommand.SaveToFile(aBatName);
  aCommand.Free;
  CommandLineStr := 'Cmd.exe /C "'
                    + ExtractFilePath(aAppPath)
                    + aBatName+'"';
  with SI do begin
    cb := SizeOf( SI );
    lpReserved := nil;
    lpDesktop := nil;
    lpTitle := nil;
    dwX := 0;
    dwY := 0;
    dwXSize := 0;
    dwYSize := 0;
    dwXCountChars := 0;
    dwYCountChars := 0;
    dwFillAttribute := 0;
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_HIDE;
    cbReserved2 := 0;
    lpReserved2 := nil;
    hStdInput := 0;
    hStdOutput := 0;
    hStdError := 0;
  end;
  if CreateProcess( nil, PChar(CommandLineStr), nil, nil, False,
                    CREATE_DEFAULT_ERROR_MODE, nil, nil, SI, PI ) then
  begin
    CloseHandle( PI.hThread );
    CloseHandle( PI.hProcess );
  end;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る