Solucionado!
El proceso quedo dividido en 2
El proceso en si...
Lparameters cAccion,nSucursal
Local llHuboError
Thisform.Accion=cAccion
Thisform.Sucursal=nSucursal
Thisform.AdoDbCmd = Createobject("ADODB.Command")
Thisform.AdoDbCmd.ActiveConnection=Thisform.ConexionActual
Thisform.AdoDbCmd.CommandText="ProcesaReplica"
Thisform.AdoDbCmd.CommandType=4 && adCmdStoredProc
Thisform.AdoDbCmd.CommandTimeOut=0
Thisform.AdoDbCmd.Parameters.Refresh
Thisform.AdoDbCmd.Parameters.Item("@cAccion")=Thisform.Accion
Thisform.AdoDbCmd.Parameters.Item("@nIdSucursal")=Thisform.Sucursal
Thisform.AdoDbCmd.Parameters.Item("@cSistema")=_Screen.Modulo
Thisform.AdoDbCmd.Parameters.Item("@cPc")=Getwordnum(Sys(0),1)
Try
Thisform.AdoDbCmd.Execute(,,128+16) &&adExecuteNoRecords+adAsyncExecute
Catch To loError
llHuboError=.T.
TEXT TO lcReferencia TEXTMERGE NOSHOW PRETEXT 3
<Referencia>
<Procedimiento><<Thisform.AdoDbCmd.CommandText>></Procedimiento>
<Parametros>
<cAccion><<Thisform.Accion>></cAccion>
<nIdSucursal><<TRANSFORM(Thisform.Sucursal)>></nIdSucursal>
</Parametros>
</Referencia>
ENDTEXT
Do RegistraLog With
Datetime(),_Screen.UsrName,_Screen.AppName,3,loError.Procedure,loError.Lineno,'',;
IIF(' OLE
'$loError.Message,'OLE','VFP'),loError.ErrorNo,loError.Message+Chr(13)+Chr(10)+lcReferencia
Thisform.CondError=1
ENDTRY
Thisform.tmControl.Enabled=.t.
y un timer que controla si el proceso Asincronico termino, para procesar lo
restante.
Local llHuboError
This.Enabled=.F.
If Thisform.AdoDbCmd.State#4 &&adStateExecuting
Try
Thisform.Realizo=loCmd.Parameters("@nRealizo").Value
Thisform.CondError=loCmd.Parameters("@nCondError").Value
Catch To loError
llHuboError=.T.
TEXT TO lcReferencia TEXTMERGE NOSHOW PRETEXT 3
<Referencia>
<Procedimiento><<Thisform.AdoDbCmd.CommandText>></Procedimiento>
<Parametros>
<cAccion><<Thisform.Accion>></cAccion>
<nIdSucursal><<TRANSFORM(Thisform.Sucursal)>></nIdSucursal>
</Parametros>
</Referencia>
ENDTEXT
Do RegistraLog With
Datetime(),_Screen.UsrName,_Screen.AppName,3,loError.Procedure,loError.Lineno,'',;
IIF(' OLE
'$loError.Message,'OLE','VFP'),loError.ErrorNo,loError.Message+Chr(13)+Chr(10)+lcReferencia
Thisform.CondError=1
Endtry
If !llHuboError And Thisform.CondError>0
llHuboError=.T.
TEXT TO lcReferencia TEXTMERGE NOSHOW PRETEXT 3
<Referencia>
<Procedimiento><<Thisform.AdoDbCmd.CommandText>></Procedimiento>
<Parametros>
<cAccion><<Thisform.Accion>></cAccion>
<nIdSucursal><<TRANSFORM(Thisform.Sucursal)>></nIdSucursal>
</Parametros>
</Referencia>
ENDTEXT
Do RegistraLog With
Datetime(),_Screen.UsrName,_Screen.AppName,Iif(Thisform.CondError=1,2,3),Program(),Lineno(1),'',;
'APP',-1,'Error detectado dentro del procedimiento
almacenado.'+Chr(13)+Chr(10)+lcReferencia
Endif
If !llHuboError
If Thisform.CondError=1
* Si le dio error al procesar reintento este paso en el proximo
timer y cambio el color del label para indicar
* que hubo errores
Thisform.lblSincroniza.ForeColor=Rgb(128,0,0)
Thisform.PasoActual=Thisform.PasoActual-1
If Thisform.PasoActual=0
Thisform.PasoActual=7
Endif
Else
lcTexto="Se detiene el proceso de sincronizacion"
TEXT TO lcReferencia TEXTMERGE NOSHOW PRETEXT 3
<Referencia>
<Accion>Proceso de Sincronizacion</Accion>
<CondError><<ALLTRIM(STR(Thisform.CondError))>></CondError>
<Paso><<Thisform.PasoActual>></Paso>
</Referencia>
ENDTEXT
Do RegistraLog With
Datetime(),_Screen.UsrName,_Screen.AppName,3,Program(),Lineno(1),'',;
'APP',-1,lcTexto+Chr(13)+Chr(10)+lcReferencia
Thisform.Release
Endif
Endif
*Termina Ciclo
If Thisform.PasoActual=6
Thisform.lblSincroniza.Caption="Ultima
Sincronización:"+Left(Transform(Datetime(),'@E'),16)
Do RegistraLog With
Datetime(),_Screen.UsrName,_Screen.AppName,1,Program(),Lineno(1),'',;
'APP',0,Thisform.lblSincroniza.Caption
Do Form ProcLog
Endif
Inkey(.1)
If Thisform.PasoActual=6
Inkey(10) && Hace una espera de 10 segundos al terminar cada ciclo
para que otros procesos puedan ser atendidos
ENDIF
Thisform.tmProceso.Enabled=.t.
Else
This.Enabled=.T.
Endif
Saludos y gracias a todos.
Pancho
Córdoba
Argentina
El 16 de septiembre de 2015, 8:39, francisco prieto <[email protected]>
escribió:
> Grupo tengo el siguiente inconveniente
>
> Para ejecutar un Procedimiento almacenado de SqlServer hago esto y
> funciona bien:
>
> Lparameters cAccion,nSucursal
> Local loCmd,lnRealizo,llHuboError
> lnRealizo=0
> lnSeg=0
> loCmd = Createobject("ADODB.Command")
> loCmd.ActiveConnection=Thisform.ConexionActual
> loCmd.CommandText="ProcesaReplica"
> loCmd.CommandType=4 && adCmdStoredProc
> loCmd.CommandTimeOut=0
> loCmd.Parameters.Refresh
> loCmd.Parameters.Item("@cAccion")=cAccion
> loCmd.Parameters.Item("@nIdSucursal")=nSucursal
> loCmd.Parameters.Item("@cSistema")=_Screen.Modulo
> loCmd.Parameters.Item("@cPc")=Getwordnum(Sys(0),1)
>
> Try
> loCmd.Execute(,,128) &&adExecuteNoRecords
> lnSeg=Seconds()
> lnRealizo=loCmd.Parameters("@nRealizo").Value
> Thisform.CondError=loCmd.Parameters("@nCondError").Value
> Catch To loError
> lnSeg=(Seconds()-lnSeg)/10000
> llHuboError=.T.
> TEXT TO lcReferencia TEXTMERGE NOSHOW PRETEXT 3
> <Referencia>
> <Procedimiento><<loCmd.CommandText>></Procedimiento>
> <Parametros>
> <cAccion><<cAccion>></cAccion>
> <nIdSucursal><<TRANSFORM(nSucursal)>></nIdSucursal>
> </Parametros>
> </Referencia>
> ENDTEXT
> Do RegistraLog With
> Datetime(),_Screen.UsrName,_Screen.AppName,3,loError.Procedure,loError.Lineno,'',;
> IIF(' OLE
> '$loError.Message,'OLE','VFP'),loError.ErrorNo,loError.Message+Chr(13)+Chr(10)+lcReferencia
> Thisform.CondError=1
> ENDTRY
> IF !llHuboError AND Thisform.CondError>0
> llHuboError=.t.
> TEXT TO lcReferencia TEXTMERGE NOSHOW PRETEXT 3
> <Referencia>
> <Procedimiento><<loCmd.CommandText>></Procedimiento>
> <Parametros>
> <cAccion><<cAccion>></cAccion>
> <nIdSucursal><<TRANSFORM(nSucursal)>></nIdSucursal>
> </Parametros>
> </Referencia>
> ENDTEXT
> Do RegistraLog With
> Datetime(),_Screen.UsrName,_Screen.AppName,IIF(Thisform.CondError=1,2,3),PROGRAM(),LINENO(1),'',;
> 'APP',-1,'Error detectado dentro del procedimiento
> almacenado.'+Chr(13)+Chr(10)+lcReferencia
> ENDIF
> loCmd=.Null.
> Return (!llHuboError)
>
> Pero lo estoy ejecutando en modo sincronico y desearia poder ejecutarlo en
> modo asincronico, ya que en procesos muy largos la pantalla queda colgada y
> no se refresca... Si fuera asincronico, tendria el control de los eventos
> de la pantalla.
>
> Encontre que para eso al momento de ejecutar habria que pasarle la opcion
> adAsyncExecute al execute, es decir a como esta ahora seria algo asi....
>
> loCmd.Execute(,,128+16) &&adExecuteNoRecords+adAsyncExecute
>
> Pero si hago eso necesito saber cuando termina el proceso...
>
> En VB lo hacen asi
>
> Dim Cmd As ADODB.Command
> Dim rs As ADODB.Recordset
>
> Set Cmd = New ADODB.Command
> Cmd.ActiveConnection = cn
> Cmd.CommandType = adCmdText
> Cmd.CommandText = "SELECT * FROM Usuarios"
> Abort = False
>
> Set rs = Cmd.Execute( , , adAsyncExecute)
> Do While CBool(Cmd.State And adStateExecuting)
> DoEvents
> If Abort Then
> Cmd.Cancel
> End If
> Loop
>
> y encontre que en VFP se puede implementar algo asi...
>
> https://msdn.microsoft.com/en-US/library/9e3x7620%28v=vs.80%29.aspx
>
> Alguno puede aportar algo...
>
> Saludos y gracias,
>
> Pancho
> Córdoba
> Argentina
>
>
>