1

我有一个使用线程辅助对象的 ISAPI 扩展 DLL。在我的 QA 服务器上，线程成功执行，而在实时服务器上却没有。两种环境中的服务器硬件相同。开发语言为 Delphi XE2。

unit uRemoteTest2Intf;

interface
uses Soap.InvokeRegistry, System.Types, Soap.XSBuiltIns;

type
  { Invokable interfaces must derive from IInvokable }
  IRemoteTest = interface(IInvokable)
  ['{9F4E3DF8-5D22-46FE-B3DC-B6CD8EE971AD}']
    function LogData(const Value: string): string; stdcall;
  end;

implementation

initialization
  InvRegistry.RegisterInterface(TypeInfo(IRemoteTest));

end.

unit uRemoteTest2Impl;

interface
uses Soap.InvokeRegistry, System.Types, Soap.XSBuiltIns, uRemoteTest2Intf, uThread;

type
  { TRemoteTest }
  TRemoteTest = class(TInvokableClass, IRemoteTest)
  private
    worker: TWorkerThread;
  public
    function LogData(const Value: string): string; stdcall;
    constructor Create; override;
    destructor Destroy; override;
  end;

implementation

uses
  uLog, Winapi.Windows, Winapi.Messages;

procedure RemoteTestFactory(out obj: TObject);
{$J+}
const
  iInstance: IRemoteTest = nil;
  instance: TRemoteTest = nil;
begin
  if instance = nil then
  begin
    instance := TRemoteTest.Create;
    instance.GetInterface(IRemoteTest, iInstance)
  end;
  obj := instance
end;

constructor TRemoteTest.Create;
begin
  inherited;
  //SetApplicationLogLevel(2);
  //SetApplicationLogFilename('c:\temp\test.txt');

  Log('Calling TRemoteTest.Create');
  worker := TWorkerThread.Create;
  worker.Start;
  if worker.Suspended then
    Log('worker is  suspended')
  else
    Log('worker is not suspended');

  Log('Called TRemoteTest.Create');
end;

destructor TRemoteTest.Destroy;
begin
  Log('Calling TRemoteTest.Destroy');
  worker.Free;
  inherited;
end;

function TRemoteTest.LogData(const Value: string): string;
begin
  Log('Calling TRemoteTest.LogData');
end;

initialization

InvRegistry.RegisterInvokableClass(TRemoteTest, RemoteTestFactory);

end.

unit uThread;

interface
uses
  System.Classes;

type
  TWorkerThread = class(TThread)
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  uLog;

constructor TWorkerThread.Create;
begin
  inherited Create(true);
  Log('Calling TWorkerThread.Create');
end;

destructor TWorkerThread.Destroy;
begin
  Log('Calling TWorkerThread.Destroy');
  inherited;
end;

procedure TWorkerThread.Execute;
begin
  NameThreadForDebugging('WorkerThread');
  Log('Executing Thread');
  while not Terminated do
  begin
    sleep(1000);
    Log('Executing thread');
  end;
  Log('Executed Thread');
end;

end.

{Log 过程是引用的 uLog.pas 文件中的内部日志记录例程}

在 IIS 服务器上，要运行的最后一段代码是 TWorkerThread.Start（在主线程内）。线程的 Execute 方法（应该在该线程的上下文中运行）永远不会被调用。

4

0 回答 0