romfast/foxbin2prg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
429b43342f972399fddae63a3a436537e8129122
foxbin2prg/FileName_Caps/filename_caps.prg

275 lines
11 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------
*-- FileName_Caps.PRG
*-- CAPITALIZA EL NOMBRE Y EXTENSIÓN DEL ARCHIVO INDICADO SEGÚN LA CONFIGURACIÓN INDICADA
*-- Fernando D. Bozzo - 24/12/2013
*--------------------------------------------------------------------------------------------------------------
* EJEMPLOS CON MÁSCARAS IN-LINE (SIN ARCHIVO CONFIG):
* filename_caps( 'un_EjeMplo.PrG', '*.pRg:M.M' ) ==> 'un_EjeMplo.PrG'
* filename_caps( 'un_EjeMplo.PrG', '*.pRg:U.L' ) ==> 'UN_EJEMPLO.prg'
* filename_caps( 'un_EjeMplo.PrG', '*.pRg:P.U' ) ==> 'Un_ejemplo.PRG'
* filename_caps( 'UN_EJEMPLO.PRG', 'un_EjeMplo.pRg:M.M' ) ==> 'un_EjeMplo.pRg'
*
* EJEMPLO CON MÁSCARAS EN ARCHIVO CONFIG 'filename_caps.cfg':
* filemask=*.TXT:P.L
* filemask=*.PDF:U.L
* filemask=*.APP:P.U
* filemask=un_EjeMplo.pRg:M.M
*
* filename_caps( 'UN_EJEMPLO.TXT', 'filename_caps.cfg', 'F' ) ==> 'Un_ejemplo.prg'
* filename_caps( 'un_ejemplo.PDF', 'filename_caps.cfg', 'F' ) ==> 'UN_EJEMPLO.prg'
* filename_caps( 'un_ejemplo.prg', 'filename_caps.cfg', 'F' ) ==> 'Un_ejemplo.PRG'
* filename_caps( 'UN_EJEMPLO.PRG', 'filename_caps.cfg', 'F' ) ==> 'un_EjeMplo.PrG'
*--------------------------------------------------------------------------------------------------------------
* PARÁMETROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
* tcFileName (!v IN ) Archivo a capitalizar
* tcFileMask (?v IN ) Mascara de archivo o archivo de configuración de máscaras (U,L,P,N,M)
* => Significado: (U)pper,(L)ower,(P)roper,(M)atch,(N)one
* tcFileMaskType (?v IN ) 'M' o nada=FileMask es una máscara, 'F'=FileMask es un archivo config.
* tcLog (?@ OUT) Log generado por este programa
* tlRelanzarError (?v IN ) Indica si el error se debe relanzar (THROW) o no
* tcDontShowErrors (?v IN ) '1'=Don't show errors, Otherwise=Show errors
*--------------------------------------------------------------------------------------------------------------
LPARAMETERS tcFileName, tcFileMask, tcFileMaskType, tcLog, tlRelanzarError, tcDontShowErrors
#DEFINE CR_LF CHR(13)+CHR(10)
LOCAL lcFileName ;
, loFNC AS cl_FileName_Caps OF FileName_Caps.prg ;
, loEx AS EXCEPTION
loFNC = CREATEOBJECT("cl_FileName_Caps")
lcFileName = loFNC.Capitalize( tcFileName, tcFileMask, tcFileMaskType, tcLog, tlRelanzarError, tcDontShowErrors )
RETURN lcFileName
DEFINE CLASS cl_FileName_Caps AS Custom
_memberdata = [<VFPData>] ;
+ [<memberdata name="capitalize" display="Capitalize"/>] ;
+ [<memberdata name="renamefile" display="RenameFile"/>] ;
+ [</VFPData>]
PROCEDURE INIT
*DECLARE INTEGER MoveFile IN KERNEL32.DLL STRING lpExistingFileName, STRING lpNewFileName
* DOCUMENTACIÓN: https://msdn.microsoft.com/es-es/library/windows/desktop/aa365240(v=vs.85).aspx
* dwFlags:
* 1 (0x1) MOVEFILE_REPLACE_EXISTING
* 8 (0x8) MOVEFILE_WRITE_THROUGH
DECLARE INTEGER MoveFileEx IN KERNEL32.DLL STRING lpExistingFileName, STRING lpNewFileName, INTEGER dwFlags
DECLARE INTEGER GetLastError IN KERNEL32.DLL
DECLARE Sleep IN KERNEL32.DLL INTEGER dwMilliseconds
* DOCUMENTACIÓN: https://msdn.microsoft.com/en-us/library/windows/desktop/ms679351(v=vs.85).aspx
DECLARE INTEGER FormatMessage IN KERNEL32.DLL INTEGER dwFlags, INTEGER lpSource, INTEGER dwMessageId ;
, INTEGER dwLanguageId, STRING @lpBuffer, INTEGER nSize, INTEGER Arguments
_SCREEN.AddProperty("ExitCodeFNC",0)
ENDPROC
PROCEDURE Capitalize(tcFileName, tcFileMask, tcFileMaskType, tcLog, tlRelanzarError, tcDontShowErrors)
#IF .F.
LOCAL THIS AS cl_FileName_Caps OF 'filename_caps\filename_caps.prg'
#ENDIF
TRY
LOCAL loEx AS EXCEPTION, laMasks(1,4), lcDefinition, lcFileDef, lcMaskDef, laLines(1), lcMenErr ;
, I, X, lcName, lcExt, lcPath, lcFileName, laFile(1,5), lcLogFile, lcSys16, lnPosProg, lnRet
lnRet = 0
loEx = NULL
tcFileMaskType = EVL(tcFileMaskType,'M')
lcFileName = tcFileName
lcSys16 = SYS(16)
IF LEFT(lcSys16,10) == 'PROCEDURE '
lnPosProg = AT(" ", lcSys16, 2) + 1
ELSE
lnPosProg = 1
ENDIF
lcLogFile = FORCEEXT( SUBSTR( lcSys16, lnPosProg ), 'LOG' )
tcLog = ''
tcDontShowErrors = EVL( tcDontShowErrors, '0' )
IF EMPTY(tcFileMask)
IF tcFileMaskType <> 'F'
tcLog = tcLog + CR_LF + '- No hay máscara definida ni archivo de configuración'
EXIT && No se indicó nada que hacer
ELSE
tcFileMask = FORCEEXT( SUBSTR( lcSys16, lnPosProg ), 'CFG' )
tcLog = tcLog + CR_LF + '- Se usará el archivo de configuración [' + tcFileMask + ']'
IF NOT FILE(tcFileMask)
ERROR 'El archivo de configuración de FileName_CAPS [' + tcFileMask + '] no existe!'
ENDIF
ENDIF
ENDIF
IF tcFileMaskType == 'M' && Máscara in-line
*-- Estructura: Filename.Ext:FNameMask.ExtMask;...
tcLog = tcLog + CR_LF + '- Máscaras definidas: [' + tcFileMask + ']'
FOR I = 1 TO OCCURS( ';', tcFileMask + ';' )
lcDefinition = GETWORDNUM( tcFileMask + ';', I, ';' )
lcFileDef = GETWORDNUM( lcDefinition, 1, ':' )
lcMaskDef = GETWORDNUM( lcDefinition, 2, ':' )
laMasks(I,1) = JUSTSTEM( lcFileDef )
laMasks(I,2) = JUSTEXT( lcFileDef )
laMasks(I,3) = JUSTSTEM( lcMaskDef )
laMasks(I,4) = JUSTEXT( lcMaskDef )
ENDFOR
ELSE && Archivo de configuración
*-- Estructura:
* filemask=Filename.Ext:FilenameCap.ExtCap => Cap: (U)pper,(L)ower,(P)roper,(M)atch,(N)one
* filemask=*.PDF:U.L ==> <NOMBREARCHIVO.pdf>
* filemask=*.DOT:L.U ==> <nombrearchivo.DOT>
* filemask=*.PRG:C.N ==> <Nombrearchivo.ini>
* filemask=EjEmPlO.iNi:C.N ==> <Ejemplo.iNi>
X = 0
FOR I = 1 TO ALINES( laLines, FILETOSTR( tcFileMask ), 1+4 )
IF LOWER( LEFT( laLines(I), 8 ) ) == 'filemask'
tcLog = tcLog + CR_LF + '- Se encontró la máscara: [' + laLines(I) + ']'
X = X + 1
lcDefinition = GETWORDNUM( laLines(I), 2, '=' )
lcFileDef = GETWORDNUM( lcDefinition, 1, ':' )
lcMaskDef = GETWORDNUM( lcDefinition, 2, ':' )
DIMENSION laMasks(X,4)
laMasks(X,1) = JUSTSTEM( lcFileDef ) && Name
laMasks(X,2) = JUSTEXT( lcFileDef ) && Ext
laMasks(X,3) = JUSTSTEM( lcMaskDef ) && Name Mask
laMasks(X,4) = JUSTEXT( lcMaskDef ) && Ext Mask
ENDIF
ENDFOR
ENDIF
*-- FileName: "c:\desa\sourcesafe\myfile.ext"
lcPath = JUSTPATH( lcFileName )
lcName = JUSTSTEM( lcFileName )
lcExt = JUSTEXT( lcFileName )
FOR I = 1 TO ALEN( laMasks, 1 )
IF LIKE( UPPER( FORCEEXT( laMasks(I,1), laMasks(I,2) ) ), UPPER( FORCEEXT( lcName, lcExt ) ) )
*-- EVALUACIÓN DEL NOMBRE
DO CASE
CASE UPPER(laMasks(I,3)) == 'U'
lcFileName = UPPER(lcName)
CASE UPPER(laMasks(I,3)) == 'L'
lcFileName = LOWER(lcName)
CASE UPPER(laMasks(I,3)) == 'P'
lcFileName = PROPER(lcName)
CASE UPPER(laMasks(I,3)) == 'N'
lcFileName = lcName
OTHERWISE && (M)atch: Tal cual aparece definido
IF '?' $ laMasks(I,1) OR '*' $ laMasks(I,1)
ERROR 'Para (M)atch no puede usar máscara "' + laMasks(I,1) + '"'
ENDIF
lcFileName = laMasks(I,1)
ENDCASE
*-- EVALUACIÓN DE LA EXTENSIÓN
DO CASE
CASE UPPER(laMasks(I,4)) == 'U'
lcFileName = FORCEEXT( lcFileName + '.' + lcExt, UPPER(lcExt) )
CASE UPPER(laMasks(I,4)) == 'L'
lcFileName = FORCEEXT( lcFileName + '.' + lcExt, LOWER(lcExt) )
CASE UPPER(laMasks(I,4)) == 'P'
lcFileName = FORCEEXT( lcFileName + '.' + lcExt, PROPER(lcExt) )
CASE UPPER(laMasks(I,4)) == 'N'
lcFileName = FORCEEXT( lcFileName + '.' + lcExt, lcExt )
OTHERWISE && (M)atch: Tal cual aparece definido
IF '?' $ laMasks(I,1) OR '*' $ laMasks(I,1)
ERROR 'Para (M)atch no puede usar máscara "' + laMasks(I,1) + '"'
ENDIF
lcFileName = FORCEEXT( lcFileName + '.' + lcExt, laMasks(I,2) )
ENDCASE
lcFileName = FORCEPATH( lcFileName, lcPath )
tcLog = tcLog + CR_LF + '- El archivo se debe renombrar a [' + lcFileName + ']'
EXIT
ENDIF
ENDFOR
*MESSAGEBOX( 'lcLogFile = ' + TRANSFORM(lcLogFile),0+4096, 'Error' )
IF ADIR( laFile, lcFileName, '', 1 ) > 0 AND laFile(1,1) <> JUSTFNAME(lcFileName)
lnRet = THIS.RenameFile( FORCEPATH( laFile(1,1), JUSTPATH(lcFileName) ), lcFileName )
*MESSAGEBOX('(MoveFile) lnRet = ' + TRANSFORM(lnRet),0+4096, 'Error')
IF lnRet = 0 && Failed
lnRet = GetLastError()
*MESSAGEBOX('(GetLastError) lnRet = ' + TRANSFORM(lnRet),0+4096, 'Error')
ERROR 'MoveFile'
ENDIF
tcLog = tcLog + CR_LF + ' => Se renombrará a [' + lcFileName + ']'
ELSE
tcLog = tcLog + CR_LF + ' => No se renombrará a [' + lcFileName + '] porque ya estaba correcto.'
ENDIF
CATCH TO loEx
_SCREEN.ExitCodeFNC = loEx.ErrorNo
IF loEx.ErrorNo = 1098 && User defined error
IF LOWER(loEx.Message) == 'movefile'
* SE OBTIENE EL MENSAJE DE ERROR DEL SISTEMA CORRESPONDIENTE A GetLastError()
* FORMAT_MESSAGE_FROM_SYSTEM 0x00001000
LOCAL lnRetLen, lpBuffer
lpBuffer = REPLICATE(CHR(0),256)
lnRetLen = FormatMessage(0x00001000,0,lnRet,0,@lpBuffer,256,0)
loEx.Message = LEFT(lpBuffer, lnRetLen)
ENDIF
ENDIF
IF tlRelanzarError THEN
THROW
ELSE
IF '800a0046:' $ loEx.Details
tcLog = tcLog + CR_LF + ' => No se renombrará a [' + lcFileName + '] porque el archivo estaba en uso o no se puede acceder a el.'
ENDIF
lcMenErr = 'ERROR ' + TRANSFORM(loEx.ERRORNO) + ', ' + loEx.MESSAGE + CHR(13) ;
+ loEx.PROCEDURE + ', line ' + TRANSFORM(loEx.LINENO) + CHR(13) ;
+ loEx.LINECONTENTS
IF TRANSFORM(tcDontShowErrors) # '1' THEN
MESSAGEBOX( lcMenErr, 0+16+4096, 'ATENCIÓN!! Ha ocurrido un error al capitalizar', 600000 )
ENDIF
ENDIF
FINALLY
tcFileName = lcFileName
*-- Si existe FileName_Caps.LOG, lo actualiza
IF FILE(lcLogFile)
IF NOT EMPTY(lcMenErr)
tcLog = tcLog + CR_LF + CR_LF + lcMenErr
ENDIF
STRTOFILE( tcLog, lcLogFile, 1 )
ENDIF
ENDTRY
RETURN lcFileName
ENDPROC
FUNCTION RenameFile(lpExistingFileName as String, lpNewFileName as String) as Integer
* RENAME con reintento. A veces el sistema operativo puede devolver un error en los primeros intentos de renombrado,
* por ejemplo con el error "Can not create a file that already exists"
* FUENTE: http://stackoverflow.com/questions/13025313/why-os-rename-is-raising-an-exception-in-python-2-7
LOCAL lnRet
lnRet = 0
*lnRet = MoveFile( FORCEPATH( laFile(1,1), JUSTPATH(lcFileName) ), lcFileName )
FOR I = 1 TO 10
lnRet = MoveFileEx( lpExistingFileName, lpNewFileName, 0x1 + 0x8 )
IF lnRet != 0
EXIT
ENDIF
Sleep(10)
ENDFOR
RETURN lnRet
ENDFUNC
ENDDEFINE && CLASS cl_FileName_Caps AS Custom
Reference in New Issue View Git Blame Copy Permalink