unit UThreadCom;
interface
uses Windows, Sysutils, Classes;
type
EThreadCom = class(Exception);
TThreadCom = class(TThread)
private
FHandle: THandle;
FPort: Integer;
procedure Procesar(Str: String);
protected
procedure Execute; override;
public
constructor Create(APort: Integer);
destructor Destroy; override;
end;
implementation
// Esta funcion solo esta para hacer pruebas
procedure log(Mensaje: String);
var
F: TextFile;
Filename: String;
Mutex: THandle;
SearchRec: TSearchRec;
begin
// Insertamos la fecha y la hora
Mensaje:= FormatDateTime('[ddd dd mmm, hh:nn] ', Now) + Mensaje;
// El nombre del archivo es igual al del ejecutable, pero con la extension .log
Filename:= ChangeFileExt(ParamStr(0),'.log');
// Creamos un mutex, usando como identificador unico la ruta completa del ejecutable
Mutex:= CreateMutex(nil,FALSE,
PChar(StringReplace(ParamStr(0),'\','/',[rfReplaceAll])));
if Mutex <> 0 then
begin
// Esperamos nuestro turno para escribir
WaitForSingleObject(Mutex, INFINITE);
try
// Comprobamos el tamaño del archivo
if FindFirst(Filename,faAnyFile,SearchRec) = 0 then
begin
// Si es mayor de un mega lo copiamos a (nombre).log.1
if SearchRec.Size > (1024*1024) then
MoveFileEx(PChar(Filename),PChar(Filename + '.1'),
MOVEFILE_REPLACE_EXISTING);
FindClose(SearchRec);
end;
try
AssignFile(F, Filename);
{$I-}
Append(F);
if IOResult <> 0 then
Rewrite(F);
{$I+}
if IOResult = 0 then
begin
// Escribimos el mensaje
Writeln(F,Mensaje);
CloseFile(F);
end;
except
//
end;
finally
ReleaseMutex(Mutex);
CloseHandle(Mutex);
end;
end;
end;
{ TThreadCom }
constructor TThreadCom.Create(APort: Integer);
var
DCB: TDCB;
begin
FPort:= APort;
FHandle:= CreateFile(PChar('\\.\COM' + IntToStr(APort)), GENERIC_READ or
GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if FHandle = INVALID_HANDLE_VALUE then
raise EThreadCom.Create('No puedo abrir el puerto COM' + IntToStr(APort));
DCB.DCBlength:= Sizeof(DCB);
if not GetCommState(FHandle,DCB) then
raise EThreadCom.Create('Error al configurar el puerto');
// Aqui esta la configuracion del puerto. Se la podriamos pasar por parametros ...
with DCB do
begin
BaudRate := CBR_9600;
ByteSize := 8;
Parity := NOPARITY;
StopBits := ONESTOPBIT;
Flags := $01;
end;
if not SetCommState(FHandle, DCB) then
raise EThreadCom.Create('Error al configurar el puerto');
inherited Create(FALSE);
end;
destructor TThreadCom.Destroy;
begin
if FHandle = INVALID_HANDLE_VALUE then
CloseHandle(FHandle);
inherited;
end;
const
CR = #13;
LF = #10;
BUFFERSIZE = 1024;
procedure TThreadCom.Execute;
var
Err: DWORD;
COMSTAT: TCOMSTAT;
Buffer: PChar;
Str: String;
i: Integer;
begin
Getmem(Buffer,BUFFERSIZE);
try
Str:= EmptyStr;
while not Terminated do
if ClearCommError(FHandle,Err,@COMSTAT) then
if COMSTAT.cbInQue > 0 then
begin
if COMSTAT.cbInQue >= BUFFERSIZE then
Err:= BUFFERSIZE - 1
else
Err:= COMSTAT.cbInQue;
FillChar(Buffer^,BUFFERSIZE,#0);
if ReadFile(FHandle,Buffer^,Err,Err,nil) then
begin
Str:= Str + String(Buffer);
i:= Pos(CR,Str);
while i > 0 do
begin
Procesar(Trim(Copy(Str,1,i-1)));
Delete(Str,1,i);
i:= Pos(CR,Str);
end;
end else
begin
// Aqui podemos guardar un error en el log
end;
end else
Sleep(10);
finally
FreeMem(Buffer);
end;
end;
procedure TThreadCom.Procesar(Str: String);
begin
// Aqui procesamos cada una de las lineas de texto
// Para hacer pruebas
log(Str);
end;
end.
, gracias amigo, esto va a ser muy util para mi y para muchos mas
