荔园在线
荔园之美,在春之萌芽,在夏之绽放,在秋之收获,在冬之沉淀
[回到开始]
[上一篇][下一篇]
发信人: gary (★有所属), 信区: Homepage
标 题: 不用组件上载文件代码段(三)[转载]
发信站: BBS 荔园晨风站 (Sat Oct 14 08:28:01 2000), 转信
文件fformat.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
function Foot()
DIM HTML
HTML = "<hr><Table Border=0 Width=100%><TR><TD><font size=1>燬ample
upload/"
HTML = HTML & "</td><td Align=right><Font Size=1><A HRef=http://www.pstruh.
HRef=http://www.pstruh.cz/help/RSConv/library.htm>DBF on-the-fly</A>?A
HRef=htt"
HTML = HTML & "</td></tr></table></Body></HTML>"
Foot = HTML
end function
function Head(Title, Description)
DIM HTML
HTML = "<HTML><Head>"
HTML = HTML & "<Title>" & Title & "</Title>"
HTML = HTML & "<Meta Content=""" & Description & """ Name=""Description"">"
HTML = HTML & Style()
HTML = HTML & "</Head>"
HTML = HTML & Body()
Head = HTML
end function
function Body()
DIM HTML
HTML = "<body ALINK=YELLOW bgcolor=White LeftMargin=0 TopMargin=0>" &vbCrLf
HTML = HTML & ClHead() &vbCrLf
HTML = HTML & Source()
Body = HTML
'<LeftMargin=0 TopMargin=0 Style="margin-right:0pt; margin-top:0pt;
margin-le>
end function
function Style()
Style = "<STYLE TYPE=""text/css""><--BODY{font-size:10pt;font-family:Arial,
Ar"
'<LeftMargin=0 TopMargin=0 Style="margin-right:0pt; margin-top:0pt;
margin-le>
end function
function ClHead()
DIM HTML
HTML = HTML & "<TABLE width=100% border=1 cellpadding=1 cellspacing=0
BORDERC"
HTML = HTML & "<th><a href=fupload.asp>Multiple text files upload</a></th>"
HTML = HTML & "<th><a href=fdbupl.asp>Upload to database</a></th>"
HTML = HTML & "<th><a href=fdbdown.asp>Download from database</a></th>"
HTML = HTML & "<th><a href=" & request.servervariables("script_name") &
"?S=1"
HTML = HTML & "</tr></table>"
ClHead = HTML
end function
function Source()
DIM HTML
if request.querystring("S")<>"" then
HTML = HTML & "<pre>" & server.htmlencode(CreateObject("Scripting.
FileSyste_
(server.mappath(request.servervariables("script_name")), 1, False, False).
r"
end if
Source = BasicEncode(HTML)
end function
Function BasicEncode(ByVal VBCode)
' Dim Pom, PosStart, PosEnd
' PosStart = InStr(VBCode, "'")
' Do While PosStart > 0
' PosEnd = InStr(PosStart + 1, VBCode, vbCrLf)
' If PosEnd = 0 Then PosEnd = Len(VBCode)
' Pom = Left(VBCode, PosStart - 1) & "<font color=green>"
' Pom = Pom & Mid(VBCode, PosStart, PosEnd - PosStart - 0) & "</font>"
' Pom = Pom & Mid(VBCode, PosEnd)
' VBCode = Pom
' PosStart = InStr(PosEnd + 1, VBCode, "'")
' Loop
VBCode = FilterBeginEnd(VBCode, "'", vbCrLf, "green")
VBCode = FilterBeginEnd(VBCode, """, """, "brown")
VBCode = FilterWord(VBCode, "Set ", "blue")
VBCode = FilterWord(VBCode, "If ", "blue")
VBCode = FilterWord(VBCode, "For ", "blue")
VBCode = FilterWord(VBCode, " Then", "blue")
VBCode = FilterWord(VBCode, " In ", "blue")
VBCode = FilterWord(VBCode, "Each ", "blue")
VBCode = FilterWord(VBCode, "Function ", "blue")
VBCode = FilterWord(VBCode, "End Function", "blue")
VBCode = FilterWord(VBCode, "MsgBox ", "blue")
VBCode = FilterWord(VBCode, "OutPut ", "blue")
VBCode = FilterWord(VBCode, "Empty", "blue")
VBCode = FilterWord(VBCode, "Debug.Print ", "darkblue")
VBCode = FilterWord(VBCode, "Print ", "blue")
VBCode = FilterWord(VBCode, " And ", "blue")
VBCode = FilterWord(VBCode, " Or ", "blue")
VBCode = FilterWord(VBCode, "Next" & vbcrlf, "blue")
VBCode = FilterWord(VBCode, "Next " , "blue")
VBCode = FilterWord(VBCode, "Response.Write", "darkblue")
VBCode = FilterWord(VBCode, "Response.BinaryWrite" , "darkblue")
VBCode = FilterWord(VBCode, "Response.ContentType" , "darkblue")
VBCode = FilterWord(VBCode, "Response.AddHeader" , "darkblue")
VBCode = FilterWord(VBCode, "Server.CreateObject" , "darkblue")
VBCode = FilterWord(VBCode, "CreateObject" , "darkblue")
' VBCode = FilterWord(VBCode," = ","red")
BasicEncode = VBCode
End Function
Function FilterBeginEnd(ByVal VBCode, ByVal sBegin, ByVal sEnd, ByVal Color)
Dim Pom, PosStart, PosEnd, FontColor
FontColor = "<font color=" & Color & ">"
PosStart = InStr(ucase(VBCode), ucase(sBegin))
Do While PosStart > 0
PosEnd = InStr(PosStart + Len(sBegin), ucase(VBCode), ucase(sEnd))
If PosEnd = 0 Then PosEnd = Len(VBCode)
Pom = Left(VBCode, PosStart - 1) & FontColor
Pom = Pom & Mid(VBCode, PosStart, PosEnd - PosStart + Len(sEnd)) &
"</font>"
Pom = Pom & Mid(VBCode, PosEnd + Len(sEnd))
VBCode = Pom
PosStart = InStr(PosEnd + Len(FontColor) + Len("</font>") + Len(sEnd),
ucas)
Loop
FilterBeginEnd = VBCode
End Function
Function FilterWord(ByVal VBCode, ByVal Word, ByVal Color)
Dim Pom, PosStart, PosEnd, FontWord
FontWord = "<font color=" & Color & ">" & Word & "</font>"
PosStart = InStr(ucase(VBCode), ucase(Word))
Do While PosStart > 0
Pom = Left(VBCode, PosStart - 1) & FontWord
Pom = Pom & Mid(VBCode, PosStart + Len(Word))
VBCode = Pom
PosStart = InStr(PosStart + Len(FontWord), ucase(VBCode), ucase(Word))
Loop
FilterWord = VBCode
End Function
Function FilterWord(ByVal VBCode, ByVal Word, ByVal Color)
Dim Pom, PosStart, PosEnd, FontWord
FontWord = "<font color=" & Color & ">" & Word & "</font>"
PosStart = InStr(ucase(VBCode), ucase(Word))
Do While PosStart > 0
Pom = Left(VBCode, PosStart - 1) & FontWord
Pom = Pom & Mid(VBCode, PosStart + Len(Word))
VBCode = Pom
PosStart = InStr(PosStart + Len(FontWord), ucase(VBCode), ucase(Word))
Loop
FilterWord = VBCode
End Function
</SCRIPT>
--
I Believe I Can ...
_____________________________________________________
欢迎光临我的主页 Netdreams!
※ 来源:·BBS 荔园晨风站 bbs.szu.edu.cn·[FROM: 192.168.28.86]
[回到开始]
[上一篇][下一篇]
荔园在线首页 友情链接:深圳大学 深大招生 荔园晨风BBS S-Term软件 网络书店