var StrMsg  : string;
    i : Integer; b : Byte;
Begin
    FDEFINE(BOX_L4,BOX_L4_SZ,True);
   while not Terminated do Begin
     FGET(BOX_L4,@m_nMsg);
     if Terminated then Exit;
     if m_nL4Synchronize = 1  then Synchronize(OnHandler)
     else EventHandler(m_nMsg);
   End;
End;

procedure FDEFINE(nIndex:Integer;w_lBoxSize:DWord;blSynch:Boolean);
Begin
  try
    with pHiBuff[nIndex] do begin
      if sCS=Nil then Begin
        sCS         := TCriticalSection.Create;
        SetLength(pb_mBoxCont,w_lBoxSize+3000);
        w_mEvent    := CreateEvent(nil, False, False, nil);
        w_mBoxSize  := w_lBoxSize;
        w_mBoxCSize := w_lBoxSize;
        w_mBoxWrite := 0;
        w_mBoxRead  := 0;
        w_mBoxMesCt := 0;
        w_blSynchro := blSynch;
        m_byIsEvent := False;
        ResetEvent(w_mEvent);
      end;
    end;
  except
     SClass.ToStringBox(ET_CRITICAL, 'Ошибка в utlbox.FDEFINE ');
  end;
End;

function FGET(nIndex:Integer;pb_lInBox:Pointer):Integer;
Var wLng:Word;
Begin
  try
    if pHiBuff[nIndex].w_blSynchro then WaitForSingleObject(pHiBuff[nIndex].w_mEvent, INFINITE);
     Move(pHiBuff[nIndex].pb_mBoxCont[pHiBuff[nIndex].w_mBoxRead],wLng,2);
     Move(pHiBuff[nIndex].pb_mBoxCont[pHiBuff[nIndex].w_mBoxRead],pb_lInBox^,wLng);
     pHiBuff[nIndex].w_mBoxRead  := pHiBuff[nIndex].w_mBoxRead + wLng;
     pHiBuff[nIndex].w_mBoxSize  := pHiBuff[nIndex].w_mBoxSize + wLng;
     pHiBuff[nIndex].w_mBoxMesCt := pHiBuff[nIndex].w_mBoxMesCt - 1;
     if(pHiBuff[nIndex].w_mBoxRead > pHiBuff[nIndex].w_mBoxCSize) then pHiBuff[nIndex].w_mBoxRead := 0;
     if pHiBuff[nIndex].w_mBoxMesCt=0 then ResetEvent(pHiBuff[nIndex].w_mEvent)
     else SetEvent(pHiBuff[nIndex].w_mEvent);
     result := wLng;
  except
    SClass.ToStringBox(ET_CRITICAL, Ошибка в utlbox.FGET ');
  end;
End;

destructor CThread.Destroy;
begin
  try
  if Suspended then begin
    TerminateThread(Self.Handle, 0);
  end;
  except
    on E : Exception do
      SendEventBox(ETA_ERROR_METR+usedColor, 'Ошибка в : CThread.Destroy: '+E.Message);
  end;
  if SenderClass <> Nil then FreeAndNil(SenderClass);
  inherited;
end;

//  pL4Module.Suspend;
  pL4Module.Terminate;
//  FDEFINE(BOX_L4,BOX_L4_SZ,True);
//  FPUT(BOX_L4,@m_nMsg);
  if pL4Module <> nil then FreeAndNil(pL4Module);

    repeat
      { This prevents a potential deadlock if the background thread
        does a SendMessage to the foreground thread }
      if WaitResult = WAIT_OBJECT_0 + 2 then
        PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
      WaitResult := MsgWaitForMultipleObjects(2, H, False, 1000, QS_SENDMESSAGE);
      CheckThreadError(WaitResult <> WAIT_FAILED);
      if WaitResult = WAIT_OBJECT_0 + 1 then
        CheckSynchronize;
    until WaitResult = WAIT_OBJECT_0;

constructor CThread.Create(Bool: boolean);
begin
  inherited Create(Bool);
  . . .
  TerminateEvent := CreateEvent(nil, True, False, 'TerminateEvent');
end;

destructor CThread.Destroy;
begin
  try
{  if Suspended then begin
    TerminateThread(Self.Handle, 0);
  end;}
  SetEvent(TerminateEvent);
  except
    on E : Exception do
      SendEventBox(ETA_ERROR_METR+usedColor, 'Ошибка в : CThread.Destroy: '+E.Message);
  end;
  FreeAndNil(SenderClass);
  inherited;
end;

function FGETMULT(nIndex:Integer; pb_lInBox:Pointer; AE: ArrayEvents):Integer;
Var wLng:Word;
Begin
  try
    case WaitForMultipleObjects(2, @AE, False, 1) of
      WAIT_OBJECT_0:
        begin
          Move(pHiBuff[nIndex].pb_mBoxCont[pHiBuff[nIndex].w_mBoxRead],wLng,2);
          Move(pHiBuff[nIndex].pb_mBoxCont[pHiBuff[nIndex].w_mBoxRead],pb_lInBox^,wLng);
          pHiBuff[nIndex].w_mBoxRead  := pHiBuff[nIndex].w_mBoxRead + wLng;
          pHiBuff[nIndex].w_mBoxSize  := pHiBuff[nIndex].w_mBoxSize + wLng;
          pHiBuff[nIndex].w_mBoxMesCt := pHiBuff[nIndex].w_mBoxMesCt - 1;
          if(pHiBuff[nIndex].w_mBoxRead > pHiBuff[nIndex].w_mBoxCSize) then pHiBuff[nIndex].w_mBoxRead := 0;
          if pHiBuff[nIndex].w_mBoxMesCt=0 then ResetEvent(AE[0]) // ResetEvent(pHiBuff[nIndex].w_mEvent)
          else SetEvent(pHiBuff[nIndex].w_mEvent);
          result := wLng;
        end;
      WAIT_OBJECT_0 + 1:
        begin
          ResetEvent(AE[1]);
          Exit;
        end;
    end;
  except
    SClass.ToStringBox(ET_CRITICAL, 'Ошибка в utlbox.FGETMULT ');
  end;
End;

ArrayEvents = array[0..1] of THandle;

     FEvents        : ArrayEvents;
     TerminateEvent : THandle;

procedure CL4Module.Execute;
Begin
   FDEFINE(BOX_L4,BOX_L4_SZ,True);
   while not Terminated do Begin
     FEvents[0] := pHiBuff[BOX_L4].w_mEvent;
     FEvents[1] := TerminateEvent;
     FGETMULT(BOX_L4, @m_nMsg, FEvents);
     if Terminated then Exit;
      if m_nL4Synchronize = 1  then Synchronize(OnHandler)
. . . 

  pL4Module.Terminate;
  if pL4Module <> nil then FreeAndNil(pL4Module);
  . . . 

procedure FreeAndNil(var Obj);
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;