prueba esto
* Function.......: filetostrintomemo
* Purpose........: inserts the contents of a file into single or multile record of a given table.
* Parameters.....: lcfilename as string, file name of contents to process
* lctablename as string, table name that will store the information
* lcfieldlist as string, field list that will be inserted into
* lcvalueslist as string, values that will be inserted into the above fieldlist
* lcfiletype as string, filetype to be stored
* llignorezip as Boolean, .T. to skip the zip step (this is because the file is already zipped up)
*
* Example1.......: lcfieldlist="idcode,filetype,filename,filesize,checksum,origin,dtcreated,VERSION,file_info"
* lcvalueslist='NEWID("CCOMNID"),lcfiletype,JUSTFNAME(lcfilename),LEN(cstring),VAL(SYS(2007,cstring)) ;
* ,"M",dt1,"",cstring'
* lctablename="filescommon"
* lcfiletype="P" && this value can be obtained from the form or by any other means necessary
* lcfilename= && this value is obtained from the screen or an adir() or any other means necessary
* =filetostrintomemo(lcfilename,lctablename,lcfieldlist,lcvalueslist,lcfiletype,"")
*
* Example2.......: lcfieldlist="file_info"
* lcvalueslist='cstring'
* lctablename="filescommon"
* lcfiletype="P" && this value can be obtained from the form or by any other means necessary
* lcfilename= && this value is obtained from the screen or an adir() or any other means necessary
* =filetostrintomemo(lcfilename,lctablename,lcfieldlist,lcvalueslist,lcfiletype)
*
* Return Type....: logical (probably needs some work to return a more accurate success value)
*===========================================================================
FUNCTION filetostrintomemo
LPARAMETERS lcfilename as string,lctablename as string,lcfieldlist as string,lcvalueslist as string,lcfiletype as string,llignorezip as Boolean
LOCAL x,llsuccess,dt1,dt2,dt3,nfilehandle,nsize,llcreategroup,lntimes,lifilegrpid,cstring,lczipfile
LOCAL lcZipName,nhtmpfile,lccommand
STORE DATETIME() TO dt1,dt2,dt3
IF VARTYPE(goapp)="O"
IF VARTYPE(goapp.omainwframe)="O"
IF VARTYPE(goapp.omainwframe.otime)="O"
goapp.omainwframe.otime.getfilestime(FULLPATH(lcfilename),@dt1,@dt2,@dt3)
ELSE
dt1={}
ENDIF
ENDIF
ENDIF
x=16777183 && set memvar limit to x
nfilehandle=FOPEN(FULLPATH(lcfilename),0) && open file to process
IF nfilehandle>=0
nsize = FSEEK(nfilehandle, 0, 2) && move pointer to EOF
IF nsize > 0
llcreategroup=(nsize>x) && determine if file is too large for memvar limit
lntimes=0
IF llcreategroup && create unique id for file group
lifilegrpid=NEWID("FILEGRPID")
ELSE
lifilegrpid=0
ENDIF
= FSEEK(nfilehandle, 0, 0) && move pointer to BOF
DO WHILE nsize<>0
lczipfile=FORCEEXT(ADDBS(SYS(2023))+(justfname(lcfilename)),"wdp") && temp ext needed for processing
lcZipName=FORCEEXT(lczipfile,"zip")
nhtmpfile=FCREATE(lczipfile) && create temp file to be zipped
=FWRITE(nhtmpfile,FREAD(nfilehandle,IIF(nsize>x,x,nsize)),nsize) && write contents to temp file to be zipped
=FCLOSE(nhtmpfile) && close temp file
IF llignorezip
cstring=FILETOSTR(lczipfile)&& create memvar to be inserted into memo contents field
ELSE
IF zipfile(lcZipName, lczipfile) && zip temp file up)
cstring=FILETOSTR(lcZipName) && create memvar to be inserted into memo contents field
ELSE
llignorezip=.T.
cstring=""
nsize=0
ENDIF
ENDIF
DELETE FILE (lczipfile) && clean up temp file
IF !llignorezip
DELETE FILE (lcZipName) && clean up temp file
ENDIF
IF !EMPTY(cstring)
lntimes=lntimes+1
lccommand="lparameters lcfiletype,lcfilename,cstring,dt1,lntimes,lifilegrpid"+chr(13)+ ;
"BEGIN TRANSACTION"+CHR(13)+"INSERT INTO "+lctablename+" ("+lcfieldlist+") VALUES ("+lcvalueslist+")"+ ;
CHR(13)+'IF !TABLEUPDATE(0,.F.,"'+lctablename+'")'+CHR(13)+"ROLLBACK"+chr(13)+"RETURN .F."+CHR(13)+ ;
"ELSE"+CHR(13)+"END TRANSACTION"+CHR(13)+"RETURN .T."+CHR(13)+"ENDIF" && create insert script
llsuccess=execscript(lccommand,lcfiletype,lcfilename,cstring,dt1,lntimes,lifilegrpid) && execute insert script
IF llsuccess
IF nsize-x<0
nsize=0
ELSE
nsize=nsize-x
ENDIF
ELSE
lnsize=0
ENDIF
ENDIF
ENDDO
ENDIF
= FCLOSE(nfilehandle) && close the file
llsuccess=.T.
ENDIF
RETURN llsuccess
*===========================================================================
* Function.......: strtofilefrommemo
* Purpose........: restores the contents of single or multile record of a given table into a file. Where the table has
* a field named filename
* Parameters.....: lctablename as string, this is the table name that is holding the the file
* lcoutputlocation as string, this is the location the file will be in after it is extracted
*
* Example........: strtofilefrommemo(ctablename,lcextractpath)
*
* Return Type....: logical (probably needs some work to return a more accurate success value)
*===========================================================================
FUNCTION strtofilefrommemo
LPARAMETERS lctablename as string,lcoutputlocation as string
LOCAL llsuccess,lcfilename,lcoldfilter
llsuccess=.T.
SELECT (lctablename)
ligrpid=EVALUATE(lctablename+".filegrpid") && check for filegroup info
IF ligrpid>0
SET FILTER TO filegrpid=ligrpid
ENDIF
lcfilename=JUSTFNAME(ALLTRIM(EVALUATE(lctablename+".filename")))
lcworkfile=FORCEEXT(ADDBS(lcoutputlocation)+lcfilename,".wdp")
lnfilehandle=FCREATE(ADDBS(lcoutputlocation)+lcfilename) && create main file
=FCLOSE(lnfilehandle)
lnfilehandle=FOPEN(ADDBS(lcoutputlocation)+lcfilename,2) && open file for read/write access
IF lnfilehandle>0
IF ligrpid>0
&& process file group into master file
SCAN
llsuccess=processrecord(lnfilehandle,lcoutputlocation,lcworkfile,lctablename)
IF !llsuccess
EXIT
ENDIF
ENDSCAN
ELSE
&& process data to master file
llsuccess=processrecord(lnfilehandle,lcoutputlocation,lcworkfile,lctablename)
ENDIF
=FCLOSE(lnfilehandle) && close main file
IF !llsuccess
DELETE FILE (ADDBS(lcoutputlocation)+lcworkfile) && delete work file
ENDIF
ELSE
=MESSAGEBOX("File could not be Created!",16,"Error Message")
llsuccess=.F.
ENDIF
IF filegrpid>0
SET FILTER TO
ENDIF
RETURN llsuccess
ENDFUNC
* Procedure......: processrecord
* Purpose........: processes info from a table memo into the master file from a work file (connotation for multiple
* records into a single file)
* Parameters.....: lnfilehandle as Number, file handle of master file
* lcoutputlocation as string, output and work location (fully qualified path ie. c:\windows\temp\)
* lcfilename as string, temporary work file
* lctablename as string, table where data is comming from
*
* Example........: processrecord(210,"c:\windows\temp\","mytempfile.wdp","mytable")
*
* Special Notes..: This should only be called from the function strtofilefrommemo()
*
* Return Type....: logical (probably needs some work to return a more accurate success value)
PROCEDURE processrecord
LPARAMETERS lnfilehandle as Number,lcoutputlocation as string,lcfilename as string,lctablename as string
LOCAL lczipfile,lnbytes,lczipfolder,lntmphandle,nSize,cstring
lczipfile=FORCEEXT(lcfilename,"dmp") && establish zip file name with a unique extension of dmp just incase the
&& the file being extracted is a zip file with the zip extension
lnbytes=STRTOFILE(EVALUATE(lctablename+".file_info"),lczipfile) && store contents to zip file name
lczipfolder=lcoutputlocation && create temp file name for extacted file to write contents to main filename
IF !unzipfile(lczipfile,lczipfolder)
RETURN .F.
ENDIF
DELETE FILE (lczipfile)
lntmphandle=FOPEN(lcfilename) && open file of extracted contents
IF lntmphandle>0
nSize = FSEEK(lntmphandle,0,2) && Move pointer to EOF
= FSEEK(lntmphandle, 0, 0) && Move pointer to BOF
cstring=FREAD(lntmphandle,nSize)
llsuccess=FWRITE(lnfilehandle,cstring,nSize) && write contents from zip to main work file
=FCLOSE(lntmphandle) && close temp file
DELETE FILE (lcfilename) && clean up temp file
ELSE
=MESSAGEBOX("There is a problem with the contents during Extraction!",16,"Error Message")
llsuccess=.F.
EXIT
ENDIF
ENDPROC
* Function.......: extractzipfilefrommemo
* Purpose........: Extracts the contents from a table memo into a file (if groups, filename is dynamically changed
* by adding 1,2,3,... to the file name)
* Parameters.....: lctablename as string, tablename where data is comming from
* lcoutputlocation as string, output location or working directory
* lcfilename as string, resulting filename (if groups exist, file name will be changed dynamically)
*
* Example........: EXTRACTZIPFILEFROMMEMO()
*
* Return Type....: logical (probably needs some work to return a more accurate success value)
Suerte
