На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Как бы мне передать большой объём данных процессу при его запуске , SharedMemory, CreateFileMapping
    Вопрос по мотивам статьи от Gunsmoker'a
    Цитата
    Как бы мне передать большой объём данных процессу при его запуске
    https://www.transl-gunsmoker.ru/2008/12/blog-post_603.html.


    В статье приведён следующий код:
    (код уже причёсан для простоты и удобства)
    ExpandedWrap disabled
      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; , а например динамический массив ? типа

    ExpandedWrap disabled
      type
        PStartupParams = ^TStartupParams;
        TStartupParams = packed record
          Bytes: TBytes;              
        end;
    Сообщение отредактировано: Jiro -
      Выделить объём памяти, достаточный для размещения тела массива, и скопировать тело массива в эту память.

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

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

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

          ExpandedWrap disabled
            AMapping := CreateFileMapping(INVALID_HANDLE_VALUE, @SA, PAGE_READWRITE, 0, SizeOf(TStartupParams), nil);
            Цитата
            Вот здесь вместо SizeOf(TStartupParams) что ставили?


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

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

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

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

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


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

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

                  ExpandedWrap disabled
                    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 -
                    1) 46: if not CreateProcess(nil, PChar(CmdLine), nil, nil, True, 0, nil, nil, SI, PI) then
                    2) Не надо использовать динамический массив для передачи. Он будет сохраняться в структуре как указатель, а указатель в другом процессе не валиден.
                    ExpandedWrap disabled
                      const
                        MAX_BYTES = 256;
                      type
                        PStartupParams = ^TStartupParams;
                        TStartupParams = packed record
                          Magic: Integer;               // только одно значение
                          Bytes: array [0 .. MAX_BYTES - 1] of Byte;
                        end;
                    Обычный статический массив будет включен в структуру полностью, а не как указатель. В него и надо положить данные, которые будут передаваться корректно.
                    Сообщение отредактировано: macomics -
                      macomics
                      Про статический массив было понятно с самого начала, вопрос в том как динамический массив перегнать ?
                      Я точно уверен, что это можно но моего кунгфу тут не хватает.
                        Точно так же. Либо определите длину данных и скопируйте их туда. Проблема с динамическим массивом в том, что он добавляет в структуру указатель, а не передаваемые данные. Вам же надо посчитать длину блока, создаваемого CreateFileMapping, с учетом длины данных динамического массива и скопировать эти данные из динамического массива в соответствующее смещение в структуре. Разумеется их надо точно так же копировать при получении. И точно так же вручную передавать длину данных.
                        Попробуйте так:
                        ExpandedWrap disabled
                          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 -
                          WM_COPYDATA?
                            macomics

                            Спасибо :good:
                            0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                            0 пользователей:


                            Рейтинг@Mail.ru
                            [ Script execution time: 0,0428 ]   [ 16 queries used ]   [ Generated: 17.06.24, 12:44 GMT ]