multithreading em delphi par uso de portas seriais
15/04/2013
0
Uso componentes / ActiveX para enviar SMS com modem conectado no USB.
Preciso criar uma multithread para ler várias portas USB ao mesmo tempo, tipo todas portas USB existente no PC ou até mesmo usando um HUB USB.
Obrigado a quem puder ajudar.
Welder.
Posts
30/04/2013
Diego Garcia
30/04/2013
Welder.
Olá drgarcia1986, hoje eu já consigo ler as portas, me conecto na porta COM (USB).
O que eu preciso é criar uma thread que conecte em várias portas COM ao mesmo tempo, usando várias instância do componente que uso.
Ex:
objSMS1.OpenComPort(COM10);
objSMS2.OpenComPort(COM12);
objSMS3.OpenComPort(COM14);
Isso sem saber a quantidade de portas que será necessário, tipo usando um For
30/04/2013
Diego Garcia
30/04/2013
Welder.
Exatamente isso que preciso. Mas o problema é que não estou conseguindo criar.
Assim o Objeto ficaria dentro da thread? Não irá instanciar um objeto já instanciado?
30/04/2013
Diego Garcia
05/05/2013
Welder.
Dá uma olhada como está meu código.
1 - Criação da Thread
TSendReceive = Class(TThread)
protected
procedure Execute; override;
private
FTimer: TTimer;
procedure OverrideOnTerminate(Sender: TObject);
procedure OverrideOnTimer(Sender: TObject);
public
objSMS: TGSMSMS;
iError: Integer;
procedure SetParametros(Port, Parity, StopBits: String; BaudRate: Integer;
CharEncoding, FlowControl, DataBits: SmallInt);
procedure SendReceiveSms(sTexto, sNumero: String; RelatorioEntrega, SmsDeAlerta: Boolean);
end;
2 - Implementação dos métodos
procedure TSendReceive.Execute;
begin
inherited;
FreeOnTerminate := True;
FTimer := TTimer.Create(nil);
FTimer.OnTimer := OverrideOnTerminate;
FTimer.OnTimer := OverrideOnTimer;
FTimer.Interval := 1000;
end;
procedure TSendReceive.SendReceiveSms(sTexto, sNumero: String; RelatorioEntrega, SmsDeAlerta: Boolean);
begin
objSMS.SendMessage(sTexto, sNumero, RelatorioEntrega, SmsDeAlerta);
iError := objSMS.ErrorNo;
if iError = 0 then
frmSmsBrasilDelivery.MotraMensagem(' Mensagem enviada com sucesso!!!.')
else
frmSmsBrasilDelivery.MotraMensagem(' Mensagem não enviada.' + objSMS.ErrorDescription);
end;
procedure TSendReceive.SetParametros(Port, Parity, StopBits: String; BaudRate: Integer;
CharEncoding, FlowControl, DataBits: SmallInt);
begin
objSMS := TGSMSMS.Create(Application);
objSMS.COMPort := Port;
objSMS.BaudRate := BaudRate;
objSMS.DataBits := DataBits;
objSMS.Parity := Parity;
objSMS.StopBits := StopBits;
objSMS.FlowControl := FlowControl;
objSMS.CharEncoding := CharEncoding;
if objSMS.OpenCOMPort then
frmSmsBrasilDelivery.MotraMensagem(Port + ' Aberta com sucesso.')
else
frmSmsBrasilDelivery.MotraMensagem(Port + ' Falha na abertura da porta.');
end;
procedure TSendReceive.OverrideOnTerminate(Sender: TObject);
begin
FTimer.Enabled := false;
FreeAndNil(FTimer);
end;
procedure TSendReceive.OverrideOnTimer(Sender: TObject);
begin
Self.Execute;
end;
3 - Chamada dos métodos
if cboCharacter.ItemIndex = 0 then
Characther := 8
else
if cboCharacter.ItemIndex = 1 then
Characther := 7
else
Characther := 16;
dmPrincipal.ChecaPortasAtiva;
dmPrincipal.cdsPortasAtivas.First;
while not dmPrincipal.cdsPortasAtivas.Eof do
begin
W := TSendReceive.Create(True);
with W do
begin
FreeOnTerminate := True;
SetParametros(dmprincipal.cdsPortasAtivas.FieldByName('PORTA').Value, 'N', '1', 115200, Characther, 0, 8);
Resume;
end;
dmPrincipal.cdsPortasAtivas.Next;
end;
Obs: Preciso que o método SendReceiveSms seja executado várias vezes, tipo a cada segundo, para cada registro existente no cdsPortasAtivas.
06/05/2013
Diego Garcia
FTimer.OnTimer := OverrideOnTerminate; FTimer.OnTimer := OverrideOnTimer;
imagino que você quis fazer
Self.OnTerminate := OverrideOnTerminate; FTimer.OnTimer := OverrideOnTimer;
agora, não seria mais correto no Execute da thread você fazer algo do tipo
FTimer.Enable := true; while not (self.Terminate) do begin continue; end; FTimer.Enable := false;
E no OnTimer do TTimer vc manda as msgs ?
06/05/2013
Diego Garcia
while not (Self.Terminated) do begin ...
06/05/2013
Welder.
while not (Self.Terminated) do begin ...
Ok. Fiz a correção. Agora tenho uma procedure que executa várias instruções, faz consulta no banco e tal.
eu preciso colocar essa procedure no execute da Thread.
08/05/2013
Welder.
while not (Self.Terminated) do begin ...
coloquei minha procedure dentro do executar da Thread, ao executar o programa ocorre:
delphi EOleSysError with message 'CoInitialize não foi chamado
o que Ficou errado?
08/05/2013
Diego Garcia
CoInitialize(nil);
no inicio da thread e o
CoUninitialize();
no final da thread
08/05/2013
Welder.
CoInitialize(nil);
no inicio da thread e o
CoUninitialize();
no final da thread
Agora ocorre esse erro:
---------------------------
Debugger Exception Notification
---------------------------
Project SmsBrasilDelivery.exe raised exception class EAccessViolation with message 'Access violation at address 72A249AD in module 'MSVBVM60.DLL'. Write of address 00000098'.
---------------------------
Break Continue Help
---------------------------
08/05/2013
Welder.
procedure TSendReceive.Execute;
begin
inherited;
try
FreeOnTerminate := True;
FTimer := TTimer.Create(nil);
FTimer.OnTimer := OverrideOnTerminate;
FTimer.OnTimer := OverrideOnTimer;
FTimer.Interval := 1000;
FTimer.Enable := true;
while not (self.Terminate) do
begin
SendReceiveSms(sTexto, sNumero: String; RelatorioEntrega, SmsDeAlerta: Boolean);
end;
finally
CoUninitialize();
end;
end;
Ocorre quando executo a linha SendReceiveSms(sTexto, sNumero: String; RelatorioEntrega, SmsDeAlerta: Boolean);
Código da procedure abaixo:
procedure TSendReceive.SendReceiveSms(sTexto, sNumero: String; RelatorioEntrega, SmsDeAlerta: Boolean);
begin
objSMS.SendMessage(sTexto, sNumero, RelatorioEntrega, SmsDeAlerta);
iError := objSMS.ErrorNo;
if iError = 0 then
frmSmsBrasilDelivery.MotraMensagem(' Mensagem enviada com sucesso!!!.')
else
frmSmsBrasilDelivery.MotraMensagem(' Mensagem não enviada.' + objSMS.ErrorDescription);
end;
o objSMS, como informei no inicio do posto é um componente ActiveX da http://www.logiccodesoft.com/lcgsmsms.aspx
Clique aqui para fazer login e interagir na Comunidade :)