 |
| |
|
Вывод данных GENERAL поля обратно в WORD
*************************************************
* Вывод результатов Дженерал поля в ВОРД - ResultToWord *
*************************************************
FUNCTION ResultToWord
cFileFolder = "c:\"
close all
* CopyGen Demo routine - you can modify this to suit your needs
*======================
********** Required code before CopyGen is called ********
SET LIBRARY TO &Main_path\foxtools.fll ADDITIVE &&
* &&
DIMENSION FnNum[7] &&
FnNum = -1 &&
**********************************************************
PrevSec = SECONDS()
use &Main_path\_tmp.DBF in 45 shared alias temporary &&c:\_tmp.dbf in 0 shared
SELECT temporary
goto top
cNameOfStudent = ALLTRIM(temporary.person)
sum temporary.bal TO nAllBalls
SELECT temporary
goto 2
scan all
* QUEST = General field name
RetVal = CopyGen(DBF("temporary"), recno(), "Quest", "c:\"+ALLTRIM(STR(RECNO())) ) && do not use
targetfile extension
*****************************************
* формирование ВОРД-документов
* если в General поле стоит картинка - то попросту будет создан bmp, gif, jpeg файд
*****************************************
DO CASE
CASE RetVal = 0
* WAIT WINDOW "File extracted successfully! ("+STR(SECONDS()-PrevSec)+" seconds)";
* + CHR(13) + "Press any key to continue......"
CASE RetVal = -1
WAIT WINDOW "CopyGen demo works only with 1986 dbf file size!" + CHR(13) + "Press any key to
continue......"
CASE RetVal = -2
WAIT WINDOW "File access error - not found or in exclusive use!" + CHR(13) + "Press any key to
continue......"
CASE RetVal = -3
WAIT WINDOW "Incorrect filetype - not FPW/memo or VFP/memo!" + CHR(13) + "Press any key to
continue......"
CASE RetVal = -4
WAIT WINDOW "Specified field not found in DBF file!"
CASE RetVal = -5
WAIT WINDOW "Specified field is not a general field!"
CASE RetVal = -6
* WAIT WINDOW "No valid .BMP or .DOC file found inside general field!"
ENDCASE
endscan
*************************
* создаем массив с созданными
* выще ВОРД-документами
*************************
n = adir(afiles, cFileFolder + "*.doc")
oWord = createobject("Word.application")
y = oWord.documents.ADD
**************
oRange = oWord.ActiveDocument.Range()
oword.Selection.Font.Size=12
oword.Selection.Font.bold=.t.
oword.Selection.ParagraphFormat.Alignment=1
oword.Selection.insertafter("Р Е З У Л Ь Т А Т И " + CHR(13) + CHR(13))
oword.Selection.insertafter(cNameOfStudent + CHR(13))
oword.Selection.insertafter("ДАТА : " + DTOC(DATE()) + " РОКУ, ЧАС: " + ;
TIME() + CHR(13))
oword.Selection.insertafter(CHR(13))
oword.Selection.InsertAfter('ЗАГАЛЬНА КIЛЬКIСТЬ : ' + str(nAllBalls))
END=oword.activedocument.Bookmarks("\ENDOFDOC").select
oword.Selection.ParagraphFormat.Alignment=0
With oRange
.moveend(6)
.collapse(0)
.insertafter(chr(13)+chr(13))
.collapse(0)
EndWith
********************
oword.Selection.Font.Size=11
oword.Selection.Font.bold=.t.
oTable = oWord.ActiveDocument.Tables.Add(oRange,1,4)
WITH oTable
* First, put all borders
.Borders.InsideLineStyle = .t.
.Borders.OutsideLineStyle = .t.
* Put heading text in and set alignment
.Cell[1,1].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter
.Cell[1,2].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter
.Cell[1,3].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter
.Cell[1,4].Range.ParagraphFormat.Alignment = 1 && wdAlignParagraphCenter
.cell[1,1].Range.InsertAfter('№')
.cell[1,1].Width = 30
.cell[1,2].Range.InsertAfter('Содержимое ВОРД файла')
.cell[1,2].Width = 320
.cell[1,3].Range.InsertAfter('Цифровое поле')
.cell[1,3].Width = 80
.cell[1,4].Range.InsertAfter('Еще одно цифровое поле')
.cell[1,4].Width = 40
ENDWITH
*oWord.visible = .t.
SELECT temporary
goto 2 &&top
nRowNum = 1
for i = 1 to n
z = oWord.documents.Open(cFileFolder + aFiles[i,1])
z.range.copyAsPicture
z.close
IF y.paragraphs.Count > 1
y.paragraphs.Add
ENDIF
oTable.Rows.Add()
oTable.Cell(nRowNum + 1,1).Range.InsertAfter(STR(nRowNum))
oTable.Cell(nRowNum + 1,2).Select
* вставка содержимого файла в один
oWord.Selection.paragraphs.Last.Range.Paste
SELECT temporary
goto i + 1
oTable.Cell(nRowNum + 1,3).Range.InsertAfter(STR(temporary.Answer,8,2))
oTable.Cell(nRowNum + 1,4).Range.InsertAfter(STR(temporary.bal))
nRowNum = nRowNum + 1
endfor
_cliptext = ""
oWord.visible = .t.
*wait window "wait..."
*oWord.quit
ERASE cFileFolder + "*.doc" && erase doc files
SELECT temporary
use in temporary
********************************************************
* END of Вывод результатов теста в ВОРД - ResultToWord *
********************************************************
**************************************************************
********* ****************
********* C O P Y C O N T E N T O F ****************
********* G E N E R A L F I E L D ****************
********* ****************
**************************************************************
procedure copygen
PARAMETER DBFFILE, RECNUM, FIELDNAME, OUTFILE
FIELDNAME = ALLTRIM(UPPER(FIELDNAME))
PRIVATE DBFHANDLE, MEMOHANDLE, OUTFHANDLE, MBLOCKSIZE, MEMOLEN
PRIVATE FIRSTRECPOS, RECORDLEN, MBLOCKSIZE, BLOCKPOS, DBFLEFT
PRIVATE FILETYPE, VFP_MEMO, GENFIELD
PRIVATE II, IICOUNT, IIREM, TEMPNO, FIELDFOUND
DBFHANDLE = LFOPEN(DBFFILE,64)
IF DBFHANDLE<0
RETURN -2
ENDIF
FILETYPE = GETVALUE(DBFHANDLE,0,1,1)
VFP_MEMO = FILETYPE=48 .AND. BIT(1,GETVALUE(DBFHANDLE,28,1,1))
IF FILETYPE<>245 .AND. .NOT. VFP_MEMO
= LFCLOSE(DBFHANDLE)
RETURN -3
ENDIF
PRIVATE DBFLEN
DBFLEN = LFSEEK(DBFHANDLE,0,2)
IF DBFLEN<>1986
* = LFCLOSE(DBFHANDLE)
* RETURN -1
ENDIF
FIRSTRECPOS = GETVALUE(DBFHANDLE,8,2,1)
RECORDLEN = GETVALUE(DBFHANDLE,10,2,1)
FIELDFOUND = .F.
GENFIELD = .F.
TEMPNO = 32
DO WHILE .NOT. FIELDFOUND .AND. TEMPNO
TEMPS = GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))
IF UPPER(FIELDNAME)=GETSTRING(DBFHANDLE,TEMPNO,LEN(FIELDNAME))
FIELDFOUND = .T.
POSINREC = GETVALUE(DBFHANDLE,TEMPNO+12,4,1)
GENFIELD = 'G'=GETSTRING(DBFHANDLE,TEMPNO+11,1)
ELSE
TEMPNO = TEMPNO+32
ENDIF
ENDDO
IF .NOT. FIELDFOUND
= LFCLOSE(DBFHANDLE)
RETURN -4
ENDIF
IF .NOT. GENFIELD
= LFCLOSE(DBFHANDLE)
RETURN -5
ENDIF
IF VFP_MEMO
BLOCKPOS = GETVALUE(DBFHANDLE,FIRSTRECPOS+(RECNUM-1)*RECORDLEN+POSINREC,4,1)
ELSE
BLOCKPOS = VAL(GETSTRING(DBFHANDLE,FIRSTRECPOS+(RECNUM-1)*RECORDLEN+POSINREC,10))
ENDIF
= LFCLOSE(DBFHANDLE)
DBFLEFT = UPPER(IIF(RAT('.', DBFFILE)>0, LEFT(DBFFILE, RAT('.', DBFFILE)-1), DBFFILE))
MEMOHANDLE = LFOPEN(DBFLEFT+'.FPT',64)
MBLOCKSIZE = GETVALUE(MEMOHANDLE,6,2,-1)
MEMOLEN = GETVALUE(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS+4,4,-1)
TEMPS = GETSTRING(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS,128)
PRIVATE SIGNATURE, FILEEXT
DO CASE
CASE CHR(208)+CHR(207)+CHR(17)+CHR(224)$TEMPS
SIGNATURE = CHR(208)+CHR(207)+CHR(17)+CHR(224)
FILEEXT = '.DOC'
CASE 'BM'$TEMPS
SIGNATURE = 'BM'
FILEEXT = '.BMP'
OTHERWISE
= LFCLOSE(MEMOHANDLE)
RETURN -6
ENDCASE
= LFSEEK(MEMOHANDLE,MBLOCKSIZE*BLOCKPOS-1+AT(SIGNATURE, TEMPS),0)
IICOUNT = INT(MEMOLEN/512)
IIREM = MOD(MEMOLEN, 512)
IF '.'$OUTFILE
OUTFILE = UPPER(IIF(RAT('.', OUTFILE)>0, LEFT(OUTFILE, RAT('.', OUTFILE)-1), OUTFILE))
ENDIF
OUTFHANDLE = LFCREATE(OUTFILE+FILEEXT)
FOR II = 1 TO IICOUNT
TEMPS = LFREAD(MEMOHANDLE,512)
= LFWRITE(OUTFHANDLE,TEMPS)
ENDFOR
IF IIREM>0
= LFWRITE(OUTFHANDLE,LFREAD(MEMOHANDLE,IIREM))
ENDIF
= LFCLOSE(MEMOHANDLE)
= LFCLOSE(OUTFHANDLE)
RETURN 0
ENDFUNC
*
FUNCTION GetValue
PARAMETER FILEHANDLE, FILELOC, NBYTES, DIRN
= LFSEEK(FILEHANDLE,FILELOC,0)
RETURN BYTE2INT(LFREAD(FILEHANDLE,NBYTES),DIRN)
ENDFUNC
*
FUNCTION byte2int
PARAMETER STRING, DIRN
PRIVATE STRLEN, A, B, RETVAL, I, J
RETVAL = 0
J = 0
A = IIF(DIRN>0, 0, LEN(STRING)-1)
B = IIF(DIRN>0, LEN(STRING)-1, 0)
FOR I = A TO B STEP DIRN
J = J+1
RETVAL = ASC(SUBSTR(STRING, J, 1))*256**I+RETVAL
ENDFOR
RETURN RETVAL
ENDFUNC
*
FUNCTION GetString
PARAMETER FILEHANDLE, FILELOC, NBYTES
= LFSEEK(FILEHANDLE,FILELOC,0)
RETURN LFREAD(FILEHANDLE,NBYTES)
ENDFUNC
*
FUNCTION Bit
PARAMETER BITNO, A
RETURN INT(MOD(A/2**BITNO, 2))=1
ENDFUNC
*
FUNCTION LFCREATE
PARAMETER FNAME, FATTRIB
PRIVATE FILEHANDLE
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(1)
FILEHANDLE = CALLFN(FNNUM(1),FNAME,IIF(PARMS>2, FATTRIB, 0))
IF FILEHANDLE>-1
FNNUM[7] = LFSEEK(FILEHANDLE,0,2)
= LFSEEK(FILEHANDLE,0,0)
ENDIF
RETURN FILEHANDLE
ENDFUNC
*
FUNCTION LFOPEN
PARAMETER FNAME, FATTRIB
PRIVATE FILEHANDLE
FILEHANDLE = -1
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(2)
FILEHANDLE = CALLFN(FNNUM(2),FNAME,IIF(PARMS=1, 0, FATTRIB))
IF FILEHANDLE>-1
FNNUM[7] = LFSEEK(FILEHANDLE,0,2)
= LFSEEK(FILEHANDLE,0,0)
ENDIF
RETURN FILEHANDLE
ENDFUNC
*
FUNCTION LFCLOSE
PARAMETER FILEHANDLE
= REGFUNCTS(3)
RETURN CALLFN(FNNUM(3),FILEHANDLE)
ENDFUNC
*
FUNCTION LFREAD
PARAMETER FILEHANDLE, BYTESTOREAD
PRIVATE READBUF, BYTESREAD
BYTESTOREAD = INT(BYTESTOREAD)
READBUF = REPLICATE(CHR(0), BYTESTOREAD)
= REGFUNCTS(4)
BYTESREAD = CALLFN(FNNUM(4),FILEHANDLE,@READBUF,BYTESTOREAD)
RETURN READBUF
ENDFUNC
*
FUNCTION LFWRITE
PARAMETER FILEHANDLE, WSTRING, BYTESTOWRITE
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(5)
RETURN CALLFN(FNNUM(5),FILEHANDLE,WSTRING,IIF(PARMS<3, LEN(WSTRING), BYTESTOWRITE))
ENDFUNC
*
FUNCTION LFSEEK
PARAMETER FILEHANDLE, FOFFSET, RELTO
PRIVATE PARMS
PARMS = PARAMETERS()
= REGFUNCTS(6)
RETURN CALLFN(FNNUM(6),FILEHANDLE,INT(FOFFSET),IIF(PARMS=3, RELTO, 0))
ENDFUNC
*
FUNCTION LFEOF
PARAMETER FILEHANDLE
= REGFUNCTS(6) && = REGFUNTCS(6)
RETURN CALLFN(FNNUM(6),FILEHANDLE,0,1)>=FNNUM(7)
ENDFUNC
*
PROCEDURE RegFuncts
PARAMETER FNID
IF FNNUM(FNID)>-1
RETURN
ENDIF
DO CASE
CASE FNID=1
FNNUM[1] = REGFN("_lcreat","CI","I")
CASE FNID=2
FNNUM[2] = REGFN("_lopen","CI","I")
CASE FNID=3
FNNUM[3] = REGFN("_lclose","I","I")
CASE FNID=4
FNNUM[4] = REGFN("_lread","I@CI","I")
CASE FNID=5
FNNUM[5] = REGFN("_lwrite","ICI","I")
CASE FNID=6
FNNUM[6] = REGFN("_llseek","ILI","L")
ENDCASE
ENDPROC
*
***********************
|
|
|
|  |
|
Конференция
