TIdServerIOHandlerSSLOpenSSL与BoxedApp SDK静态版SSL搭配使用异常

在基于TService的服务程序中，结合TIdHTTPWebBrokerBridge与TIdServerIOHandlerSSLOpenSSL建立SSL连接，同时使用静态版BoxedApp SDK创建虚拟目录和文件，程序依赖WebModule运行。

未启用SSL（不为TIdHTTPWebBrokerBridge设置IOHandler）时，程序运行正常；但启用SSL后，无法完成TIdHTTPWebBrokerBridge的激活操作。单独移除SSL配置或BoxedApp SDK相关代码时，程序均可正常运行，两者同时使用则触发错误，日志中偶现如下访问违例：

Access violation at address 7704F5AE in module 'ntdll.dll'. Read of address 00000000

主程序代码 #

program Server_Service;

{$R 'IconBD.res' 'IconBD.rc'}
{$R 'Server.res' 'Server.rc'}
{$R 'SSL.res' 'SSL.rc'}
{$R 'TQ_PICT1_IMGs.res' 'TQ_PICT1_IMGs.rc'}
{$R 'TQ_PICT2_IMGs.res' 'TQ_PICT2_IMGs.rc'}

uses
  Vcl.SvcMgr,
  Web.WebReq,
  IdHTTPWebBrokerBridge,
  FService in 'FService.pas' {ServerService: TService},
  WebModuleUnit5 in 'WebModuleUnit5.pas' {WebModule5: TWebModule},
  Constantes in 'Constantes.pas',
  BoxedAppSDK_Static in '..\BoxedAppSDK\BoxedAppSDK_Static.pas',
  FrameInforme in '..\Productos\Activo\FrameInforme.pas' {InformeBase: TFrame};

{$R *.RES}

begin
  if WebRequestHandler <> nil then
    WebRequestHandler.WebModuleClass := WebModuleClass;
  if not Application.DelayInitialize or Application.Installing then
    Application.Initialize;
  Application.CreateForm(TServerService, ServerService);
  Application.Run;

end.

服务单元代码（FService.pas） #

unit FService;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  SapiemUnit, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
  IdHTTPWebBrokerBridge,
  IdSSLOpenSSL, Web.HTTPApp,
  //
  SapiemFirewallUnit, BoxedAppSDK_Static, Constantes, FrameInforme;

type
  TServerService = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceExecute(Sender: TService);
  private
    { Private declarations }
    HandleFileList: TStringList;
    InformeBase: TInformeBase;
    procedure SalvarImgTemp;
  public
    function GetServiceController: TServiceController; override;
    procedure LogMe(texto: string);
    { Public declarations }
  private
    FServer: TIdHTTPWebBrokerBridge;
    procedure StartServer;
    procedure OnGetSSLPassword(var APassword: String);

  end;

var
  ServerService: TServerService;

implementation

{$R *.dfm}

function ServerDir: string;
begin
  Result := ExtractFilePath(ParamStr(0));
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServerService.Controller(CtrlCode);
end;

function TServerService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TServerService.ServiceCreate(Sender: TObject);
var
  LIOHandleSSL: TIdServerIOHandlerSSLOpenSSL;
begin
  FServer := TIdHTTPWebBrokerBridge.Create(Self);
  LIOHandleSSL := TIdServerIOHandlerSSLOpenSSL.Create(FServer);
  LIOHandleSSL.SSLOptions.CertFile := ServerDir + 'Cert.pem';
  LIOHandleSSL.SSLOptions.RootCertFile := ServerDir + 'Cert.pem';
  LIOHandleSSL.SSLOptions.KeyFile := ServerDir + 'Cert.pem';
  LIOHandleSSL.OnGetPassword := OnGetSSLPassword;
  FServer.IOHandler := LIOHandleSSL;
  LogMe('Terminada la configuración');

  StartServer;
end;

procedure TServerService.ServiceExecute(Sender: TService);
begin
  while not Terminated do
    ServiceThread.ProcessRequests(True);
end;

procedure TServerService.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
  FServer.Active := False;
  FServer.Bindings.Clear;
end;

/// /// SSL //////
procedure TServerService.OnGetSSLPassword(var APassword: String);
begin
  APassword := '';
end;

procedure TServerService.StartServer;
var
  Li: TStringList;
  Stream: TResourceStream;
  Major, Minor, Release, Build: Word;
  ver, ver1: string;
  LIOHandleSSL: TIdServerIOHandlerSSLOpenSSL;

begin
  
  BoxedAppSDK_CreateVirtualDirectory
    (PWideChar(Camino + 'Server'), nil);
  Server := Camino + 'Server\';

  SalvarImgTemp;


  if not FServer.Active then
  begin
    FServer.Bindings.Clear;
    FServer.DefaultPort := 443;
    try
      FServer.Active := True;
    except
      on E: Exception do
        LogMe(E.Message);
    end;
  end;
