Bucle que me peta un timer
Publicado por Loren (15 intervenciones) el 09/11/2011 00:49:12
Tengo un programa, que recorre un bucle de continuo, hasta que se da una condicion para salir del bucle (que un campo de la base de datos se actualize a 0 desde otro pc). Durante ese paso por el bucle, el timer que me muestra la hora exacta en pantalla se me bloquea y deja de marcar. He probado con sleep, con doevents y no consigo quitar este fallo. Alguna sugerencia???
Sub lanzaProcesos()
Dim sql As String
Dim rs As Recordset
Set rs = New Recordset
sql = "select * from tb_cola_procesos"
rs.Open sql, conmysql, adOpenKeyset, adLockBatchOptimistic
If Not rs.BOF Then
rs.MoveFirst
Do
terminal = asignaTerminal
Do While terminal = "0"
terminal = asignaTerminal
Form1.Refresh
DoEvents
Loop
'Text1.Text = Text1.Text + "Terminal: " + terminal + "->" + CStr(rs("pid").Value) + vbCrLf
rs.movenext
Loop While Not rs.EOF
End If
Set rs = Nothing
End Sub
Function asignaTerminal() As String
Dim sql As String
Dim rs As Recordset
Set rs = New Recordset
sql = "select * from tb_terminales where estado=0"
rs.Open sql, conmysql, adOpenKeyset, adLockBatchOptimistic
If rs.RecordCount = 0 Then
asignaTerminal = "0"
Else
rs.MoveFirst
conmysql.BeginTrans
conmysql.Execute "update tb_terminales set estado=1 where ip='" & rs("ip").Value & "'"
conmysql.CommitTrans
asignaTerminal = rs("ip").Value
End If
Set rs = Nothing
End Function
-lanzaProcesos() busca en una tabla de una base de datos los procesos pendientes, y a continuacion los terminales que se encuentran disponibles para iniciar ese proceso o tarea. Hasta que la funcion asignaTerminal no retorna un valor distinto a "0", se ejecuta el bucle que la llama de continuo, y ahi esta el problema, que me fastidia reloj que tengo en mi formulario.
Sub lanzaProcesos()
Dim sql As String
Dim rs As Recordset
Set rs = New Recordset
sql = "select * from tb_cola_procesos"
rs.Open sql, conmysql, adOpenKeyset, adLockBatchOptimistic
If Not rs.BOF Then
rs.MoveFirst
Do
terminal = asignaTerminal
Do While terminal = "0"
terminal = asignaTerminal
Form1.Refresh
DoEvents
Loop
'Text1.Text = Text1.Text + "Terminal: " + terminal + "->" + CStr(rs("pid").Value) + vbCrLf
rs.movenext
Loop While Not rs.EOF
End If
Set rs = Nothing
End Sub
Function asignaTerminal() As String
Dim sql As String
Dim rs As Recordset
Set rs = New Recordset
sql = "select * from tb_terminales where estado=0"
rs.Open sql, conmysql, adOpenKeyset, adLockBatchOptimistic
If rs.RecordCount = 0 Then
asignaTerminal = "0"
Else
rs.MoveFirst
conmysql.BeginTrans
conmysql.Execute "update tb_terminales set estado=1 where ip='" & rs("ip").Value & "'"
conmysql.CommitTrans
asignaTerminal = rs("ip").Value
End If
Set rs = Nothing
End Function
-lanzaProcesos() busca en una tabla de una base de datos los procesos pendientes, y a continuacion los terminales que se encuentran disponibles para iniciar ese proceso o tarea. Hasta que la funcion asignaTerminal no retorna un valor distinto a "0", se ejecuta el bucle que la llama de continuo, y ahi esta el problema, que me fastidia reloj que tengo en mi formulario.
Valora esta pregunta
0