[cesarsoftware]

Hola me respondo porque no puedo editar

Este es el codigo de la thread que realiza la funcion, ya se que no es necesario verla para el caso que nos ocupa, pero no todo va a ser pedir, puede que ha alguien le resulte muy util para saber como hacer thread de lectura TCP/IP y puerto serie (ojo las unidades UnitComm y PComm no van incluidas en delphi)

Código Delphi [-]
unit UnitThReadDCx;

interface

uses
  Windows, Classes, SysUtils,
  IdTCPClient, IdStack, IdBuffer,
  UnitComm, Pcomm;

type
  TTimeEvent = procedure(Sender: TObject) of object;
  ThreadCapturaDCx = class(TThread)
  private
    { Private declarations }
    sio_Status: longint;
    NameId: ansistring;
    miliseg: word;
    RxTime: int64;
    binEnvio: string;
    charEnvio: string;
    bitSalida: array[0..5] of boolean;
    bitContador: boolean;
    bitDisplay: boolean;
    OnVaciaBuffer: boolean;
    TimeVaciaBuffer: int64;
    IdTCPClient: TIdTCPClient;
    FOnCadarecibido: TTimeEvent;
    FOnAbriendo: TTimeEvent;
    FOnFalloAlAbrir: TTimeEvent;
    FOnOkAlAbrir: TTimeEvent;
    FOnCerrando: TTimeEvent;
    FOnFalloAlCerrar: TTimeEvent;
    FOnOkAlCerrar: TTimeEvent;
    FOnDesconectado: TTimeEvent;
    FOnCpsTimer: TTimeEvent;
    FOnBufferLimpio: TTimeEvent;
  protected
    procedure Execute; override;
    procedure CadaRecibido(); dynamic;
    procedure Desconectado(); dynamic;
    procedure Abriendo(); dynamic;
    procedure FalloAlAbrir(); dynamic;
    procedure OkAlAbrir(); dynamic;
    procedure Cerrando(); dynamic;
    procedure FalloAlCerrar(); dynamic;
    procedure OkAlCerrar(); dynamic;
    procedure CadaTimer(); dynamic;
    procedure BufferLimpio(); dynamic;
    procedure VerEstadoLineaSerie();
    procedure ChrDeBin();
    function StrToBytes(cadena: string): TBytes;
    function BufferVacio(): boolean;
    procedure Captura();
    function AbrirSerie(): boolean;
    procedure CerrarSerie();
    procedure RecibeChrSerie();
    function AbrirTCPCliente(): boolean;
    procedure CerrarTCPCliente();
    procedure RecibeChrTCPCliente();
    function CompruebaTCP(): boolean;
    procedure IdTCPClientConnected(Sender: TObject);
    procedure IdTCPClientDisconnected(Sender: TObject);
  public
    // entrada
    tag: word;
    puertocom: longint;
    baudios: integer;
    config: integer;
    control: integer;
    dtr: boolean;
    rts: boolean;
    comtimeout: integer;
    dirip: string;
    puertotcp: word;
    ethernet: boolean;
    CPS: word;
    cpstime: word;
    tipocapturador: word;
    bytesarecibir: integer;
    standby: boolean;
    conectando: boolean;
    // salida
    cts: boolean;
    dsr: boolean;
    ri: boolean;
    cd: boolean;
    abierto: boolean;
    cpsTxCount: word;
    cpsCount: word;
    bufferRec: tBytes;
    recBytes: word;
    cBytes: string;
    constructor Create();
    destructor Destroy(); override;
    property OnCadaRecibido: TTimeEvent read FOnCadarecibido write FOnCadarecibido;
    property OnDesconectado: TTimeEvent read FOnDesconectado write FOnDesconectado;
    property OnCadaTimer: TTimeEvent read FOnCpsTimer write FOnCpsTimer;
    property OnAbriendo: TTimeEvent read FOnAbriendo write FOnAbriendo;
    property OnFalloAlAbrir: TTimeEvent read FOnFalloAlAbrir write FOnFalloAlAbrir;
    property OnOkAlAbrir: TTimeEvent read FOnOkAlAbrir write FOnOkAlAbrir;
    property OnCerrando: TTimeEvent read FOnCerrando write FOnCerrando;
    property OnFalloACerrar: TTimeEvent read FOnFalloAlCerrar write FOnFalloAlCerrar;
    property OnOkAlCerrar: TTimeEvent read FOnOkAlCerrar write FOnOkAlCerrar;
    property OnBufferLimpio: TTimeEvent read FOnBufferLimpio write FOnBufferLimpio;
    function BinToInt(BinStr: string): int64;
    function DifTiempo(inicio, ultimo: longword): longword;
    procedure Iniciar();
    procedure Terminar();
    procedure VaciaBuffer();
    procedure ActualizaCPS();
    procedure ActivaContador(estado: boolean);
    procedure ActivaDisplay(estado: boolean);
    procedure ActivaSalida(numeroBit: word);
    procedure DesactivaSalida(numeroBit: word);
    procedure Escribe(cadena: string);
  end;

