Question

更新问题仍然存在。

是否可以在已经运行的线程中运行代码？例如： thread1正在运行一些代码＆amp;我想在thread1中运行thread2中的代码。

我想在idTCPServer线程中运行代码以将一些数据发送到客户端

修改经过研究似乎我的问题是，当收到客户端数据或正在接收同一时间时，另一个线程正在尝试写入该套接字。

修改

procedure TMainFrm.UserSRVExecute(AContext: TIdContext);
var
 Command        : String;
 msSize         : Int64;
 ms             : TMemoryStream;
 decompressedMS : TMemoryStream;
 H              : TIdNotify;
begin
// Application.ProcessMessages;
 Command := AContext.Connection.Socket.ReadLn;
// messagebox(0,'snd','',$40);
 if logb then mainfrm.mconnections.Lines.Add(command + ' - BEGIN');

 if Command <> '' then   // keepalive 
  begin
  //Application.ProcessMessages;
   msSize         := AContext.Connection.Socket.ReadInt64;
   ms             := TMemoryStream.Create;
   decompressedMS := TMemoryStream.Create;
   try
    AContext.Connection.Socket.ReadStream(ms, msSize);
    ms.Position := 0;
    DecompressStream(MS,decompressedMS);
    decompressedMS.Position := 0;
    Client_ProcessData(AContext,Command,decompressedMS);
   finally
    ms.Free;
    decompressedMS.Free;
    if logb then mainfrm.mconnections.Lines.Add(command + ' - END');
   end;
  end;
end;


procedure Client_ProcessData(AContext: TIdContext; cmd : String; data : TMemoryStream);
var
 Hnd     : THandle;
 clData  : TStringArray;
 TmpStr1 : String;
 Tmp     : String;
 TN      : TIdNotify;

 Sync    : TMySync;
 I,I2    : Integer;
begin
 Hnd := AContext.Connection.Socket.Binding.Handle;

 if cmd = 'scr' then  // RECEIVE COMMAND TO SEND TO CLIENT TO RECEIVE DATA FROM CLIENT
  begin
   Tmp := StreamToString(data);
   {Sync := TMySync2.Create(True);
   try
    Sync.cmd := cmd;
    Sync.hnd := Hnd;
    Sync.tmp := TmpStr1;
    Sync.Resume;
   finally
    //Sync.Free;
   end;  }
   log('>>> CLFROMAS: '+IntToStr(HND)+':::'+cmd+':::');
 //  SendCMDToSocket(MainFrm.UserSRV,StrToInt(Trim(Tmp)),'scr'+IntToStr(Hnd));
   I2 := StrToInt(Trim(Tmp));
  for I := 0 to 100 do
  if USRVData[i].hnd = I2 then
   begin
   // cs.Acquire;
    USRVData[i].CTX.Connection.Socket.WriteLn('scr'+IntToStr(Hnd));  // PLACED ALL CONTEXTs IN GLOBAL VARIABLE + ALL SOCKET HANDLES. <--- HERE IS THE PROBLEM
   // cs.Release;
    Break;
   end;
 //  log('>>> CLFROMAS: '+IntToStr(HND)+':::'+cmd+':::'+streamtostring(data));
   Exit;
  end;

   if Copy(cmd,1,Length('scr4u')) = 'scr4u' then // RECEIVE DATA FROM CLIENT TO SEND IT TO ADMIN CLIENT REQUEST ABOVE
   begin
    if Length(cmd) > Length('scr4u') then
     begin
      Delete(cmd,1,Length('scr4u'));
      Data.Position := 0;
     { Sync := TMySync.Create;
      try
       Sync.cmd := cmd;
       Sync.hnd := Hnd;
       Sync.data := TMemoryStream.Create;
       Sync.data.CopyFrom(data,data.Size);
       Sync.data.Position := 0;
       Sync.DoNotify;
      finally
       Sync.data.Free;
       Sync.Free;
      end;  }
      SendStreamToSocket(MainFrm.UserSRV,strtoint(cmd),'scr4u',Data);

      log('>>>>> ADMIN: '+IntToStr(HND)+':::'+cmd+':::'{+streamtostring(data)});
     end else TmpStr1 := '';
    Exit;
   end;

   ...

更新

