RTC Forums
March 28, 2024, 09:30:15 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
 
   Home   Help Login Register  
Pages: [1]
  Print  
Author Topic: Delphi 11 : error when closing Delphi  (Read 3933 times)
thierry.lemaire
RTC License
***
Posts: 1


« on: January 09, 2022, 07:53:57 AM »

I have installed RTC SDK v 9.51 on Delphi 11 (Enterprise Edition), following the provided installation steps.
Everything went well, except the fact that every time I quit Delphi, I get the error message below:

---------------------------
Application Error
---------------------------
Exception EAccessViolation in module rtl280.bpl at 16E677B4.
Access violation at address 16E687B4 in module 'bds.exe'. Read of address 16E687B4.

Any idea how I could get rid of this error ?
Thanks,
Thierry
Logged
D.Tkalcec (RTC)
Administrator
*****
Posts: 1881


« Reply #1 on: January 10, 2022, 02:40:44 AM »

The only "reliable" way to get rid of that Error message when closing Delphi, would be to uninstall the RTC SDK Design-Time package (rtcSDKD.dpk). But ... if you do that, you won't be able to use any RTC components from the Integrated Delphi Form and Modules Designer.

Frankly, I've seen that Error quite often when closing Delphi, but I've never been able to figured out what exactly causes it, except that it is somehow related to the RTC SDK design-time package. Fortunately, that Error only affects Delphi at shut-down. It does NOT affect the use of RTC components at design-time (unless you remove the design-time package) and it does NOT affect your Applications compiled with the RTC SDK (which should ONLY use the run-time package).

Best Regards,
Danijel Tkalcec
Logged
earthsbest
RTC License+
****
Posts: 7


« Reply #2 on: January 12, 2022, 04:03:43 AM »

1.Open "rtcSDKD.dpk" and delete or comment those units related to "ISAPI".
2.recompile,restart Delphi 11 IDE.
Work fine.

Code:
contains
  rtcRegister in 'rtcRegister.pas',
  //rtcISAPISrv in 'rtcISAPISrv.pas',
  //rtcISAPIApp in 'rtcISAPIApp.pas',
  //rtcISAPISrvProv in 'rtcISAPISrvProv.pas',
  rtcEditors in 'rtcEditors.pas';
Logged
earthsbest
RTC License+
****
Posts: 7


« Reply #3 on: January 12, 2022, 08:59:10 AM »

We try to use another solution to solve the issue,found the issue caused by rtcISAPIApp.pas.

Here is a new unit was fixed the issue.