implementation

constructor ThreadCapturaDCx.Create();
begin
  // inicializar privadas
  sio_Status := -1;
  NameId := '';
  miliseg := 0;
  RxTime := 0;
  binEnvio := '00000001';
  charEnvio := Chr(BinToInt(binEnvio));
  bitSalida[0] := False;
  bitSalida[1] := False;
  bitSalida[2] := False;
  bitSalida[3] := False;
  bitSalida[4] := False;
  bitSalida[5] := False;
  bitContador := False;
  bitDisplay := False;
  OnVaciaBuffer := False;
  TimeVaciaBuffer := 0;
  IdTCPClient := nil;
  // inicializar entrada
  tag := 0;
  puertocom := 0;
  baudios := 0;
  config := 0;
  control := 0;
  dtr := False;
  rts := False;
  comtimeout := 0;
  dirip := '127.0.0.1';
  puertotcp := 950;
  ethernet := True;
  CPS := 100;
  cpstime := 1000;
  tipocapturador := 0;
  bytesarecibir := -1; // todo
  standby := False;
  conectando := False;
  // inicializar salida
  cts := False;
  dsr := False;
  ri := False;
  cd := False;
  abierto := False;
  cpsTxCount := 0;
  cpsCount := 0;
  bufferRec := nil;
  recBytes := 0;
  cBytes := '';
  inherited Create(True); // entra en modo suspendido
end;

destructor ThreadCapturaDCx.Destroy;
begin
  if IdTCPClient <> nil then
    FreeAndNil(IdTCPClient);
  inherited Destroy;
end;

procedure ThreadCapturaDCx.Execute;
begin
  NameID := AnsiString('DCx:' + IntToStr(tag));
  NameThreadForDebugging(NameId);
  FreeOnTerminate := True;
  Priority := TThreadPriority(tpNormal);
  Iniciar();
end;

function ThreadCapturaDCx.BinToInt(BinStr: string): int64;
var
  RetVar: Int64;
  i: byte;
begin
  // Convierte binario en entero
  BinStr := UpperCase(BinStr);
  if BinStr[length(BinStr)] = 'B' then
    Delete(BinStr,length(BinStr),1);
  RetVar := 0;
  for i := 1 to length(BinStr) do
  begin
    if CharInSet(BinStr[i], ['0', '1']) = False then
    begin
      RetVar := 0;
      Break;
    end;
    RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1);
  end;
  Result := RetVar;
end;

function ThreadCapturaDCx.DifTiempo(inicio, ultimo: longword): longword;
begin
  // Devuelve ms de diferencia entre 2 GetTickCount(), controla el paso por 0
  if ultimo >= inicio then
    Result := ultimo - inicio
  else
    Result := (High(longword) - inicio) + ultimo;//a los 49,7 dias supera dword
