uWorkThread.pas

unit uWorkThread;

interface
uses Classes,IdBaseComponent, IdComponent, IdTCPConnection,
 IdTCPClient, uMessageQueue, SysUtils, SyncObjs,Windows,IdException,Dialogs,global_const;
type
 TWorkThread = class(TThread)                //êëàññ ïîòîêîâ
  private
 //  tip :byte;   //òèï ìîäóëÿ: 1-ïðèíèìàåò,2-ïîñûëàåò
   queue :TMessageQueue;
   IdTCPClient: TIdTCPClient;
   is_work: boolean;
   PauseEvent : Cardinal;
   errormsg:string;
   Is_Connected: Pointer;
    { Private declarations }
  protected
    procedure Execute; override;
  public
    tip :byte;   //òèï ìîäóëÿ: 1-ïðèíèìàåò,2-ïîñûëàåò
    procedure InitThread(recv_send:byte; pqueue :TMessageQueue; TCPClient: TIdTCPClient);
    procedure EndThread(Sender: TObject);
    procedure StopWork;
    procedure PauseWork;
    procedure ShowErrLog;
end;

implementation
//Uses uKernel;
//Èíèöèàëèçàöèÿ êëàññà-ïîòîêà
//Ïàðàìåòðû:
procedure TWorkThread.InitThread(recv_send:byte; pqueue :TMessageQueue; TCPClient: TIdTCPClient);
begin
   tip := recv_send;   //òèï ìîäóëÿ: 1-ïðèíèìàåò,2-ïîñûëàåò
   queue := pqueue;
   IdTCPClient := TCPClient;
   //OnTerminate:= EndThread;   //ôóíêöèÿ îêîí÷àíèÿ ïîòîêà
   is_work := true;
   PauseEvent := CreateEvent(nil, false,false, nil);
   errormsg := '';
end;

procedure TWorkThread.StopWork;
begin
  is_work := false;
  if tip = 2 then  queue.FreeTread;
end;

procedure TWorkThread.Execute;
var
    pack, str: string;
begin
  case tip of
  1: begin        //ïðèíèìàåì ñîîáùåíèÿ ñ ñåðâåðà
      while(is_work)do
        begin
         try
           //ñíà÷àëà ïðèíèìàåì çàãîëîâîê
            pack := '';
            str := ' ';
          //ïîòîì âñå îñòàëüíîå                   //íàäî ñîçäàòü ïàêåò
         // IdTCPClient.ReadBuffer(str[1],1);
          pack := IdTCPClient.CurrentReadBuffer;   //,sizeáóäåò ëè ðàáîòàòü?
          if (pack<> '') then
          begin
          pack := str + pack;
          queue.Put(Pack);
          end;
        except
        on  e:EIdConnClosedGracefully  do
          begin
            errormsg:= e.Message;
            Errlog('TWorkThread.Execute tip=1 on EIdConnClosedGracefully'+ errormsg);
            if  IdTCPClient.Connected then
                begin
                  DoTerminate
                end;
           
          //  Synchronize(ShowErrLog);
          end;
        on e:EIdSilentException do
            begin
             errormsg:= e.Message;
              Errlog('TWorkThread.Execute tip=1 on EIdSilentException'+ errormsg);
              if  IdTCPClient.Connected then
                begin
                  DoTerminate
                end;
          end;
        on e:EIdNotConnected do
            begin
             errormsg:= e.Message;
             Errlog('TWorkThread.Execute tip=1 on EIdNotConnected'+ errormsg);
              if  IdTCPClient.Connected then
                begin
                  DoTerminate
                end;
          end;
        on e:  EIdException do
            begin
              errormsg:= e.Message;
              Errlog('TWorkThread.Execute tip=1 on EIdException___'+ errormsg);
              if  IdTCPClient.Connected then
                begin
                  DoTerminate
                end;
            end
         else
              errormsg:= 'Left Error';
              Errlog('TWorkThread.Execute tip=1 on else'+ errormsg);
              if  IdTCPClient.Connected then
                begin
                  DoTerminate
                end;
       end;
       end; //while
     end;

  2: begin       //ïîñûëàåì ñîîáùåíèÿ íà ñåðâåð
       while(is_work) do
        begin
          pack := queue.Extract;
          if pack<>'' then
          begin
          try
            IdTCPClient.WriteBuffer(pack[1],Length(pack));
          except
           on  e:EIdConnClosedGracefully  do
          begin
            errormsg:= e.Message;
            Errlog('TWorkThread.Execute tip=2 on EIdConnClosedGracefully'+ errormsg);
              if  IdTCPClient.Connected then
                begin
                  DoTerminate
                end;
          end;
          else
             Errlog('TWorkThread.Execute tip=2 on else'+ errormsg);
               if  IdTCPClient.Connected then
                begin
                  DoTerminate
                end;
          //  is_work := false;  ///ñåðâåð óïàë!!!äîäåëàòü
          end;
          end;

        end;
     end;
  end;
 // Terminate;                        //çàâåðøàåì ïîòîê
end;

procedure TWorkThread.EndThread(Sender: TObject);
var t:integer;
begin
//äîîáðàáîòàòü îñòàâøèåñÿ â î÷åðåäè ñîîáùåíèÿ?

end;

procedure TWorkThread.PauseWork;
var size: integer;
    pack: string;
    waitres : Cardinal;
    exitflag : boolean;
begin
  case tip of
  1:  begin      //ïðèíèìàåò
        //
      end;
  2:  begin    //îòïðàâëÿåò

      {    exitflag := false;
          pack := TPacket.Create;
          pack.Seek(0,soFromBeginning);
          size := END_WORK;
          pack.Write(size,4);
          Queue.Put(pack);
          waitres := WaitForSingleObject(PauseEvent, 10000);
          if (waitres = WAIT_OBJECT_0) then
            begin
          //     IdTCPClient.Disconnect;
              Suspend;
              exitflag := true;
            end;
             }
      end;
  end;        

end;

procedure TWorkThread.ShowErrLog;
begin
  ShowMessage('Error'+ errormsg);
end;

end.