procedure TMainFrm.UserSRVExecute(AContext: TIdContext);
var
 Command        : String;
 msSize         : Int64;
 ms             : TMemoryStream;
 decompressedMS : TMemoryStream;
 H              : TIdNotify;
 I              : Integer;
 List, Messages : TStringList;
begin
  Messages := nil;
  try
   List := TMyContext(AContext).OutgoingMessages.Lock;
   try
    if List.Count > 0 then
     begin
      Messages := TStringList.Create;
      Messages.Assign(List);
      List.Clear;
     end;
   finally
    TMyContext(AContext).OutgoingMessages.Unlock;
   end;
   if Messages <> nil then
    begin
     for I := 0 to Messages.Count-1 do
      begin
       AContext.Connection.IOHandler.WriteLn(Messages.Strings[I]);
      end;
    end;
  finally
   Messages.Free;
  end;

  if AContext.Connection.IOHandler.InputBufferIsEmpty then
   begin
    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
      Exit;
   end;

 Command := AContext.Connection.Socket.ReadLn;

 if logb then mainfrm.mconnections.Lines.Add(command + ' - BEGIN');

 if Command <> '' then
  begin
   msSize         := AContext.Connection.Socket.ReadInt64;
   ms             := TMemoryStream.Create;
   decompressedMS := TMemoryStream.Create;
   try
    AContext.Connection.Socket.ReadStream(ms, msSize);
    ms.Position := 0;
    DecompressStream(MS,decompressedMS);
    decompressedMS.Position := 0;
    Client_ProcessData(AContext,Command,decompressedMS);
   finally
    ms.Free;
    decompressedMS.Free;
    if logb then mainfrm.mconnections.Lines.Add(command + ' - END');
   end;
  end;
end;

Answer 1

是否可以在已经运行的线程中运行代码？例如：thread1正在运行一些代码＆amp;我想在thread1中运行thread2中的代码。

没有。需要对Thread1进行显式编码以停止当前正在执行的操作，执行其他操作，然后返回到之前的操作。所有Thread2都能做到的是信号Thread1，以便在最早的方便时执行停止+继续。

我想在idTCPServer线程中运行代码以将一些数据发送到客户端

您的TIdTCPServer.OnExecute事件处理程序需要定期检查该数据，并在可用时发送。

您可以使用TIdContext.Data属性，或从TIdServerContext派生自定义类并将其分配给TIdTCPServer.ContextClass属性，以便为您的出站提供每个客户端的线程安全缓冲区数据。然后，您的OnExecute处理程序可以在需要时访问该缓冲区。

例如：

type
  TMyContext = class(TIdServerContext)
  public
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
    OutgoingMessages: TIdThreadSafeStringList;
  end;

constructor TMyContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited;
  OutgoingMessages := TIdThreadSafeStringList.Create;
end;

destructor TMyContext.Destroy;
begin
  OutgoingMessages.Free;
  inherited;
end;

procedure TMyForm.FormCreate(Sender: TObject);
begin
  // this must be set before activating the server...
  IdTCPServer1.ContextClass := TMyContext;
end;

procedure TMyForm.IdTCPServer1Execute(AContext: TIdContext);
var
  List, Messages: TStringList;
begin
  // check for outgoing data...

  Messages := nil;
  try
    List := TMyContext(AContext).OutgoingMessages.LockList;
    try
      if List.Count > 0 then
      begin
        Messages := TStringList.Create;
        Messages.Assign(List);
        List.Clear;
      end;
    finally
      TMyContext(AContext).OutgoingMessages.UnlockList;
    end;
    if Messages <> nil then
    begin
      // send Messages using AContext.Connection.IOHandler as needed...
    end;
  finally
    Messages.Free;
  end;

  // check for incoming data...

  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
      Exit;
  end;

  // process incoming data as needed...
end;

procedure TForm1.SomeProcedure;
var
  List: TIdContextList;
  Context: TMyContext;
begin
  List := IdTCPServer1.Contexts.LockList;
  try
    Context := TMyContext(List[SomeIndex]);
    Context.OutgoingMessages.Add('something');
  finally
    IdTCPServer1.Contexts.UnlockList;
  end;
end;

如何在已经运行的线程中运行代码以安全地发送/ recv数据[TidTCPServer]

1 个答案: