Delphi ISAPI 多线程日志对象未正确处理

Question

我已尝试使用此处描述的多线程日志解决方案：Delphi multi-threading file write: I/O error 32。

我创建了一个空的 Delphi ISAPI 项目以测试上面 link.

中描述的 TThreadFileLog class

当实例化的 log 对象被放置在 finalize 部分（回收 IIS 应用程序池）时，ISAPI DLL 未正确释放，需要重新启动整个 IIS。

有人可以建议我如何正确释放 log 对象吗？（我是机械工程师，所以我可能缺乏一些编程原理）。

unit LogUnit;

interface

uses Winapi.Windows, System.Classes, System.SysUtils, ThreadFileLog;

type
    PLogRequest = ^TLogRequest;
    TLogRequest = record
        LogText: String;
    end;

    TThreadFileLog = class(TObject)
    private
        FFileName: String;
        FThreadPool: TThreadPool;
        procedure HandleLogRequest(Data: Pointer; AThread: TThread);
    public
        constructor Create(const FileName: string);
        destructor Destroy; override;
        procedure Log(const LogText: string);
    end;

var log: TThreadFileLog;

implementation

{ TThreadFileLog }

constructor TThreadFileLog.Create(const FileName: string);
begin
    FFileName := FileName;
    FThreadPool := TThreadPool.Create(HandleLogRequest, 1);
end;

destructor TThreadFileLog.Destroy;
begin
    FThreadPool.Free;
    inherited;
end;

procedure TThreadFileLog.HandleLogRequest(Data: Pointer; AThread: TThread);
var
    Request: PLogRequest;
    F: TextFile;
begin
    Request := Data;
    try
        AssignFile(F, FFileName);
        if not FileExists(FFileName) then
            Rewrite(F)
        else
            Append(F);
        try
            Writeln(F, DateTimeToStr(Now) + ': ' + Request^.LogText);
        finally
            CloseFile(F);
        end;
    finally
        Dispose(Request);
    end;
end;

procedure TThreadFileLog.Log(const LogText: string);
var
    Request: PLogRequest;
begin
    New(Request);
    Request^.LogText := LogText;
    FThreadPool.Add(Request);
end;

initialization
    OutputDebugString('I N I T');
    log := TThreadFileLog.Create('C:\Temp\Test.log'); // <-- OK

finalization
    log.Free;                   // *** some IIS problem here when app-pool is recycled (need to restart the whole IIS)
    OutputDebugString('E N D'); // *** and this is never reached

end.

unit LogIsapiWebModuleUnit;

interface

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

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

var
    WebModuleClass: TComponentClass = TWebModule1;

implementation

{$R *.dfm}

uses LogUnit;

procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
    log.Log('WEBMODULE1 DefaultHandlerAction');
    Response.Content :=
        '<html>' +
        '<head><title>Web Server Application</title></head>' +
        '<body>Web Server Application</body>' +
        '</html>';
end;

感谢 Stijn Sanders 的宝贵线索，我进行了额外的搜索，可能找到了解决问题的方法，如下所示：

library TestIsapiProject;

uses
    Winapi.Windows,
    Winapi.ActiveX,
    System.Win.ComObj,
    Web.WebBroker,
    Web.Win.ISAPIApp,
    Web.Win.ISAPIThreadPool,
    LogUnit in 'LogUnit.pas',
    TestIsapiMainWebModuleUnit in 'TestIsapiMainWebModuleUnit.pas' {WebModule1: TWebModule};

function TerminateExtension(dwFlags: dword): bool; stdcall;
begin
    // as per Microsoft "TerminateExtension provides a place to
    // put code that cleans up threads or de-allocate resources

    OutputDebugString('TerminateExtension BEGIN');
    log.Free;
    OutputDebugString('TerminateExtension END');

    Result := Web.Win.ISAPIThreadPool.TerminateExtension(dwFlags);
end;

exports
    GetExtensionVersion,
    HttpExtensionProc,
    TerminateExtension;

begin
    CoInitFlags := COINIT_MULTITHREADED;
    Application.Initialize;
    Application.WebModuleClass := WebModuleClass;
    Application.Run;
end.

我还发现 article 可以准确说明问题并提出其他解决方案。但据我所知，在我看来，DoTerminate 从未被调用过。

library TestIsapiProject;

uses
    Winapi.Windows,
    Winapi.ActiveX,
    System.Win.ComObj,
    Web.WebBroker,
    Web.Win.ISAPIApp,
    Web.Win.ISAPIThreadPool,
    LogUnit in 'LogUnit.pas',
    TestIsapiMainWebModuleUnit in 'TestIsapiMainWebModuleUnit.pas' {WebModule1: TWebModule};

procedure DoTerminate;
begin
    // free global objects and wait/terminate threads here
  
    OutputDebugString('TerminateExtension BEGIN');
    log.Free;
    OutputDebugString('TerminateExtension END');
end;

exports
    GetExtensionVersion,
    HttpExtensionProc,
    TerminateExtension;

begin
    CoInitFlags := COINIT_MULTITHREADED;
    Application.Initialize;
    Application.WebModuleClass := WebModuleClass;
    TISAPIApplication(Application).OnTerminate := DoTerminate; // added
    Application.Run;
end.

谢谢。

Answer 1

您的 ISAPI DLL 是否导出函数 TerminateExtension？建议从那里调用所有清理代码，不要依赖 finalization 部分来完成它们的工作。

Delphi ISAPI 多线程日志对象未正确处理

Delphi ISAPI multi-threading log object not disposed correctly

delphi

logging

multithreading