Code:
{
  @html(<b>)
  ISAPI Application Component
  @html(</b>)
  - Copyright 2004-2020 (c) Teppi Technology (https://rtc.teppi.net)
  @html(<br><br>)

  Partial Copyright (c) Borland Inc.
  - TApplication interface compatibility
  - Exception Handling
  - Component creation

  This unit is ONLY for MS Windows.

  @exclude
}
unit rtcISAPIApp;

{$INCLUDE rtcDefs.inc}

interface

{$IFDEF WINDOWS}

uses
  Windows,
  {$IFNDEF FPC}Isapi2,{$ENDIF}
  Classes, SysUtils,
  ComObj, ActiveX,

  rtcTypes,
  rtcSystem,
  rtcLog,

  rtcInfo,
  rtcISAPISrv;

type
  TRtcISAPIApplication = class(TComponent)
  private
    FTitle: RtcString;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure CreateForm(InstanceClass: TComponentClass; var Reference); virtual;
    procedure Initialize; virtual;
    procedure Run; virtual;

    // ISAPI entry points ->
    function GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL;
    function HttpExtensionProc(var ECB: TEXTENSION_CONTROL_BLOCK): DWORD;
    function TerminateExtension(dwFlags: DWORD): BOOL;
    // <- ISAPI entry points

    property Title: RtcString read FTitle write FTitle;
  end;

  THandleShutdownException = procedure(E: Exception);

var
  HandleShutdownException: THandleShutdownException = nil;
  Application: TRtcISAPIApplication = nil;

function GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL; stdcall; export;
function HttpExtensionProc(var ECB: TEXTENSION_CONTROL_BLOCK): DWORD; stdcall; export;
function TerminateExtension(dwFlags: DWORD): BOOL; stdcall; export;

exports
  GetExtensionVersion,
  HttpExtensionProc,
  TerminateExtension;

{$ENDIF} // {$IFDEF WINDOWS}

implementation

{$IFDEF WINDOWS}

// ISAPI interface

function GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL;
  begin
  Result := Application.GetExtensionVersion(Ver);
  end;

function HttpExtensionProc(var ECB: TEXTENSION_CONTROL_BLOCK): DWORD;
  begin
  Result := Application.HttpExtensionProc(ECB);
  end;

function TerminateExtension(dwFlags: DWORD): BOOL;
  begin
  Result := Application.TerminateExtension(dwFlags);
  end;

{ TRtcISAPIApplication }

type
  TDLLProc = procedure (Reason: Integer);

var
  OldDllProc: TDLLProc;
  rtcLoaded:boolean=False;

procedure DoneVCLApplication;
  begin
  try
    Application.Free;
    Application := nil;
  except
    on E:Exception do
      if Assigned(HandleShutdownException) then
        begin
        Application := nil;
        // Classes.ApplicationHandleException := nil;
        HandleShutdownException(E);
        end;
    end;
  end;

procedure DLLExitProc(Reason: Integer);
  begin
  if Reason = DLL_PROCESS_DETACH then
    DoneVCLApplication;
  if Assigned(OldDllProc) then
    OldDllProc(Reason);
  end;

procedure HandleServerException(E: Exception; var ECB: TEXTENSION_CONTROL_BLOCK);
  var
    ResultText,
    ResultHeaders: RtcByteArray;
    Size: DWORD;
    xData:RtcByteArray;
  begin
  ResultText := RtcStringToBytes( '<html><h1>Internal Server Error</h1><br>'+
                    RtcString(E.ClassName)+': '+RtcString(E.Message) );
  Size := Length(ResultText);

  ECB.dwHTTPStatusCode := 500;
  ResultHeaders := RtcStringToBytes( 'Content-Type: text/html'#13#10 +
                      'Content-Length: '+Int2Str(length(ResultText))+#13#10+#13#10 );

  xData:=RtcStringToBytesZero('500 ' + RtcString(E.Message));
  ECB.ServerSupportFunction(ECB.ConnID, HSE_REQ_SEND_RESPONSE_HEADER,
                            @(xData[0]), @Size, LPDWORD(ResultHeaders));

  ECB.WriteClient(ECB.ConnID, Addr(ResultText[0]), Size, 0);
  end;

function IsPackage: Boolean;
var
  AFileName: String;
begin
  AFileName := GetModuleName(HInstance);
  Result := SameText(ExtractFileExt(AFileName), '.bpl');
end;

constructor TRtcISAPIApplication.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  if IsLibrary then
  begin
    IsMultiThread := True;
    OldDllProc := DLLProc;
    DLLProc := @DLLExitProc;
  end else if not IsPackage then
  begin
    AddExitProc(DoneVCLApplication);
  end;
end;

destructor TRtcISAPIApplication.Destroy;
  begin
  try
    if rtcLoaded then
      begin
      rtcLoaded:=False;
      TRtcISAPIServer.UnLoad;
      end;
    inherited;
  except
    on E:Exception do
      begin
      if LOG_AV_ERRORS then
        Log('TRtcISAPIApplication.Destroy',E,'ERROR');
      raise;
      end;
    end;
  end;

function TRtcISAPIApplication.GetExtensionVersion(var Ver: THSE_VERSION_INFO): BOOL;
  var
    xTitle:RtcByteArray;
  begin
  xTitle:=nil;
  try
    Ver.dwExtensionVersion := MakeLong(HSE_VERSION_MINOR, HSE_VERSION_MAJOR);
    xTitle:=RtcStringToBytesZero(Title);
    StrLCopy(Ver.lpszExtensionDesc, @(xTitle[0]), HSE_MAX_EXT_DLL_NAME_LEN);
    Integer(Result) := 1;
  except
    Result := False;
    end;
  end;

function TRtcISAPIApplication.HttpExtensionProc(var ECB: TEXTENSION_CONTROL_BLOCK): DWORD;
  begin
  try
    Result:=TRtcISAPIServer.HttpExtensionProc(ECB);
    if Result=HSE_STATUS_ERROR then
      raise Exception.Create('TRtcISAPIServer.HttpExtensionProc() returned with STATUS_ERROR.<br>'#13#10+
                             'Please check if you have created the TDataModule with one TRtcISAPIServer component.');
  except
    if ExceptObject is Exception then
      HandleServerException(Exception(ExceptObject), ECB);
    Result := HSE_STATUS_ERROR;
    end;
  end;

function TRtcISAPIApplication.TerminateExtension(dwFlags: DWORD): BOOL;
  begin
  if rtcLoaded then
    begin
    rtcLoaded:=False;
    TRtcISAPIServer.UnLoad;
    end;
  Integer(Result) := 1;
  end;

procedure TRtcISAPIApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
  var
    Instance: TComponent;
  begin
  Instance := TComponent(InstanceClass.NewInstance);
  TComponent(Reference) := Instance;
  try
    Instance.Create(Self);
  except
    TComponent(Reference) := nil;
    raise;
    end;
  end;

procedure TRtcISAPIApplication.Initialize;
  begin
  if InitProc <> nil then TProcedure(InitProc);
  end;

procedure TRtcISAPIApplication.Run;
  begin
  TRtcISAPIServer.Load;
  rtcLoaded:=True;
  end;

procedure InitApplication;
  begin
  CoInitFlags := COINIT_MULTITHREADED;
  Application := TRtcISAPIApplication.Create(nil);
  end;

procedure DoneApplication;
begin
  if IsPackage then
  begin
    DoneVCLApplication;
  end;
end;

initialization
{$IFDEF RTC_DEBUG} StartLog; Log('rtcISAPIApp Initializing ...','DEBUG');{$ENDIF}

InitApplication;

{$IFDEF RTC_DEBUG} Log('rtcISAPIApp Initialized.','DEBUG');{$ENDIF}
finalization
{$IFDEF RTC_DEBUG} Log('rtcISAPIApp Finalized.','DEBUG');{$ENDIF}
DoneApplication;
{$ENDIF} // {$IFDEF WINDOWS}
end.
Logged
D.Tkalcec (RTC)
Administrator
*****
Posts: 1881


« Reply #4 on: January 13, 2022, 01:38:05 AM »

Thank you for solving that very old mystery Smiley

I see you've modified the ISAPI unit, so it would destroy the ISAPI Application from the units finalization section in case it's compiled into a BPL, instead of attaching an Exit Procedure to do it. Yep, that makes sense. I have no idea why the version that attaches itself to the Exit procedure was there. Destroying objects created in a unit from units finalization section is much cleaner.

Best Regards,
Danijel Tkalcec
Logged
D.Tkalcec (RTC)
Administrator
*****
Posts: 1881


« Reply #5 on: January 13, 2022, 02:23:30 AM »

Thanks again for solving this problem and providing a solution.

I've included your updated version of the "rtcISAPIApp.pas" unit in the RealThinClient SDK v9.52,
which is now available for download form the "Downloads" section on this Forum.

Best Regards,
Danijel Tkalcec
Logged
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!
Page created in 0.025 seconds with 17 queries.