Rutinas diversas en vfp 9

&& ******************************************
&& * Rutinas de uso general del Sistema iFe *
&& * Noviembre de 2010 *
&& * GENERAL.PRG *
&& ******************************************

&& *********************************
&& * Rutina para manejo de errores *
&& *********************************
PROCEDURE rut_err
PARAMETERNumeroDeError,MensajeDeError,LineaDeError,ProgramaDeError,TablaDeError
AERROR(ErrorGenerado)
#INCLUDE const.h
DO CASE
CASE ErrorGenerado(1) = 1924 && "Name" is Not An Object
FormaAlterna.Release
CASE ErrorGenerado(1) = 1705 && File access is denied ( la aplicación ya está corriendo )
MESSAGEBOX("Algún archivo está en uso y no se puede abrir de forma exclusiva",16,"Acceso exclusivo denegado")
MESSAGEBOX(ErrorGenerado(2),16,"Error")QUIT
CASE ErrorGenerado(1) = 2005 && Algun archivo no se puede abrir
MESSAGEBOX(_RutaIncorrecta,16,_Error)
DO salida
CASE ErrorGenerado(1) = 2002 && Unidad de diskette no preparada
WAIT WINDOW "Por favor inserte el disco en la unidad A:"
RETRY
CASE ErrorGenerado(1) = 1 && Archivo no existe
MESSAGEBOX(_ArchNoExiste,16,_Error)
DO salida
CASE ErrorGenerado(1) =1526 AND ErrorGenerado(5) = 2627 && Problema de llave duplicada
CASE ErrorGenerado(1) = 108 && El archivo está siendo utilizado por otro usuario
IF MESSAGEBOX(_ArchEnUso,292,_Confirma) = 6 && El usuario desea reintentarlo
RETRY
ELSE
IF MESSAGEBOX(_PierdeDatos,292,_Confirma) = 6
NTActual = ALIAS()
TABLEREVERT(.F.,(NTActual))
ELSE
RETRY
ENDIF
ENDIFCASE ErrorGenerado(1) = 109 && El registro está siendo utilizado por otro usuario
IF MESSAGEBOX(_RegEnUso,292,_Confirma) = 6 && El usuario desea reintentarlo
RETRY
ELSE
IF MESSAGEBOX(_PierdeDatos,292,_Confirma) = 6
NTActual = ALIAS()
TABLEREVERT(.F.,(NTActual))
ELSE
RETRY
ENDIF
ENDIF
CASE ErrorGenerado(1) = 1595 OR ErrorGenerado(1) = 1585 OR ;(ErrorGenerado(1) = 1526 AND ISNULL(ErrorGenerado(5))) && Conflicto de actualización
TABLEUPDATE(.T.,.T.)
OTHERWISE
_MensajeError = "Se ha presentado un conflicto en el sistema" + CHR(13)
_MensajeError = _MensajeError + ALLTRIM(TRANSFORM(NumeroDeError)) + " -> " + MensajeDeError + CHR(13)
_MensajeError = _MensajeError + ProgramaDeError + " en la línea " + ALLTRIM(TRANSFORM(LineaDeError))_MensajeError = _MensajeError + REPLICATE("=",80)
MESSAGEBOX(_ErrDesconocido + " #" + ALLT(STR(ErrorGenerado(1))),16,"Solicitud de asistencia técnica")
DO salida
ENDCASE
_MensajeError = "Se ha presentado un conflicto en el sistema" + CHR(13)
_MensajeError = _MensajeError + ALLTRIM(TRANSFORM(NumeroDeError)) + " -> " + MensajeDeError + CHR(13)
_MensajeError = _MensajeError +ProgramaDeError + " en la línea " + ALLTRIM(TRANSFORM(LineaDeError))
_MensajeError = _MensajeError + REPLICATE("=",80)
MESSAGEBOX(_ErrDesconocido + " #" + ALLT(STR(ErrorGenerado(1))),16,"Solicitud de asistencia técnica")
DO salida
RETURN

&& ***********************************
&& * Función para convertir una hora *
&& ***********************************
FUNCTION convhora
PARAMETER hora
hrs =VAL(LEFT(hora,2))
minutos = VAL(RIGHT(hora,2))/60
result = hrs + minutos
RETURN result

&& *****************************************************
&& * Función para convertir una fecha a formato AAMMDD *
&& *****************************************************
FUNCTION fecha_ent && Recibe un valor fecha y lo convierte
PARAMETER fecha && a valor numérico entero
PRIVATEmfecha,mdia,mmes,mano
mdia = LlenaCeros(STR(DAY(fecha),2),2)
mmes = LlenaCeros(STR(MONTH(fecha),2),2)
mano = LlenaCeros(STR(YEAR(fecha),4),2)
RETURN mano + mmes + mdia

&& *******************************************************
&& * Función para convertir una fecha a formato DDMMAAAA *
&& *******************************************************
FUNCTION fecha_ent2000 && Recibe un valor fecha y lo...