*-------------------------------------------------------------------------------------------- * * PROGRAMA : DBREPARA.
PRG * OBJETIVO : RECORRE TODOS LOS DBF DE UN DIRECTORIO Y CHEQUEA QUE SE PUEDA * ABRIR SI NO ES ASI, INTENTA REPARAR EL ENCABEZADO
* AUTOR : RICHARD SANCHEZ * FECHA : 11/OCT/2004 *-------------------------------------------------------------------------------------------- *
CLOSE ALL ON ERROR DO NOABRE SET EXCLU ON
do db_titulo
SELE 1
MRUTA = DB_DRIVE+DB_ARCHIVO+DB_SLASH SET DEFA TO &MRUTA
DECLARE ARD(200,5) XTA=0 KA=ADIR(ARD,"*.DBF") T=ASORT(ARD) TKA=0
FOR N=1 TO KA
WAIT WINDOWS "REPARANDO TABLAS" NOWAIT DBF=ALLTRIM(ARD(N,1)) AP=.T. DO WHILE .T. OK=.T. USE &DBF IF OK EXIT ENDIF ENDDO IF .NOT. AP SELE 1 TKA=TKA+1 ENDIF NEXT
CLOSE ALL ON ERROR CLOSE ALL SET DEFA TO &DB_OBJETOS IF TKA<>0 DO DB_ERRMSG WITH "Proceso finalizado ! Se repararon "+ALLTRIM(TRANS(TKA,"999999"))+" archivo(s)" ELSE DO DB_ERRMSG WITH "Proceso finalizado ! No se encontraron archivos daados" ENDIF
QUIT
PROCEDURE NOABRE H=FOPEN(DBF,2) IF H<0 DO DB_ERRMSG WITH "NO ES POSIBLE ABRIR EL ARCHIVO "+DBF RETURN ENDIF M=FSEEK(H,4) C1=FREAD(H,1) M=FSEEK(H,5) C2=FREAD(H,1) M=FSEEK(H,6) C3=FREAD(H,1) TAM=(ASC(C3)*65536)+(ASC(C2)*256)+(ASC(C1)) OTM=TAM TAM=TAM-1 STORE 0 TO B1,B2,B3 IF TAM>=65536 B3=INT(TAM/65536) ENDIF TAM=TAM-(65536*B3) IF TAM>=256 B2=INT(TAM/256) ENDIF TAM=TAM-(256*B2)
B1=TAM M=FSEEK(H,4) T=FWRITE(H,CHR(B1)) M=FSEEK(H,5) T=FWRITE(H,CHR(B2)) M=FSEEK(H,6) T=FWRITE(H,CHR(B3)) XTA=(B3*65536)+(B2*256)+B1 IF AP SELE 1 AP=.F. ENDIF DO DB_CLRLIN WITH 23 @ 23,15 SAY "TABLA "+DBF+TRANS(OTM,"999999")+" REGISTROS REPARANDOSE" T=FCLOSE(H) OK=.F.
Primer programa: [Link] ************* * Este programa lee y guarda en el archivo Encabezado_Reporte los valores del encabezado * del reporte seleccionado antes de ser modificado por el generador de reportes de VFP bajo Win7 * Esta informacin deber ser restaurada con el programa GuardaEncabezadoReporte una vez * que se hagan los cambios necesarios.
CLOSE DATABASES USE GETFILE("FRX") IN 0 ALIAS Informe SELECT Informe Largo=AFIELDS(Campos) COPY STRUCTURE TO Encabezado_Reporte USE Encabezado_Reporte IN 0 ALIAS Valores
SELECT Valores APPEND BLANK FOR I=1 TO ALEN(Campos,1) Campo1="Informe."+Campos(I,1) Campo2=FIELD(I,1) REPLACE &Campo2 WITH &Campo1 NEXT I close data ***************************************************** Segundo Programa:GuardaEncabezadoReporte
****************************
* Este programa guardar nuevamente el encabezado del reporte seleccionado * una vez modificado desde el generador de reportes. * La razn: Win7 no permite configurar impresora y se perdera la configuracin * original para el reporte.
* Antes de ejecutar ste programa, se debi guardar la informacin del encabezado * en el archivo encabezado_reporte con el programa [Link]
CLOSE DATABASES USE Encabezado_Reporte IN 0 ALIAS Valores USE GETFILE("FRX") IN 0 ALIAS Informe &&Informe en el que se guardarn los datos... SELECT Valores Largo=AFIELDS(Campos) Si="" ACCEPT "Totalmente Seguro? (S=999)" TO Si IF Si="999" &&Para evitar cualquier error por digitacin involuntaria.... SELECT Informe GO TOP &&Primer Registro.. FOR I=1 TO ALEN(Campos,1) Campo1="Valores."+Campos(I,1) Campo2=FIELD(I,1) REPLACE &Campo2 WITH &Campo1 NEXT I ENDIF CLOSE DATA
FUNCTION REDONDEA(P1)
* Programa: REDONDEA * Objetivo: "Redondear" cantidades a fraccin .05 * Escrito : Eduardo [Link] Solano * Pas: Costa Rica * Se debe pasar el parmetro P1, que es el valor numrico a redondear a 0.05 P1=P1+.0025 P1=INT(P1*20+.5)/20 RETURN P1 DEACTIVATE WINDOW SCREEN && Desactiva la ventana de VFP.
CLEAR
*DO FORM forms\[Link] && Codigo para ejecutar un formulario de inicio (Ejemplo: [Link]).
READ EVENTS
RELEASE ALL * *Aqui va la funcion: *Nota: [Link] es mi tabla que yo he protegido. * Function Protec
&&****************************************** handle = FOPEN("[Link]",2) && abre en modo lectura escritura primerbyte = FREAD(handle,1) && lee el 1er byte Do case Case primerbyte = CHR(255) && si protegido escrib = chr(3) && desprotege
Case primerbyte = CHR(3) && si desprotegido escrib = chr(255) Endcase =FSEEK(handle,0,0) =FWRITE(handle,escrib,1) =FCLOSE(handle) Return .t. *************************************************************************** * ** FUNCTION DesactivarTeclasWindows(tlEstado) ** Funcion para Desactivar las Teclas CRTL + ALT + SUPR de Windows * ** Parametros ** tlEstado = Estado de las Teclas (VALOR LOGICO) ** ** * *** Rutina suministrada por: ROD - eendor@[Link] .T. = Desactiva las Teclas .F. = Activa las Teclas && protege
*** Ultima Modificacion: *** *
Foxperto - foxperto@[Link]
Marzo 01 2002
************************************************************************** * FUNCTION DesactivarTeclasWindows(tlEstado)
DECLARE INTEGER SystemParametersInfo IN [Link] ; LONG uAction, ; LONG uParam, ; STRING lpvParam, ; LONG fuWinIni
uAction = 97 lpvParam = '0' fuWinIni = 0
If tlEstado = .T. *--- deshabilita las teclas uParam = 1 tnResultado = SystemParametersInfo(@uAction,@uParam,lpvParam,@fuWinIni) Else *--- habilita las teclas uParam = 0 tnResultado = SystemParametersInfo(@uAction,@uParam,lpvParam,@fuWinIni) EndIf
RETURN tnResultado
ENDFUNC * ** Fin DesactivarTeclasWindows() * *************************************************************************** * ** Este pequeo programa puede ser utilizado para ser el Programa Principal ** o el Inicio de su aplicacion EXE. * ** Oculta la Ventana de VFP ** Permite que el Programa quede residente en Memoria * *** Rutina suministrada por: Foxperto - foxperto@[Link] *** * *************************************************************************** * [Link] = .F. Clear *Do Form <Nombre del Formulario de Nivel Superior> *Do <Nombre del Menu Principal de la Aplicacion> Read Event Marzo 01 2002
[Link] = .T.