end;

procedure ThreadCapturaDCx.Iniciar();
begin
  Synchronize(
    procedure
    begin
    // No hacer nada, esta pare recordar que tambien se puede sicronizar asi
    end
  );
  ActualizaCPS();
  RxTime := GetTickCount();
  abierto := False;
  conectando := True;
  if ethernet = True then
  begin
    if AbrirTCPCliente() = True then
      Captura();
  end
  else
  begin
    if AbrirSerie() = True then
      Captura();
  end;
  abierto := False;
  conectando := False;
end;

procedure ThreadCapturaDCx.Terminar();
begin
  if ethernet = True then
    CerrarTCPCliente()
  else
    CerrarSerie();
  Terminate;
end;

procedure ThreadCapturaDCx.VaciaBuffer();
begin
  OnVaciaBuffer := True;
end;

function ThreadCapturaDCx.BufferVacio(): boolean;
begin
  Result := OnVaciaBuffer;
end;

procedure ThreadCapturaDCx.ActualizaCPS();
begin
  if CPS = 0 then
    miliseg := 0
  else
    miliseg := 1000 div CPS;
  if miliseg = 0 then
    miliseg := 1;
end;

procedure ThreadCapturaDCx.ActivaContador(estado: boolean);
begin
  bitContador := estado;
end;

procedure ThreadCapturaDCx.ActivaDisplay(estado: boolean);
begin
  bitDisplay := estado;
end;

procedure ThreadCapturaDCx.ActivaSalida(numeroBit: word);
begin
  bitSalida[numeroBit] := True;
end;

procedure ThreadCapturaDCx.DesactivaSalida(numeroBit: word);
begin
  bitSalida[numeroBit] := False;
end;

procedure ThreadCapturaDCx.Abriendo();
begin
  if Terminated then
    Exit;
  if Assigned(FOnAbriendo) then
    FOnAbriendo(Self);
end;

procedure ThreadCapturaDCx.FalloAlAbrir();
begin
  abierto := False;
  conectando := False;
  if Terminated then
    Exit;
  if Assigned(FOnFalloAlAbrir) then
    FOnFalloAlAbrir(Self);
end;

procedure ThreadCapturaDCx.OkAlAbrir();
begin
  abierto := True;
  conectando := False;
  if Terminated then
    Exit;
  if Assigned(FOnOkAlAbrir) then
    FOnOkAlAbrir(Self);
end;

procedure ThreadCapturaDCx.Cerrando();
begin
  if Terminated then
    Exit;
  if abierto = False then
    Exit;
  if Assigned(FOnCerrando) then
    FOnCerrando(Self);
end;

procedure ThreadCapturaDCx.FalloAlCerrar();
begin
  if Terminated then
    Exit;
  if Assigned(FOnFalloAlCerrar) then
    FOnFalloAlCerrar(Self);
end;

procedure ThreadCapturaDCx.OkAlCerrar();
begin
  abierto := False;
  if Terminated then
    Exit;
  if Assigned(FOnOkAlCerrar) then
    FOnOkAlCerrar(Self);
end;

procedure ThreadCapturaDCx.Desconectado();
begin
  abierto := False;
  if Terminated then
    Exit;
  if Assigned(FOnDesconectado) then
    FOnDesconectado(Self);
end;

procedure ThreadCapturaDCx.CadaRecibido();
begin
  if Terminated then
    Exit;
  if abierto = False then
    Exit;
  if Assigned(FOnCadaRecibido) then
    FOnCadarecibido(Self);
end;

procedure ThreadCapturaDCx.CadaTimer();
begin
  if Terminated then
    Exit;
  if abierto = False then
    Exit;
  if Assigned(FOnCpsTimer) then
    FOnCpsTimer(Self);
end;

procedure ThreadCapturaDCx.BufferLimpio();
begin
  if Terminated then
    Exit;
  if abierto = False then
    Exit;
  if Assigned(FOnBufferLimpio) then
    FOnBufferLimpio(Self);
