Question

我开发了一个服务应用程序，它从一些设备收集JPEG数据。远程设备的数量从1到20不等。

服务启动后，它会创建许多线程=当前的远程设备数。

每个线程都写入全局记录数组。

记录：

type
TDevice=record
  devName:string;
  ms:TMemoryStream;
end;

Devices:array of TDevice;

CS:TCriticalSection;

线程创建

cs:=TCriticalsection.Create;

for i := 0 to device_list_names.Count-1 do
  begin
    packs[i].ms:=TMemoryStream.Create;
    arr_CT[i]:=TClientThread.Create(false,device_list_ip.Strings[i],
      cs,packs[i].ms);

    arr_CT[i].FreeOnTerminate:=false;
    arr_CT[i].Priority:=tpLower;
  end;

线程破坏

for i := 0 to length(arr_CT)-1 do
  begin
    arr_CT[i].Terminate;
    arr_CT[i].waitfor;
    arr_CT[i].free;
  end;

线程代码

type
  TClientThread = class(TThread)
 private
   imconnected:boolean;
   FLock:TCriticalSection;
   FAddress:string;
   LogPath:string;
   tcpcli:TIdTCPClient;
   Fms:TMemoryStream;
   procedure CreateSocket;
   procedure GetImageStreamTCP;
 protected
   procedure Execute;override;
 public
   constructor Create(CreateSuspended: Boolean;const Address:string;
    var ALock:TCriticalSection; var Ams:TMemoryStream);
 end;

const
  socketport:integer=12340;

implementation

uses GlobalVariables, superlog;

constructor TClientThread.Create(CreateSuspended: Boolean;const Address:string;
  var ALock:TCriticalSection; var Ams:TMemoryStream);
begin
  inherited Create(CreateSuspended);
  FLock:=ALock;
  Fms:=Ams;
  FAddress:=Address;

  imconnected:=false;

  LogPath:='E:\NetView07\Logs\'+FAddress+'_'+
    FormatDateTime('dd-mm-yyyy',now)+'.log';

  posttolog(LogPath,'E:\NetView07\Logs\_'+
            FormatDateTime('dd-mm-yyyy',now)+'.log');

  PostToLog('Thread '+FAddress+' started',Logpath);
end;

procedure TClientThread.CreateSocket;
begin
  tcpcli:=TIdTCPClient.Create(nil);
  tcpcli.Host:=FAddress;
  tcpcli.Port:=socketport;
  tcpcli.ReadTimeout:=3000;
end;

procedure TClientThread.GetImageStreamTCP;
begin
  try
    try
      if not imconnected then
        begin
          tcpcli.Connect;
          imconnected:=true;
        end;
      Flock.Enter;
      Fms.Clear;
      tcpcli.IOHandler.WriteLn('grab');
      tcpcli.IOHandler.ReadStream(Fms, -1);
    except on e:exception do
      begin
        posttolog('Error on receive stream('+FAddress+'): ' + e.Message,LogPath);
        imconnected:=false;
        try
          tcpcli.Disconnect;
        except on e:Exception do
        end;
        posttolog('imconnected=false',LogPath);
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

procedure TClientThread.Execute;
begin
  CreateSocket;

  while not Terminated do
  begin
    GetImageStreamTCP;
    Sleep(200);
  end;
  try
    tcpcli.Disconnect;
  Except on e:Exception do
  end;
  FreeAndNil(tcpcli);

  posttolog(FAddress+' terminated.',LogPath);
end;

问题是有时服务会挂起而没有任何错误。我认为问题出现在CriticalSection中，因为如果我将用足够的日志填充我的代码，那么最后的日志条目将在Flock.Enter之前。

你能告诉我我做错了什么吗？

如果我创建了一个问题副本，我很抱歉。我试图找到相同的问题，但没有结果。

Answer 1

你应该使用这样的结构

type
  TDevice = class
  protected
    FCriticalSection: TCriticalSection;
    FDevName: string;
    Fms: TMemoryStream;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Lock;
    procedure Unlock;

    property DevName: string read FDevName write FDevName;
    property ms: TMemoryStream read Fms write Fms;
  end;

...

constructor TDevice.Create;
begin
  inherited Create;
  FCriticalSection := TCriticalSection.Create;
  Fms:=TMemoryStream.Create;
end;

destructor TDevice.Destroy;
begin
  FreeAndNil(FCriticalSection);
  FreeAndNil(Fms);
  inherited Destroy;
end;

procedure TDevice.Lock;
begin
  FCriticalSection.Enter;
end;

procedure TDevice.Unlock;
begin
  FCriticalSection.Leave;
end;

用法

  Device.Lock;
  try
    Device.ms... // access it
  finally
    Device.Unlock;
  end;

并将整个设备传递到您想要的任何地方，而不仅仅是流。

然后您可以简化线程

constructor TClientThread.Create(const Address:string;
  ADevice:TDevice);
begin
  inherited Create(False);

还有处理执行中的异常

procedure TClientThread.Execute;
begin
  try
    ... your code here ...
  except

  end;
end;

服务中的关键部分，多线程服务

1 个答案: