Как бы мне передать большой объём данных процессу при его запуске , SharedMemory, CreateFileMapping

[Jiro]

Вопрос по мотивам статьи от Gunsmoker'a

Цитата

Как бы мне передать большой объём данных процессу при его запуске
https://www.transl-gunsmoker.ru/2008/12/blog-post_603.html.

В статье приведён следующий код:
(код уже причёсан для простоты и удобства)

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils;
 
type
  PStartupParams = ^TStartupParams;
  TStartupParams = packed record
    Magic: Integer;               // только одно значение
  end;
 
   // Вставьте сюда все наши процедуры. Первой должна идти FreeStartupParams.
 
procedure FreeStartupParams(var AMapping: THandle; var AData: PStartupParams);
var
  HR: HRESULT;
begin
  HR := GetLastError;
  if AData <> nil then
  begin
    UnmapViewOfFile(AData);
    AData := nil;
  end;
  if AMapping <> 0 then
  begin
    CloseHandle(AMapping);
    AMapping := 0;
  end;
  SetLastError(HR);
end;
 
 
procedure PassNumberViaSharedMemory(const AMapping: THandle);
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  ExeName, CmdLine: String;
begin
  ExeName := GetModuleName(0);
  CmdLine := '"' + ExeName + '" ' + IntToStr(AMapping);
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);
  if not CreateProcess(PChar(ExeName), PChar(CmdLine), nil, nil, True, 0, nil, nil, SI, PI) then
    RaiseLastOSError;
  CloseHandle(PI.hProcess);
  CloseHandle(PI.hThread);
end;
 
function GetStartupParams(out AMapping: THandle): PStartupParams;
var
  MBI: TMemoryBasicInformation;
begin
  AMapping := StrToInt(ParamStr(1));
  Result := MapViewOfFile(AMapping, FILE_MAP_READ, 0, 0, 0);
  if Result = nil then
    RaiseLastOSError;
  // После проецирования произведём базовую проверку
  if (
      (VirtualQuery(Result, MBI, SizeOf(MBI)) >= SizeOf(MBI)) and
      (mbi.State = MEM_COMMIT) and
      (mbi.BaseAddress = Result) and
      (mbi.RegionSize >= SizeOf(TStartupParams))
     ) then
  begin
     // Успех!
  end
  else
  begin
    // Блок памяти не подходит
    FreeStartupParams(AMapping, Result);  // будет описана чуть позже
    raise Exception.Create(' invalid Send mem block.');  // Передан неверный блок памяти
  end;
 
end;
 
function CreateStartupParams(out AMapping: THandle): PStartupParams;
var
  SA: TSecurityAttributes;
begin
  FillChar(SA, SizeOf(SA), 0);
  SA.nLength := SizeOf(SA);
  SA.lpSecurityDescriptor := nil;
  SA.bInheritHandle := TRUE;
  AMapping := CreateFileMapping(INVALID_HANDLE_VALUE, @SA, PAGE_READWRITE, 0, SizeOf(TStartupParams), nil);
  if AMapping = 0 then
    RaiseLastOSError;
  Result := MapViewOfFile(AMapping, FILE_MAP_WRITE, 0, 0, 0);
  if Result = nil then
  begin
    FreeStartupParams(AMapping, Result);  // будет описана чуть позже
    RaiseLastOSError;
  end;
end;
 
 
 
 
function AnsiToOEM(const AMsg: AnsiString): AnsiString;
begin
  SetLength(Result, Length(AMsg));
  Windows.AnsiToOem(PAnsiChar(AMsg), PAnsiChar(Result));
end;
 
var
  Mapping: THandle;
  Data: PStartupParams;