end;

procedure ThreadCapturaDCx.ChrDeBin();
begin
{ 0 DC-26 Serie
  1 DC-26 Eth
  2 DC-266 Serie
  3 DC-266 Eth
  4 Terminal DT-6 serie
  5 Terminal DT-6 Eth }
  case tipocapturador of
    0..1: begin
      binEnvio := '';
      if bitSalida[5] = True then
        binEnvio := binEnvio + '1' // #128
      else
        binEnvio := binEnvio + '0';
      if bitSalida[4] = True then
        binEnvio := binEnvio + '1' // #64
      else
        binEnvio := binEnvio + '0';
      if bitSalida[3] = True then
        binEnvio := binEnvio + '1' // #32
      else
        binEnvio := binEnvio + '0';
      if bitSalida[2] = True then
        binEnvio := binEnvio + '1' // #16
      else
        binEnvio := binEnvio + '0';
      if bitSalida[1] = True then
        binEnvio := binEnvio + '1' // #8
      else
        binEnvio := binEnvio + '0';
      if bitSalida[0] = True then
        binEnvio := binEnvio + '1' // #4
      else
        binEnvio := binEnvio + '0';
      binEnvio := binEnvio + '0'; // #2 Reservado
      binEnvio := binEnvio + '1'; // #1 Bit de control
    end;
    2..3: begin
      binEnvio := '1';              // #128
      if bitContador = True then
        binEnvio := binEnvio + '1' // Activar #64
      else
        binEnvio := binEnvio + '0';// Desactivar #64
      if bitSalida[5] = True then
        binEnvio := binEnvio + '1' // #32
      else
        binEnvio := binEnvio + '0';
      if bitSalida[4] = True then
        binEnvio := binEnvio + '1' // #16
      else
        binEnvio := binEnvio + '0';
      if bitSalida[3] = True then
        binEnvio := binEnvio + '1' // #8
      else
        binEnvio := binEnvio + '0';
      if bitSalida[2] = True then
        binEnvio := binEnvio + '1' // #4
      else
        binEnvio := binEnvio + '0';
      if bitSalida[1] = True then
        binEnvio := binEnvio + '1' // #2
      else
        binEnvio := binEnvio + '0';
      if bitSalida[0] = True then
        binEnvio := binEnvio + '1' // #1
      else
        binEnvio := binEnvio + '0';
    end;
    4..5: begin
      binEnvio := '1';             // #128
      if bitSalida[0] = True then
        binEnvio := binEnvio + '1' // #64
      else
        binEnvio := binEnvio + '0';
      if bitSalida[1] = True then
        binEnvio := binEnvio + '1' // #32
      else
        binEnvio := binEnvio + '0';
      if bitSalida[2] = True then
        binEnvio := binEnvio + '1' // #16
      else
        binEnvio := binEnvio + '0';
      if bitSalida[3] = True then
        binEnvio := binEnvio + '1' // #8
      else
        binEnvio := binEnvio + '0';
      if bitSalida[4] = True then
        binEnvio := binEnvio + '1' // #4
      else
        binEnvio := binEnvio + '0';
      if bitSalida[5] = True then
        binEnvio := binEnvio + '1' // #2
      else
        binEnvio := binEnvio + '0';
      binEnvio := binEnvio + '0'; // #1 Bit de control
    end;
  end;
  charEnvio := Chr(BinToInt(binEnvio));
end;

function ThreadCapturaDCx.StrToBytes(cadena: string): TBytes;
var
  buffer: Tbytes;
  i, l: word;
begin
  // Conveierte cadena en array de bytes
  l := Length(cadena);
  if l = 0 then
    Exit;
  SetLength(buffer, l);
  for i := 0 to l - 1 do
    buffer[i] := Ord(cadena[i + 1]);
  Result := buffer;
end;

