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
>
>
>

Responder a