exeを落とさずに数回動かせるには？ (ID:41331)

名前

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

本文

EXE を起動しなおさなくても Form1 (MainForm) を Create しなおせば
いいので、後はコマンドラインの問題

コマンドラインは共有メモリーにしてしまう。

ParamCount と ParamStr  を共有メモリから取得するようにする

１）親  から  子を起動
２）新しいコマンドラインを指定してから 子を終了で
３）新しいコマンドラインで起動(Form1 を作成しなおし)

MapViewOfFilePointer.Exit を  0 以外にしておけば  子終了

--------- プロジェクト ------
program Project1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas';

{$R *.res}

begin

Application.Initialize;
   Application.MainFormOnTaskbar := True;

while MapViewOfFilePointer.Exit = 0 do
   begin
     Form1 := TForm1.Create(Application);
     Form1.ShowModal;
     Form1.Release;
   end;

end.

----------------- UNIT 1 --------------

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//終了フラグ
procedure TForm1.Button1Click(Sender: TObject);
begin
    MapViewOfFilePointer.Exit := 1;
end;

//コマンドライン変更
procedure TForm1.Button2Click(Sender: TObject);
begin
    SetCommandLine (['XXX','YYYYYY','ZZZZZZZ']);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

Memo1.Lines.Add(IntToStr(MapViewOfFilePointer.ParamCount));
    Memo1.Lines.Add('Param0:'+ParamStr(0));
    Memo1.Lines.Add('Param1:'+ParamStr(1));
    Memo1.Lines.Add('Param2:'+ParamStr(2));
    Memo1.Lines.Add('Param3:'+ParamStr(3));

end;

end.

unit Unit2;

interface

uses
    Windows,SysUtils;

type

TFileMap = record
      Exit: Integer;
      ParamCount: Integer;
      ParamStr: array[0..1047] of WChar;
    end;
    PFileMap = ^TFileMap;

var
    FileMappingHandle : THandle;
    MapViewOfFilePointer: PFileMap;

procedure SetCommandLine(Params: array of String);
    function ParamStr(Index: Integer): String;

const
    UniqueName = 'UniqueName';

implementation

function ParamStr(Index: Integer): String;
var
  P2: PChar;

//System からコピー
{$IFDEF MSWINDOWS}
function GetParamStr(P: PChar; var Param: string): PChar;
var
  i, Len: Integer;
  Start, S: PChar;
begin
  // U-OK
  while True do
  begin
    while (P[0] <> #0) and (P[0] <= ' ') do
      Inc(P);
    if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  end;
  Len := 0;
  Start := P;
  while P[0] > ' ' do
  begin
    if P[0] = '"' then
    begin
      Inc(P);
      while (P[0] <> #0) and (P[0] <> '"') do
      begin
        Inc(Len);
        Inc(P);
      end;
      if P[0] <> #0 then
        Inc(P);
    end
    else
    begin
      Inc(Len);
      Inc(P);
    end;
  end;

SetLength(Param, Len);

P := Start;
  S := Pointer(Param);
  i := 0;
  while P[0] > ' ' do
  begin
    if P[0] = '"' then
    begin
      Inc(P);
      while (P[0] <> #0) and (P[0] <> '"') do
      begin
        S[i] := P^;
        Inc(P);
        Inc(i);
      end;
      if P[0] <> #0 then Inc(P);
    end
    else
    begin
      S[i] := P^;
      Inc(P);
      Inc(i);
    end;
  end;

Result := P;
end;
{$ENDIF}
//Systemからコピー

begin
    if Index = 0 then
    begin
      Result := System.ParamStr(0);
    end
    else
    begin
      P2 := MapViewOfFilePointer.ParamStr;
      Dec(Index);
      while True do
      begin
        P2 := GetParamStr(P2, Result);
        if (Index = 0) or (Result = '') then Break;
        Dec(Index);
      end;
    end;
end;

procedure SetCommandLine(Params: array of String);
var
    I: Integer;
    S: String;
begin
    for I:=0 to High(Params) do
    begin
      S := S + Params[I] + Char(1) + Char(2);
    end;
    S := S + Char(0) + Char(0);

MapViewOfFilePointer.ParamCount := High(Params);
    StrPCopy(MapViewOfFilePointer.ParamStr,S);
end;

initialization

FileMappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS,False,PWChar(UniqueName));
   if FileMappingHandle = 0 then
   begin
     FileMappingHandle := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,1024+8,PChar(UniqueName));
   end;

if FileMappingHandle <> 0 then
   begin
     MapViewOfFilePointer := MapViewOfFile(FileMappingHandle,FILE_MAP_ALL_ACCESS,0,0,0);
   end;

finalization

UnmapViewOfFile(MapViewOfFilePointer);
   CloseHandle(THandle(FileMappingHandle));

end.

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

戻る