begin
  try
    Mapping := 0;
    Data := nil;
    try
      if ParamCount <> 0 then
      begin
        Data := GetStartupParams(Mapping);
        WriteLn(AnsiToOEM('Data send: '), Data^.Magic);
      end
      else
      begin
        Data := CreateStartupParams(Mapping);
        Data^.Magic := 42;
        PassNumberViaSharedMemory(Mapping);
      end;
    finally
      FreeStartupParams(Mapping, Data);
    end;
  except
    on E: Exception do
      WriteLn(E.Classname, ': ', AnsiToOEM(E.Message));
  end;
end.

Суть кода в крации: Запускается приложение, оно создаём в памяти объект, далее это приложение запускает свою копию, а в качестве параметра передаёт копии ранее созданный дескриптор объекта.
Запускается копия, читает параметр в котором дескриптор, и по дескриптору объекта получает доступ к объекту.


Всё просто и понятно, но возникает вопрос, а как быть если нужно передать не Magic: Integer; , а например динамический массив ? типа

type
  PStartupParams = ^TStartupParams;
  TStartupParams = packed record
    Bytes: TBytes;              
  end;

Сообщение отредактировано: Jiro - 17.01.24, 08:15

[MBo]

Выделить объём памяти, достаточный для размещения тела массива, и скопировать тело массива в эту память.

Можно также в начале маппинга записать целое число - длину массива, чтобы принимающей стороне было проще.

[Jiro]

MBo

Естесно я это пробовал, вот только лыжи не поехали.

[MBo]

Покажите, попробуем разобраться

Вот здесь вместо SizeOf(TStartupParams) что ставили?

AMapping := CreateFileMapping(INVALID_HANDLE_VALUE, @SA, PAGE_READWRITE, 0, SizeOf(TStartupParams), nil);

[Jiro]

Цитата

Вот здесь вместо SizeOf(TStartupParams) что ставили?

Вот кстати хороший вопрос, как померить размер ?
На ум приходит такое = Length(Bytes) + SizeOf(TStartupParams), но не уверен что это правильно.

Для простоты туда записывал 1024, а в значение Bytes около 10 байт,
проблема в том, что когда читаю данные (естестно читаю не все 1024, а столько сколько записал в Bytes), то считываю не то что записал.

[macomics]

Так вам надо вычислять количество байт, а не количество элементов массива. Length(Bytes) дает вам количество элементов массива. Вам надо использовать выражение: SizeOf(TStartupParams) + Length(Bytes) * SizeOf(Bytes[Low(Bytes)])

SizeOf возвращает количество байт занимаемых её аргументом, а вот Length возвращает именно количество элементов.

Плюс: CreateFileMapping, созданный с такими аргументами, существует только пока он открыт (существует хотя бы один его хэндл). Если процесс который его записал умрет до того как запустится новый процесс и попробует его прочитать, тогда и данных на месте не окажется. Чтобы это исправить добавьте сразу после CreateProcess вызов WaitForSingleObject(PI.hProcess, INFINITE);

Так первый процесс будет ждать пока второй не завершится и данные будут на месте. В более сложном случае надо использовать синхронизацию через Mutex или Event

Сообщение отредактировано: macomics - 17.01.24, 12:56

[MBo]

Цитата

то считываю не то что записал.

Видимо, вы всё-таки пишете туда не тело массива, а адрес, который не имеет смысла в другом процессе

[Jiro]

macomics

Всё равно не работает, вот сделал как вы сказали ...

program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils;
 
type
  PStartupParams = ^TStartupParams;
  TStartupParams = packed record
    Magic: Integer;               // только одно значение
    Bytes: TBytes;
  end;
 
   // Вставьте сюда все наши процедуры. Первой должна идти FreeStartupParams.
 
procedure FreeStartupParams(var AMapping: THandle; var AData: PStartupParams);
var
  HR: HRESULT;
begin
  HR := GetLastError;
  if AData <> nil then
  begin
    UnmapViewOfFile(AData);
    AData := nil;
  end;
  if AMapping <> 0 then
  begin
    CloseHandle(AMapping);
    AMapping := 0;
  end;
  SetLastError(HR);
