miron , ¡¡La vida es un constante movimiento, la quietud es la muerte!!
*FUNCTION DBFtoHTML &&***************************** LPARAMETERS tcFilename * * Take the current used table and put it's contain * in an html table in the 'tcFilename' file * * Gérald Santerre * May 1998 * ***************************************************** ***************************************************** * * Maximum of items in a html table * used to cut the lenght of a table and avoid huge tables * that the browsers have trouble to display #DEFINE MAX_TABLE 50 * The result was n tables of MAX_TABLE rows ***************************************************** *Take the current table lcTable=ALIAS() IF EMPTY(lcTable) MESSAGEBOX([There must be a table open in the current alias!],64,[Message]) RETURN ENDIF *Get the fields nbFields=AFIELDS(laFields) *Count the number of 'general' fields nbGenFields=0 FOR i = 1 TO nbFields IF laFields[i,2]='G' nbGenFields=nbGenFields+1 ENDIF ENDFOR * Check for file name and creation of the file IF EMPTY(tcFilename) MESSAGEBOX([Unable to create the file, parameter 'tcfilename' is empty!],64,[Message]) RETURN ENDIF fHandle=FCREATE(tcFilename) IF fHandle < 1 MESSAGEBOX([An error occur, unable to create the file!],64,[Message]) RETURN ENDIF ** Fputs the html header to the file ** you can customize this header to fit your need ******************** FPUTS(fHandle,[<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 3.0//EN">]) FPUTS(fHandle,[<HTML>]) FPUTS(fHandle,[<HEAD>]) FPUTS(fHandle,'') FPUTS(fHandle,[<TITLE>]+lcTable+[</TITLE>]) FPUTS(fHandle,'') FPUTS(fHandle,[<META NAME="author" content="">]) FPUTS(fHandle,[<META name="generator" content="VFP Table Export/G.Santerre 1998">]) FPUTS(fHandle,[<META name="keywords" content="">]) FPUTS(fHandle,[<META name="description" content="">]) FPUTS(fHandle,'') FPUTS(fHandle,[</HEAD>]) FPUTS(fHandle,'') FPUTS(fHandle,[<BODY BGCOLOR="#FFFFFF" BACKGROUND="">]) FPUTS(fHandle,[<BASEFONT COLOR=BLACK NAME='Arial' SIZE=1>]) FPUTS(fHandle,'') FPUTS(fHandle,'') *********************************************************************** *** Build the table SELECT &lcTable LOCATE iii=0 SCAN iii=iii+1 IF iii%MAX_TABLE=1 *** Always end the current table and start a new one *** when we reach MAX_TABLE lines in the table IF iii > 1 FPUTS(fHandle,[</TABLE>]) FPUTS(fHandle,'') FPUTS(fHandle,'') FPUTS(fHandle,[<TABLE WIDTH=100%>]) FPUTS(fHandle,[ <TR>]) FPUTS(fHandle,[ <TD BGCOLOR=#AAAAAA COLSPAN=]+; ALLTRIM(STR(nbFields-nbGenFields))+[><B><FONT SIZE=+3> ]+lcTable+' </FONT>'+; ALLTRIM(STR(iii))+'+ '+[</B></TD><TR>]) ELSE ** First table FPUTS(fHandle,[<TABLE WIDTH=100%>]) FPUTS(fHandle,[ <TR>]) FPUTS(fHandle,[ <TD BGCOLOR=#AAAAAA COLSPAN=]+; ALLTRIM(STR(nbFields-nbGenFields))+[><B><FONT SIZE=+3> ]+lcTable+[</FONT></B></TD><TR>]) ENDIF FPUTS(fHandle,[ <TR>]) FOR ii = 1 TO nbFields DO CASE CASE laFields[ii,2]='G' **Forget it! OTHERWISE **Any type... FPUTS(fHandle,[ <TD BGCOLOR=#CCCCCC ><B> ]+; laFields[ii,1]+[</B></TD>]) ENDCASE ENDFOR **close the row FPUTS(fHandle,[ </TR>]) ENDIF **start the row FPUTS(fHandle,[ <TR>]) **scan around the fields... FOR i = 1 TO nbFields DO CASE CASE ISNULL(&laFields[i,1]) **Trap the .NULL. FPUTS(fHandle,[ <TD BGCOLOR=#EEEEEE >.NULL.</TD>]) CASE laFields[i,2]='G' **forget it! CASE laFields[i,2]='L' **transform logical field to text IF &laFields[i,1] FPUTS(fHandle,[ <TD BGCOLOR=#EEEEEE >True</TD>]) ELSE FPUTS(fHandle,[ <TD BGCOLOR=#EEEEEE >False</TD>]) ENDIF OTHERWISE ** PADR() is in charge to transform anything to char! lctext=ALLTRIM(PADR(&laFields[i,1],2400)) ** convert the string... lcText=ConvertToHTML(lcText) ** Add the non breaking space to be sure that the column ** display was large enough to show correctly and ** avoid ** this ** kind of ** display ** in the ** columns IF LEN(lctext)<25 lctext=STRTRAN(lctext,' ',' ') ELSE lctext=STRTRAN(SUBSTR(lctext,1,24),' ',' ')+SUBSTR(lctext,25) ENDIF ** put to file FPUTS(fHandle,[ <TD BGCOLOR=#EEEEEE>]+lctext+[</TD>]) ENDCASE ENDFOR **close the row FPUTS(fHandle,[ </TR>]) ENDSCAN **close the last table FPUTS(fHandle,[</TABLE>]) ** FPuts the 'footer' of the html file ******************* FPUTS(fHandle,[</BODY>]) FPUTS(fHandle,[</HTML>]) ** ** Close the file FCLOSE(fHandle) RETURN ********* * Convert some special char to HTML ************** FUNCTION ConvertToHTML lParameters tcString tcString=STRTRAN(tcString,'&','&') tcString=STRTRAN(tcString,'à','à') tcString=STRTRAN(tcString,'â','â') tcString=STRTRAN(tcString,'ç','ç') tcString=STRTRAN(tcString,'é','é') tcString=STRTRAN(tcString,'è','è') tcString=STRTRAN(tcString,'ë','ë') tcString=STRTRAN(tcString,'ê','ê') tcString=STRTRAN(tcString,'ï','ï') tcString=STRTRAN(tcString,'ö','ö') tcString=STRTRAN(tcString,'ô','ô') tcString=STRTRAN(tcString,'ù','ù') tcString=STRTRAN(tcString,'û','û') tcString=STRTRAN(tcString,'À','À') tcString=STRTRAN(tcString,'Â','Â') tcString=STRTRAN(tcString,'Ç','Ç') tcString=STRTRAN(tcString,'É','É') tcString=STRTRAN(tcString,'È','È') tcString=STRTRAN(tcString,'Ë','Ë') tcString=STRTRAN(tcString,'Ê','Ê') tcString=STRTRAN(tcString,'Ï','Ï') tcString=STRTRAN(tcString,'Ö','Ö') tcString=STRTRAN(tcString,'Ô','Ô') tcString=STRTRAN(tcString,'Ù','Ù') tcString=STRTRAN(tcString,'Û','Û') tcString=STRTRAN(tcString,'<','<') tcString=STRTRAN(tcString,'>','>') tcString=STRTRAN(tcString,'"','"') tcString=STRTRAN(tcString,'®','®') &&Registered TradeMark tcString=STRTRAN(tcString,'©','©') &&Copyright tcString=STRTRAN(tcString,CHR(13)+CHR(10),'<P>') tcString=STRTRAN(tcString,CHR(10),'<BR>') RETURN tcString ***************************
el 8 abr. 03