procedure ThreadCapturaDCx.VerEstadoLineaSerie();
var
  status: longint;
begin
  // Comprueba el estado de la linea serie
  status := sio_lstatus(puertocom);
  if status < 0 then
    status := 0;
  if status and 1 = 1 then
    cts := True
  else
    cts := False;
  if status and 2 = 2 then
    dsr := True
  else
    dsr := False;
  if status and 4 = 4 then
    ri := True
  else
    ri := False;
  if status and 8 = 8 then
    cd := True
  else
    cd := False;
end;

procedure ThreadCapturaDCx.CerrarSerie();
begin
  if Terminated then
    Exit;
  Synchronize(Cerrando);
  sio_Status := PCcierra(puertocom);
  if sio_Status <> sio_OK then
    Synchronize(FalloAlCerrar)
  else
    Synchronize(OkAlCerrar);
end;

function ThreadCapturaDCx.AbrirSerie(): boolean;
begin
  UnitComm.Verbose := False; // sin mensajes
  Synchronize(Abriendo);
  sio_Status := PCabre(puertocom,
                       baudios,
                       config,
                       control,
                       dtr,
                       rts,
                       comtimeout);
  if sio_Status <> sio_OK then
  begin
    Synchronize(FalloAlAbrir);
    Result := False;
    Exit;
  end;
  Synchronize(OkAlAbrir);
  Result := True;
end;

procedure ThreadCapturaDCx.RecibeChrSerie();
begin
  if Terminated then
    Exit;
  if abierto = False then
    Exit;
  Synchronize(VerEstadoLineaSerie);
  if OnVaciaBuffer = False then
    sio_Status := sio_Write(puertocom, PChar(charEnvio), 1);
  cBytes := PCrecibeChr(puertocom);
  // convertir cadena en TBytes
  if Length(cBytes) = 1 then
  begin
    SetLength(bufferRec, 1);
    bufferRec[0] := Ord(cBytes[1]);
  end;
end;

procedure ThreadCapturaDCx.Captura();
begin
  while abierto = True do
  begin
    if Terminated then // si no a terminado la tarea
      Break;
    if standby = False then // si no esta en espera
    begin
      if OnVaciaBuffer = False then // si no tiene que vaciar buffer
      begin
        if bitDisplay = False then  // la lectura de display no necesita envio
        begin
          Inc(cpsTxCount);
          ChrDeBin();
        end;
      end;
      // recoger buffer si lo hay
      if ethernet = True then
        RecibeChrTCPCliente()
      else
        RecibeChrSerie();
      recBytes := Length(cBytes);
      // si hay datos
      if recBytes > 0 then
      begin
        // procesar datos
        Inc(cpsCount, recBytes);
        Synchronize(CadaRecibido);
        // apunta ultimo momento de recepcion de datos
        if OnVaciaBuffer = True then
          TimeVaciaBuffer := GetTickCount();
      end;
      cBytes := '';
      SetLength(bufferRec, 0);
      // si se ha pedido vaciar buffer
      if OnVaciaBuffer = True then
      begin
        // si lleva 10 miliseg sin recibir nada, entoces ha vaciado el buffer
        if DifTiempo(TimeVaciaBuffer, GetTickCount()) > 10 then
        begin
          OnVaciaBuffer := False;
          Synchronize(BufferLimpio);
        end;
      end;
    end;
    if DifTiempo(RxTime, GetTickCount()) >= cpstime then
    begin
      Synchronize(CadaTimer);
      cpsTxCount := 0;
      cpsCount := 0;
      RxTime := GetTickCount();
    end;
    SleepEx(miliseg, False);
  end;
end;

procedure ThreadCapturaDCx.CerrarTCPCliente();
begin
  Synchronize(Cerrando);
  if IdTCPClient <> nil then
  begin
    try
      IdTCPClient.Disconnect;
    finally
      FreeAndNil(IdTCPClient);
    end;
  end;
end;

