lundi 27 octobre 2008

vbscript html library

' cvt en html sauf ligatures e
function cvhtml(a)
dim s
s = a
s = replace(s, "&", "&")
s = replace(replace(s, ">", "&gt;"), "<", "&lt;")
s = replace(replace(replace(s, "Ä", "&Auml;"), "Â", "&Acirc;"), "À", "&Agrave;")
s = replace(replace(replace(s, "ä", "&auml;"), "â", "&acirc;"), "à", "&agrave;")
s = replace(replace(replace(replace(s, "Ë", "&Euml;"), "Ê", "&Ecirc;"), "È", "&Egrave;"), "É", "&Eacute;")
s = replace(replace(replace(replace(s, "ë", "&euml;"), "ê", "&ecirc;"), "è", "&egrave;"), "é", "&eacute;")
s = replace(replace(replace(replace(s, "ï", "&iuml;"), "î", "&icirc;"), "Ï", "&Iuml;"), "Î", "&Icirc;")
s = replace(replace(replace(s, "Ö", "&Ouml;"), "Ô", "&Ocirc;"), "Ó", "&Oacute;")
s = replace(replace(replace(s, "ö", "&ouml;"), "ô", "&ocirc;"), "ó", "&oacute;")
s = replace(replace(replace(replace(s, "Ü", "&Uuml;"), "Û", "&Ucirc;"), "Ú", "&Uacute;"), "Ù", "&Ugrave;")
s = replace(replace(replace(replace(s, "ü", "&uuml;"), "û", "&ucirc;"), "ú", "&uacute;"), "ù", "&ugrave;")
s = replace(replace(s, "ç", "&ccedil;"), "Ç", "&Ccedil;")
cvhtml = s
end function

function htmlHead(aTitre)
dim s
s = "<html><head>"
if trim(aTitre) <> "" then s = s & "<Title>" & cvhtml(aTitre) & "</Title>"
HtmlHead = s & vbCRLF & "<style type=""text/css"" media=""screen"">td, th {font-size:75%;}</style>" & vbCRLF
end function

function HtmlHeadToBody(aAttribs)
if trim(aAttribs) = "" then
htmlHeadToBody = "</head><body>" & vbCRLF
else
htmlHeadToBody = "</head><body " & aAttribs & ">" & vbCRLF
end if
end function

function HtmlFoot
HtmlFoot = "<br><font size=""-1"">" & cvhtml("Page générée le " & date & " à " & time) & "</font><br></body></html>" & vbCRLF
end function

function HtmlTableHeader(aRecordSet)
dim s, i
s = "<tr>"
for i = 0 to aRecordset.Fields.count - 1
s = s & tagTH(cvhtml(aRecordset.fields(i).Name) & "<!-- type:" & aRecordset.fields(i).Type & " -->")
next
HtmlTableHeader = s & "</tr>" & vbCRLF
end function

function HtmlTableLine(aRecordSet)
dim s, i, t
s = "<tr>"
for i = 0 to aRecordSet.Fields.Count - 1
t = aRecordSet.fields(i).Type
if (t = 3) or (t = 131) then
s = s & gTag("td", "align=""right""", nbspifnull(cvhtml(trim(aRecordSet.fields(i) & " "))))
else
s = s & tagTD(cvhtml(trim(aRecordSet.fields(i) & " ")))
end if
next
HtmlTableLine = s & "</tr>" & vbCRLF
end function

function nbspIfNull(s)
if s = "" then nbspIfNull = "&nbsp;" else nbspIfNull = s
end function

function gTag(tag, attribs, s)
if trim(attribs) = "" then gTag = "<" & tag & ">" & s & "</" & tag & ">" else gTag = "<" & tag & " " & attribs & ">" & s & "</" & tag & ">"
end function

function TagTH(s)
if s = "" then TagTH = "<th>&nbsp;</th>" else tagTH = "<th>" & s & "</th>"
end function

function TagTD(s)
if s = "" then TagTD = "<td>&nbsp;</td>" else tagTD = "<td>" & s & "</td>"
end function

function TagTR(s)
tagTR = gTag("tr", "", s)
end function

function tagH3(s)
tagH3 = gTag("h3", "", s)
end function

sub htmlCursorToFile(aRecordset, aFilename, aTitle)
dim lFSO
dim fout
set lFSO = CreateObject("Scripting.FileSystemObject")
set fout = lFSO.OpenTextFile(aFilename, 2, true)
fout.WriteLine htmlHead(aTitle)
fout.WriteLine htmlHeadToBody("")
fout.WriteLine "<table border>"
fout.WriteLine htmlTableHeader(aRecordset)
do while not aRecordset.EOF
fout.WriteLine htmlTableLine(aRecordset)
aRecordset.Movenext
loop
fout.WriteLine "</table>" & htmlFoot
fout.Close
set fout = nothing
set lFSO = nothing
end sub
Publié par à

Aucun commentaire:

Enregistrer un commentaire

Inscription à : Publier les commentaires (Atom)