end;

/// /// SSL End //////

procedure TServerService.LogMe(texto: string);
var
  fichero: TStringList;
  rutaFichero: string;
begin
  try
    if texto <> '' then
    begin
      rutaFichero := ServerDir + 'log_service.log';
      fichero := TStringList.Create;
      if FileExists(rutaFichero) then
        fichero.LoadFromFile(rutaFichero);
      fichero.Add(DateTimeToStr(Now) + ' ' + texto);
      fichero.SaveToFile(rutaFichero);
      FreeAndNil(fichero);
    end;
  except
    //
  end;
end;

/// /// Virtualización /// ///
function CreateVirtualFile(const RName: string; RType: pchar;
  FName: string): Boolean;

var
  ResourceStream: TResourceStream;
  HandleStream: THandleStream;
  hVirtualFile_Dll: THandle;
begin
  try
    hVirtualFile_Dll := BoxedAppSDK_CreateVirtualFile(pchar(FName), GENERIC_ALL,
      FILE_SHARE_READ, nil, CREATE_NEW, 0, 0);
    HandleStream := THandleStream.Create(hVirtualFile_Dll);
    ResourceStream := TResourceStream.Create(0, RName, RType);
    HandleStream.CopyFrom(ResourceStream, ResourceStream.size);
    HandleStream.Free;
    ResourceStream.Free;
    CloseHandle(hVirtualFile_Dll);
    CreateVirtualFile := True;
  except
    CreateVirtualFile := False;
  end;
end;

function CreateVirtualListFile(ListFileName: string): Boolean;
var
  HandleStream: THandleStream;
  hVirtualFile_BD: THandle;
begin
  hVirtualFile_BD := BoxedAppSDK_CreateVirtualFile(pchar(ListFileName),
    GENERIC_ALL, FILE_SHARE_WRITE, nil, CREATE_NEW, 0, 0);
  HandleStream := TFileStream.Create(hVirtualFile_BD);
  HandleStream.Free;

  try
    CloseHandle(hVirtualFile_BD);
  except
    // Nada, esto ocurre solo en el IDE de Delphi, así lo dice la ayuda
  end;
  Result := True;
end;

procedure TServerService.SalvarImgTemp;
var
  BitMap1: TBitMap;
  i: Integer;
  Stream: TResourceStream;
  Li: TStringList;
begin
  Li := TStringList.Create;
  BitMap1 := TBitMap.Create;
  try
    // Cargar Pict1
    Stream := TResourceStream.Create(HInstance, 'TQ_Pict1_Titles', RT_RCDATA);
    Li.LoadFromStream(Stream);
    for i := 0 to Li.Count - 1 do
    begin
      BitMap1.LoadFromResourceName(HInstance, 'Pict1' + IntToStr(i + 1));
      CreateVirtualListFile(Server + 'pict1' + IntToStr(i) + '.png');
      BitMap1.SaveToFile(Server + 'pict1' + IntToStr(i) + '.png');
    end;

    // Cargar Pict2
    Stream := TResourceStream.Create(HInstance, 'TQ_Pict2_Titles', RT_RCDATA);
    Li.LoadFromStream(Stream);
    for i := 0 to Li.Count - 1 do
    begin
      BitMap1.LoadFromResourceName(HInstance, 'Pict2' + IntToStr(i + 1));
      CreateVirtualListFile(Server + 'pict2' + IntToStr(i) + '.png');
      BitMap1.SaveToFile(Server + 'pict2' + IntToStr(i) + '.png');
    end;

  finally
    Stream.Free;
    BitMap1.Free;
    FreeAndNil(Li);
  end;
end;

/// /// Virtualización END /// ///

initialization

SetCurrentDir(ParamStr(0));
BoxedAppSDK_Init;
BoxedAppSDK_EnableOption
  (DEF_BOXEDAPPSDK_OPTION__HIDE_VIRTUAL_FILES_FROM_FILE_DIALOG, True);

end.

WebModule单元代码（WebModuleUnit5.pas） #

unit WebModuleUnit5;

interface

uses
  System.SysUtils, System.Classes, Web.HTTPApp;

type
  TWebModule5 = class(TWebModule)
    procedure WebModule5DefaultHandlerAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModuleClass: TComponentClass = TWebModule5;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

procedure TWebModule5.WebModule5DefaultHandlerAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content :=
    '<html>' +
    '<head><title>Web Server Application</title></head>' +
    '<body>Web Server Application - Sapiem</body>' +
    '</html>';
end;

end.

内容的提问来源于stack exchange，提问作者Sapiem