end;
 
 
procedure PassNumberViaSharedMemory(const AMapping: THandle);
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  ExeName, CmdLine: String;
begin
  ExeName := GetModuleName(0);
  CmdLine := '"' + ExeName + '" ' + IntToStr(AMapping);
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);
  if not CreateProcess(PChar(ExeName), PChar(CmdLine), nil, nil, True, 0, nil, nil, SI, PI) then
    RaiseLastOSError;
 
    WaitForSingleObject(PI.hProcess, INFINITE);
 
  CloseHandle(PI.hProcess);
  CloseHandle(PI.hThread);
end;
 
function GetStartupParams(out AMapping: THandle): PStartupParams;
var
  MBI: TMemoryBasicInformation;
begin
  AMapping := StrToInt(ParamStr(1));
  Result := MapViewOfFile(AMapping, FILE_MAP_READ, 0, 0, 0);
  if Result = nil then
    RaiseLastOSError;
  // После проецирования произведём базовую проверку
  if (
      (VirtualQuery(Result, MBI, SizeOf(MBI)) >= SizeOf(MBI)) and
      (mbi.State = MEM_COMMIT) and
      (mbi.BaseAddress = Result) and
      (mbi.RegionSize >= SizeOf(TStartupParams))
     ) then
  begin
     // Успех!
  end
  else
  begin
    // Блок памяти не подходит
    FreeStartupParams(AMapping, Result);  // будет описана чуть позже
    raise Exception.Create(' invalid Send mem block.');  // Передан неверный блок памяти
  end;
 
end;
 
function CreateStartupParams(out AMapping: THandle; const Sz: Integer): PStartupParams;
var
  SA: TSecurityAttributes;
begin
  FillChar(SA, SizeOf(SA), 0);
  SA.nLength := SizeOf(SA);
  SA.lpSecurityDescriptor := nil;
  SA.bInheritHandle := TRUE;
 
  AMapping := CreateFileMapping(INVALID_HANDLE_VALUE, @SA, PAGE_READWRITE, 0, Sz, nil);
 
  if AMapping = 0 then
    RaiseLastOSError;
 
  Result := MapViewOfFile(AMapping, FILE_MAP_WRITE, 0, 0, 0);
 
  if Result = nil then
  begin
    FreeStartupParams(AMapping, Result);  // будет описана чуть позже
    RaiseLastOSError;
  end;
end;
 
 
 
function AnsiToOEM(const AMsg: AnsiString): AnsiString;
begin
  SetLength(Result, Length(AMsg));
  Windows.AnsiToOem(PAnsiChar(AMsg), PAnsiChar(Result));
end;
 
var
  Mapping: THandle;
  Data: PStartupParams;
  SZ: integer;
  BTs: TBytes;
begin
  try
    Mapping := 0;
    Data := nil;
    try
      if ParamCount <> 0 then
      begin
        Data := GetStartupParams(Mapping);
        WriteLn(AnsiToOEM('Data send: '), Data^.Magic);
 
        SZ :=  Length(Data^.Bytes);
        WriteLn(AnsiToOEM('Data send: ') , SZ  {TEncoding.Ansi.GetString(Data^.Bytes )}    );
 
      end
      else
      begin
        BTs := TEncoding.Ansi.GetBytes('Bbbbb');
        SZ := SizeOf(TStartupParams) + Length(BTs) * SizeOf(BTs[Low(BTs)]);
        Data := CreateStartupParams(Mapping, SZ);
        Data^.Magic := 42;
        Data^.Bytes := BTs;
 
        PassNumberViaSharedMemory(Mapping);
      end;
    finally
      FreeStartupParams(Mapping, Data);
    end;
  except
    on E: Exception do
      WriteLn(E.Classname, ': ', AnsiToOEM(E.Message));
  end;
end.

