荔园在线

荔园之美,在春之萌芽,在夏之绽放,在秋之收获,在冬之沉淀

[回到开始] [上一篇][下一篇]


发信人: 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, "&quot;", "&quot;", "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软件 网络书店