function ThreadCapturaDCx.AbrirTCPCliente(): boolean;
begin
  Synchronize(Abriendo);
  if IdTCPClient <> nil then
  begin
    try
      if IdTCPClient.Connected then
        IdTCPClient.Disconnect;
    finally
      FreeAndNil(IdTCPClient);
    end;
  end;
  IdTCPClient := TIdTCPClient.Create();
  IdTCPClient.Port := puertotcp;
  IdTCPClient.Host := dirip;
  IdTCPClient.OnConnected := IdTCPClientConnected;
  IdTCPClient.OnDisconnected := IdTCPClientDisconnected;
  try
    IdTCPClient.Connect;
    Result := True;
  except
    on E: EIdSocketError do
    begin
      Synchronize(FalloAlAbrir);
      Result := False;
    end;
  end;
end;

procedure ThreadCapturaDCx.IdTCPClientConnected(Sender: TObject);
begin
  Synchronize(OkAlAbrir);
end;

procedure ThreadCapturaDCx.IdTCPClientDisconnected(Sender: TObject);
begin
  Synchronize(Desconectado);
end;

function ThreadCapturaDCx.CompruebaTCP(): boolean;
begin
  if IdTCPClient = nil then
  begin
    Result := False;
    Exit;
  end;
  try
    if IdTCPClient.IOHandler.ClosedGracefully = True then
    begin
      Result := False;
      Exit;
    end;
    if IdTCPClient.Connected = False then
    begin
      Result := False;
      Exit;
    end;
  except
    on E: EIdSocketError do
    begin
      CerrarTCPCliente();
      Result := False;
      Exit;
    end;
  end;
  Result := True;
end;

procedure ThreadCapturaDCx.RecibeChrTCPCliente();
var
  i: word;
begin
  if Terminated then
    Exit;
  if abierto = False then
    Exit;
  // comprobar las condiciones del canal de datos
  if CompruebaTCP() = False then
    Exit;
  // Enviar peticion de dato al capturador
  if OnVaciaBuffer = False then // si no tiene que vaciar buffer
  begin // para vaciar el buffer no debe pedir mas datos
    if bitDisplay = False then  // la lectura de display no necesita envio
    begin
      case tipocapturador of
        0..5: begin
          try
            IdTCPClient.IOHandler.Write(StrToBytes(charEnvio));
          except
            on E: EIdSocketError do
            begin
              CerrarTCPCliente();
              Exit;
            end;
          end;
        end;
      end;
    end;
  end;
  // Comprobar si ha enviado el dato
  try
//    IdTCPClient.IOHandler.CheckForDataOnSource(10); // ralentiza mucho
    if IdTCPClient.IOHandler.InputBufferIsEmpty = False then
      IdTCPClient.IOHandler.InputBuffer.ExtractToBytes(bufferRec, bytesarecibir, False);
  except
    on E: EIdNotEnoughDataInBuffer do // si se le pide un numero exacto de bytes
      Exit;
    on E: EIdSocketError do
    begin
      CerrarTCPCliente();
      Exit;
    end;
  end;
  recBytes := Length(bufferRec);
  if recBytes = 0 then
    Exit;
  // convertir TBytes en cadena de caracteres
  for i := 0 to recBytes - 1 do
    cBytes := cBytes + Chr(bufferRec[i]);
end;

procedure ThreadCapturaDCx.Escribe(cadena: string);
var
  bufferEnv: tBytes;
begin
  if Terminated then
    Exit;
  if abierto = False then
    Exit;
  // comprobar las condiciones del canal de datos
  if Ethernet = True then
    if CompruebaTCP() = False then
      Exit;
  // enviar datos al canal
  bufferEnv := StrToBytes(cadena);
  if Ethernet = True then
    IdTCPClient.IOHandler.Write(bufferEnv)
  else
    sio_Status := sio_Write(puertocom, PChar(cadena), Length(cadena));
end;

end.