// Almacena archivos de cualquier tipo en una tabla DBF o Gestor MySQL/SQLSERVER
// Juan navas jnavas@datapronet.com jnadaptapro@gmail.com
// Este programa fue extraido del sistema ERP AdaptaPro www.datapronet.com utiliza MYSQL
// Este ejemplo es mi aporte al foro de FiveWin, se puede utilizar en cualquier gestor de base de datos utilizando campos Memos
// El mecanismo es: A partir del Archivo BMP o Binario, Genera un archivo comprimido ZIP,texto mediante MIME, se fracciona en paginas y se almacena
// Para recuperarlo: Lee el contenido del memo, genera el archivo TEXTO, luego genera el archivo comprimido, finalmente se descomprime y genera el archivo nuevamente en la carpeta filerecover
// Requiere Libreria hbzlib.LIB
// Ejecucion desde la consola: savefilebmp <Nombre de Cualquier Archivo>
// Si no se indica el nombre del archivo, guardara el mismo binario y luego lo recupera en la carpeta filerecover
// Esta funcionalidad la hemos ìmplementado con campos BLOB y LONGTEXT en MYSQL.
#include "FiveWin.ch"
FUNCTION MAIN(cFile)
LOCAL aPag
LOCAL cBin :=Lower(GetModuleFileName( GetInstance() ))
LOCAL cFileDir:="FILES.DBF"
LOCAL cFilePag:="FILESPAG.DBF"
LOCAL aFile,I
DEFAULT cFile:=cBin
SET DELETE ON
IF !FILE(cFile)
MsgAlert("Archivo "+cFile+" no Existe")
RETURN NIL
ENDIF
ISTABLAS(cFileDir,cFilePag)
aFile:=DIRECTORY(cFile)
aPag :=GETPAGES(cFile)
IF Empty(aPag)
MsgAlert("Archivo no generó Paginado")
RETURN NIL
ENDIF
SELECT A
USE (cFileDir) EXCLU
GO TOP
// Remueve el COntenido
DELETE ALL FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
PACK
APPEND BLANK
REPLACE FILE WITH cFile
REPLACE SIZE WITH aFile[1,2]
REPLACE PAGES WITH LEN(aPag)
COMMIT
// BROWSE()
SELECT B
USE (cFilePag) EXCLU
GO TOP
// Remueve el COntenido
DELETE ALL FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
PACK
FOR I=1 TO LEN(aPag)
APPEND BLANK
REPLACE FILE WITH cFile
REPLACE PAGE WITH I
REPLACE MEMO WITH aPag[I]
COMMIT
NEXT I
// BROWSE()
CLOSE ALL
RECUPERAR(cFile)
RETURN NIL
FUNCTION cFileTemp(cExt)
LOCAL cFile:="tmp"+STRTRAN(LSTR(SECONDS()),".","")+cExt
RETURN cFile
FUNCTION lstr(nValue)
RETURN ALLTRIM(STR(nValue))
FUNCTION GETPAGES(cFileOrg)
LOCAL cFileZip :=cFileTemp(".ZIP")
LOCAL cFileMime:=cFileTemp(".TXT")
LOCAL aFiles :={},nSize:=0,oFile,cMemo:=""
LOCAL cBin :=Lower(cFilePath(GetModuleFileName( GetInstance() )))
LOCAL aPages:={},I,aTotal:={},nTotal:=0,lZip:=.F.
LOCAL aPag :={},nPage
LOCAL nFileMax :=(1024**4)*2 // Tamaño maximo permitido para almacenar, en paginado el limite esta en la capacidad de la tabla
LOCAL nPageSize:=(1024**2)/2 // Tamaño maximo de la Pagina, limite campo MEMO . Utilizado en MySQL para campos LONGTEXT
nPageSize:=65555 // Capacidad para tablas DBF
CursorWait()
IF !(":"$cFileOrg)
cFileOrg:=cBin+cFileOrg
ENDIF
cFileOrg :=Lower(cFileOrg)
AADD(aFiles,cFileOrg)
IF !(":"$cFileOrg)
MsgAlert("Es necesario Indicar la Ruta Completa del Archivo "+cFileOrg+CRLF+;
"Ejemplo "+cBin+"\docs\documento.doc")
RETURN 0
ENDIF
IF !FILE(cFileOrg)
MsgAlert("Archivo "+cFileOrg+" no Existe")
RETURN 0
ENDIF
IF UPPE(cFileExt(cFileOrg))="ZIP"
cFileZip:=cFileOrg
lZip :=.T.
ELSE
// El Archivo Original es Comprimido en Formato Zip
HB_ZipFile( cFileZip, aFiles, 9,,.T., NIL, .F., .F. )
ENDIF
// El Archivo MIME es Convertido en Formato TEXTO Segun Mime
FMimeEnc(cFileZip,cFileMime)
// Valida el Tamaño con el Archivo MIME
nSize:=DIRECTORY(cFileMime)[1,2]
IF nSize>nFileMax
MsgAlert("Archivo "+cFileMime+" Tamaño "+LSTR(nSize)+",Supera el Límite "+LSTR(nFileMax))
RETURN {}
ENDIF
// Determinamos las Páginas que seran empleadas
nPage :=MAX(INT(nSize/nPageSize),1)
aPages:={}
FOR I=1 TO nPage
AADD(aPages,{MIN(nPageSize,nSize)})
NEXT I
aTotal:=ATOTALES(aPages)
// Remanente de la Ultima Página
IF nSize>aTotal[1]
AADD(aPages,{nSize-aTotal[1]})
ENDIF
// Se Extra Pagina por Pagina del Arhivo MIME
oFile:=TFILE():New(cFileMime)
FOR I=1 TO LEN(aPages)
cMemo:=oFile:cGetStr( aPages[I,1] )
AADD(aPag,cMemo)
nTotal:=nTotal+LEN(cMemo)
NEXT I
oFile:End()
ferase(cFileMime)
IF !lZip
ferase(cFileZip)
ENDIF
RETURN aPag
FUNCTION ATOTALES(aData)
LOCAL aTotal,I,U
aTotal:=ARRAY(LEN(aData[1]))
Aeval( aTotal,{ |a,n| aTotal[n]:=0 })
FOR I=1 TO LEN(aData)
FOR U=1 TO LEN(aData[I])
aTotal[U]:=aTotal[U]+aData[I,U]
NEXT U
NEXT I
RETURN aTotal
PROCE ISTABLAS(cFileDir,cFilePag)
LOCAL aStruct:={}
IF FILE(cFileDir)
RETURN
ENDIF
AADD(aStruct,{"FILE", "C",250,0})
AADD(aStruct,{"SIZE", "N",12 ,0})
AADD(aStruct,{"PAGES","N",3 ,0})
dbcreate(cFileDir, aStruct)
aStruct:={}
AADD(aStruct,{"FILE","C",250,0}) // Archivo
AADD(aStruct,{"PAGE","N",4 ,0}) // Memo
AADD(aStruct,{"MEMO","M",0 ,0}) // Numero de la Pagina, es necesario el Orden para su Recuperación
dbcreate(cFilePag, aStruct)
RETURN
FUNCTION RECUPERAR(cFile)
LOCAL cFileDir:="FILES.DBF"
LOCAL cFilePag:="FILESPAG.DBF"
LOCAL cFileZip :=cFileTemp(".ZIP")
LOCAL cFileMime:=cFileTemp(".TXT")
LOCAL I,cDirOut:="filerecover\"
LOCAL aPag :={}
LOCAL oFile
lMkDir(cDirOut)
SELECT A
USE (cFileDir)
GO TOP
LOCATE FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
IF !FOUND()
CLOSE ALL
MsgAlert("Archivo "+cFile+" no Encontrado en Tabla "+cFileDir)
RETURN .F.
ENDIF
SELECT B
USE (cFilePag) EXCLU
GO TOP
// Remueve el COntenido
LOCATE FOR ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
WHILE !EOF() .AND. ALLTRIM(FIELD->FILE)=ALLTRIM(cFile)
AADD(aPag,ALLTRIM(FIELD->MEMO))
SKIP
ENDDO
CLOSE ALL
// Desde DBF hacia MIME
oFile:=TFILE():New(cFileMime)
AEVAL(aPag,{|a,n| oFile:PutStr(a)})
oFile:End()
// De MIME a ZIP
ferase(cFileZip)
FMimeDec(cFileMime,cFileZip)
ferase(cFileMime)
HB_UNZIPFILE( cFileZip , {|| nil }, .t., NIL, cDirOut , NIL )
ferase(cFileZip)
MsgAlert("Archivo recuperado en carpeta "+cDirOut)
IF !cFileExt(cFile)="EXE"
SHELLEXECUTE(NIL,"open",cFile)
ENDIF
RETURN .T.