Сообщение отредактировано: Jiro - 18.01.24, 21:26

[macomics]

1) 46: if not CreateProcess(nil, PChar(CmdLine), nil, nil, True, 0, nil, nil, SI, PI) then
2) Не надо использовать динамический массив для передачи. Он будет сохраняться в структуре как указатель, а указатель в другом процессе не валиден.

const
  MAX_BYTES = 256;
type
  PStartupParams = ^TStartupParams;
  TStartupParams = packed record
    Magic: Integer;               // только одно значение
    Bytes: array [0 .. MAX_BYTES - 1] of Byte;
  end;

Обычный статический массив будет включен в структуру полностью, а не как указатель. В него и надо положить данные, которые будут передаваться корректно.

Сообщение отредактировано: macomics - 19.01.24, 03:13

[Jiro]

macomics
Про статический массив было понятно с самого начала, вопрос в том как динамический массив перегнать ?
Я точно уверен, что это можно но моего кунгфу тут не хватает.

[macomics]

Точно так же. Либо определите длину данных и скопируйте их туда. Проблема с динамическим массивом в том, что он добавляет в структуру указатель, а не передаваемые данные. Вам же надо посчитать длину блока, создаваемого CreateFileMapping, с учетом длины данных динамического массива и скопировать эти данные из динамического массива в соответствующее смещение в структуре. Разумеется их надо точно так же копировать при получении. И точно так же вручную передавать длину данных.
Попробуйте так:

program Project1;
// Я дописал пару функций и типов отсутствующих в Delphi 7. Все работает как надо. Вы можете вместо моих функций использовать те, что есть в Embarcadero Delphi
 
