Delphi ISAPI多线程日志对象未正确处理
Delphi ISAPI多线程日志对象未正确处理
提问于 2020-12-26 10:29:32
我尝试使用这里描述的多步日志解决方案：Delphi多线程文件写入: I/O错误32。
为了测试上述链接中描述的TThreadFileLog类，我创建了一个空的Delphi项目。
当实例化的log对象在IIS部分(回收IIS应用程序池)中被释放时，ISAPI没有被正确地释放，整个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.此外，我还找到了这个文章，它精确地说明了问题，并提出了另一个解决方案。但据我所知，在我看来，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.谢谢。
Stack Overflow用户
回答已采纳
发布于 2020-12-26 18:51:49
您的ISAPI是否导出一个函数TerminateExtension(https://learn.microsoft.com/en-us/previous-versions/iis/6.0-sdk/ms524470(v=vs.90%29)?，建议从那里调用所有清理代码，而不依赖finalization部分来完成它们的工作。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/65455467
复制相关文章
相似问题
腾讯云开发者
