adfa
07-08-2007, 14:56:58
Hola a todos.
Me surgio la necesidad de hacer un programa que se conecte a un reloj de personal por tcp/ip y que traiga la marcas de los empleados.
Con el reloj venia un ejemplo en Delphi que usaba el TClientSocket (tuve que agregarlo porque en el Delphi 7 no viene por def).
El ejemplo tiene un TEdit, un TMemo1 y 3 botones, uno para activar el TClientSocket, otro para desactivarlo y el tercero para enviar el comando que se escriba en el TEdit.
En el evento OnRead del TClientSocket se graba lo que se recibe en el memo.
Este funciona bien.
Ahora yo tenía la necesidad de que sea más o menos en tiempo real por lo que hice un proyecto con un TTimer para poder consultar automáticamente cada 60 segundos al reloj las nuevas marcas. El exe queda en el tray con el componente de las trivial TApp2Tray
Mi sorpresa es que al poner todo dentro de un procedimiento deja de funcionar la comunicación, o al menos no funciona como debería.
Este es el código que uso, haber si alguien me puede dar una mano o tiene idea de porque pasa esto.
type
TfrmgetMarcas = class(TForm)
popMenu: TPopupMenu;
Cerrar1: TMenuItem;
Timer1: TTimer;
cs1: TClientSocket;
appTray: TApp2Tray;
Memo1: TMemo;
procedure Timer1Timer(Sender: TObject);
procedure cs1Read(Sender: TObject; Socket: TCustomWinSocket);
private
procedure getRegsDeMarcas;
procedure sendcomando(comando: string);
public
{ Public declarations }
end;
const
comando1 = '(1000,sysinfo)';
comando2 = '(1000,kqdata)';
comando3 = '(commclose)';
procedure TfrmgetMarcas.getRegsDeMarcas;
begin
try
cs1.Active := true;
sendcomando(comando1);
sleep(600); //sleep recomendado por el fabricante
sendcomando(comando2);
sendcomando(comando3);
cs1.Active := false;
except
on e: Exception do
begin
MessageDlg('Error al traer datos del reloj'+#10+e.Message,mtError,[mbOk],0);
cs1.Active := false;
Application.Terminate;
end;
end;
procedure TfrmgetMarcas.sendcomando(comando: string);
begin
cs1.Socket.SendText(comando);
end;
procedure TfrmgetMarcas.cs1Read(Sender: TObject; Socket: TCustomWinSocket);
var
S:String;
begin
Socket.ReceiveLength;
S:=Socket.ReceiveText;
Memo1.Text:=Memo1.Text+S;
end;
procedure TfrmgetMarcas.Timer1Timer(Sender: TObject);
begin
try
getRegsDeMarcas;
timer1.Enabled := true;
except
on e: Exception do
begin
messageDlg(e.Message,mtError,[mbOk],0);
cs1.Active := false;
application.Terminate;
end;
end;
end;
Probe poner sleep entre cada paso del procedure pero tampoco llega el programa al evento OnRead.
Ahora si pongo 5 botones y en cada boton pongo
procedure TfrmgetMarcas.Button1Click(Sender: TObject);
begin
cs1.Active := true;
end;
procedure TfrmgetMarcas.Button2Click(Sender: TObject);
begin
sendcomando(comando1);
sleep(600);
end;
procedure TfrmgetMarcas.Button3Click(Sender: TObject);
begin
sendcomando(comando2);
end;
procedure TfrmgetMarcas.Button4Click(Sender: TObject);
begin
sendcomando(comando3);
end;
procedure TfrmgetMarcas.Button5Click(Sender: TObject);
begin
cs1.Active := false;
end;
Voy apretando secuencialmente los botones y funciona .....
Me esta quemando la cabeza, alguien me puede tirar algun cable.
Saludos
Me surgio la necesidad de hacer un programa que se conecte a un reloj de personal por tcp/ip y que traiga la marcas de los empleados.
Con el reloj venia un ejemplo en Delphi que usaba el TClientSocket (tuve que agregarlo porque en el Delphi 7 no viene por def).
El ejemplo tiene un TEdit, un TMemo1 y 3 botones, uno para activar el TClientSocket, otro para desactivarlo y el tercero para enviar el comando que se escriba en el TEdit.
En el evento OnRead del TClientSocket se graba lo que se recibe en el memo.
Este funciona bien.
Ahora yo tenía la necesidad de que sea más o menos en tiempo real por lo que hice un proyecto con un TTimer para poder consultar automáticamente cada 60 segundos al reloj las nuevas marcas. El exe queda en el tray con el componente de las trivial TApp2Tray
Mi sorpresa es que al poner todo dentro de un procedimiento deja de funcionar la comunicación, o al menos no funciona como debería.
Este es el código que uso, haber si alguien me puede dar una mano o tiene idea de porque pasa esto.
type
TfrmgetMarcas = class(TForm)
popMenu: TPopupMenu;
Cerrar1: TMenuItem;
Timer1: TTimer;
cs1: TClientSocket;
appTray: TApp2Tray;
Memo1: TMemo;
procedure Timer1Timer(Sender: TObject);
procedure cs1Read(Sender: TObject; Socket: TCustomWinSocket);
private
procedure getRegsDeMarcas;
procedure sendcomando(comando: string);
public
{ Public declarations }
end;
const
comando1 = '(1000,sysinfo)';
comando2 = '(1000,kqdata)';
comando3 = '(commclose)';
procedure TfrmgetMarcas.getRegsDeMarcas;
begin
try
cs1.Active := true;
sendcomando(comando1);
sleep(600); //sleep recomendado por el fabricante
sendcomando(comando2);
sendcomando(comando3);
cs1.Active := false;
except
on e: Exception do
begin
MessageDlg('Error al traer datos del reloj'+#10+e.Message,mtError,[mbOk],0);
cs1.Active := false;
Application.Terminate;
end;
end;
procedure TfrmgetMarcas.sendcomando(comando: string);
begin
cs1.Socket.SendText(comando);
end;
procedure TfrmgetMarcas.cs1Read(Sender: TObject; Socket: TCustomWinSocket);
var
S:String;
begin
Socket.ReceiveLength;
S:=Socket.ReceiveText;
Memo1.Text:=Memo1.Text+S;
end;
procedure TfrmgetMarcas.Timer1Timer(Sender: TObject);
begin
try
getRegsDeMarcas;
timer1.Enabled := true;
except
on e: Exception do
begin
messageDlg(e.Message,mtError,[mbOk],0);
cs1.Active := false;
application.Terminate;
end;
end;
end;
Probe poner sleep entre cada paso del procedure pero tampoco llega el programa al evento OnRead.
Ahora si pongo 5 botones y en cada boton pongo
procedure TfrmgetMarcas.Button1Click(Sender: TObject);
begin
cs1.Active := true;
end;
procedure TfrmgetMarcas.Button2Click(Sender: TObject);
begin
sendcomando(comando1);
sleep(600);
end;
procedure TfrmgetMarcas.Button3Click(Sender: TObject);
begin
sendcomando(comando2);
end;
procedure TfrmgetMarcas.Button4Click(Sender: TObject);
begin
sendcomando(comando3);
end;
procedure TfrmgetMarcas.Button5Click(Sender: TObject);
begin
cs1.Active := false;
end;
Voy apretando secuencialmente los botones y funciona .....
Me esta quemando la cabeza, alguien me puede tirar algun cable.
Saludos