{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils;
 
type
  TBytes = array of Byte; // Этот тип я добавил тк D7 не знает таких
  PStartupParams = ^TStartupParams;
  TStartupParams = packed record
    Magic: Integer;
    Bytes: Cardinal; // Это переменная для передачи длины массива
    FirstByte: Byte; // Это переменная для копирования данных из массива
  end; // Конечная длина этой структуры определяется с учетом значения её поля Bytes (SizeOf(var) + var.Bytes - 1)
 
procedure FreeStartupParams(var AMapping: THandle; var AData: PStartupParams);
var
  HR: HRESULT;
begin
  HR := GetLastError;
  if AData <> nil then
  begin
    UnmapViewOfFile(AData);
    AData := nil;
  end;
  if AMapping <> 0 then
  begin
    CloseHandle(AMapping);
    AMapping := 0;
  end;
  SetLastError(HR);
end;
 
 
procedure PassNumberViaSharedMemory(const AMapping: THandle);
var
  SI: TStartupInfo;
  PI: TProcessInformation;
  ExeName, CmdLine: String;
begin
  ExeName := GetModuleName(0);
  CmdLine := '"' + ExeName + '" ' + IntToStr(AMapping);
  FillChar(SI, SizeOf(SI), 0);
  SI.cb := SizeOf(SI);
  if not CreateProcess(PChar(ExeName), PChar(CmdLine), nil, nil, True, 0, nil, nil, SI, PI) then
    RaiseLastOSError;
 
    WaitForSingleObject(PI.hProcess, INFINITE);
 
  CloseHandle(PI.hProcess);
  CloseHandle(PI.hThread);
end;
 
function GetStartupParams(out AMapping: THandle): PStartupParams;
var
  MBI: TMemoryBasicInformation;
begin
  AMapping := StrToInt(ParamStr(1));
  Result := MapViewOfFile(AMapping, FILE_MAP_READ, 0, 0, 0);
  if Result = nil then
    RaiseLastOSError;
  if (
      (VirtualQuery(Result, MBI, SizeOf(MBI)) >= SizeOf(MBI)) and
      (mbi.State = MEM_COMMIT) and
      (mbi.BaseAddress = Result) and
      (mbi.RegionSize >= SizeOf(TStartupParams))
     ) then
  begin
  end
  else
  begin
    FreeStartupParams(AMapping, Result);
    raise Exception.Create(' invalid Send mem block.');
  end;
 
end;
 
function CreateStartupParams(out AMapping: THandle; const Sz: Integer): PStartupParams;
var
  SA: TSecurityAttributes;
begin
  FillChar(SA, SizeOf(SA), 0);
  SA.nLength := SizeOf(SA);
  SA.lpSecurityDescriptor := nil;
  SA.bInheritHandle := TRUE;
 
  AMapping := CreateFileMapping(INVALID_HANDLE_VALUE, @SA, PAGE_READWRITE, 0, Sz, nil);
 
  if AMapping = 0 then
    RaiseLastOSError;
 
  Result := MapViewOfFile(AMapping, FILE_MAP_WRITE, 0, 0, 0);
 
  if Result = nil then
  begin
    FreeStartupParams(AMapping, Result);
    RaiseLastOSError;
  end;
end;
 
function GetBytes(a: AnsiString): TBytes; // Эту функцию преобразования я дописал тк D7 так не умеет
var
  i: LongInt;
begin
  SetLength(Result, Length(a));
  for i := Low(Result) to High(Result) do
    Result[i] := ord(a[i - Low(Result) + 1]);
end;
 
function GetString(ar: TBytes): String;// Эту функцию преобразования я дописал тк D7 так не умеет
var
  i: LongInt;
begin
  Result := '';
  for i := Low(ar) to High(ar) do
    Result := Result + AnsiChar(ar[i]);
end;
 
function AnsiToOEM(const AMsg: AnsiString): AnsiString;
begin
  SetLength(Result, Length(AMsg));
  Windows.AnsiToOem(PAnsiChar(AMsg), PAnsiChar(Result));
end;
 
var
  Mapping: THandle;
  Data: PStartupParams;
  SZ: integer;
  BTs: TBytes;
begin
  try
    Mapping := 0;
    Data := nil;
    try
      if ParamCount <> 0 then
      begin
        Data := GetStartupParams(Mapping); // Как обычно получили указатель
        WriteLn(AnsiToOEM('Data send: '), Data^.Magic); // Выводим Magic
        SZ :=  Data^.Bytes; // А вот массив придется вытаскивать вручную на основе переданной длины
        SetLength(BTs, 1); // Чтобы не было ошибок доступа к элементам массива на следующей строчке (можно убрать, если элементы - байты)
        SetLength(BTs, SZ div SizeOf(BTs[Low(BTs)])); // Выделение памяти под динамический массив
        CopyMemory(@BTs[Low(BTs)], @(Data^.FirstByte), SZ); // Копирование данных из структуры в массив
        WriteLn(AnsiToOEM('Data send: ') , SZ, AnsiToOEM(GetString(BTs))); // Вывод на экран
      end
      else
      begin
        BTs := GetBytes('Bbbbb');
        SZ := SizeOf(TStartupParams) + Length(BTs) * SizeOf(BTs[Low(BTs) - 1]); // Вот тут вычисляется длина передаваемых по факту данных
        Data := CreateStartupParams(Mapping, SZ);
        Data^.Magic := 42;
        Data^.Bytes := SZ; // Заполняем поле длины данных
        CopyMemory(@(Data^.FirstByte), BTs, Length(BTs) * SizeOf(BTs[Low(BTs)])); // Копируем данные из массива в структуру
        PassNumberViaSharedMemory(Mapping);
        ReadLn; // Добавил остановку в конце родительского процесса
      end;
    finally
      FreeStartupParams(Mapping, Data);
    end;
  except
    on E: Exception do
      WriteLn(E.Classname, ': ', AnsiToOEM(E.Message));
  end;
end.

Сообщение отредактировано: macomics - 19.01.24, 12:45

[Krid]

WM_COPYDATA?

[Jiro]

macomics

Спасибо