如何编上传文件的ASP,来源程序吧给100分!!!

wzs 2000-07-16 12:21:00
...全文
237 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
蝈蝈俊 2000-07-17
  • 打赏
  • 举报
回复
到http://www.active.com.cn
下载一个吧,有使用范列。
OUYAN 2000-07-17
  • 打赏
  • 举报
回复
1)首先你要去下载个组件,比如(LyfUpload),
2)然后要进行注册,在开始,运行窗中键入,
RegSvr32 c:\windows\system\LyfUpload.dll
3)做一个提交页面,
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title></title>
<meta name="GENERATOR" content="Microsoft FrontPage 3.0">
<style></style>
</head>

<body bgcolor="#C4E0FD">
<table border="0" width="100%" bgcolor="#FDDBC4">
<tr>
<td width="44%">
<p> </p>
<form method="POST" enctype="multipart/form-data" action="ti.asp">
选择文件:<input type="file" name="file1"><br>
选择文件:<input type="file" name="file2"><br>
<input type="submit" value="上载"
style="background-color: rgb(0,0,255); color: rgb(255,255,0)"> </p>
</form>
</td>
</tr>
</table>
</body>
</html>
4)做一个处理提交的ASP文件,(ti.asp)这里先假设是传输到C盘的C:\TEMP
处理提交的ASP文件
<%
Set obj = Server.CreateObject("LyfUpload.UploadFile")
ss=obj.SaveFile("file1", "C:\temp", true) '保存文件到服务器,这里先假设是C盘
aa=obj.filetype("file1")
cc=obj.FileSize
ss1=obj.SaveFile("file2", "C:\temp", true)
aa1=obj.filetype("file2")
cc1=obj.FileSize
if ss<> "" then
Response.Write "选择的文件已经上载到服务器!<br>"
Response.Write("文件名:" & ss)
Response.Write("<br>Content-Type:" & aa)
Response.Write("文件大小:" & cc)
end if
if ss1<> "" then
Response.Write "选择的文件已经上载到服务器!<br>"
Response.Write("文件名:" & ss1)
Response.Write("<br>Content-Type:" & aa1)
Response.Write("文件大小:" & cc1)
end if
%>

华南虎哥 2000-07-17
  • 打赏
  • 举报
回复
---------------接上:不 使 用 组 件 上 载 文 件 示 例-------------------
主题:不用组件上载文件代码具体例子
下面的第一个例子为只是将客户端的文件上传到服务端的例子
第二个例子为将文件内容保存入数据库中。
文件fupload.asp
<%
dim ResultHTML
'Some value greater than default of 60s (According to upload size.)
'The maximum speed is about 100kB/s for IIS4, P200 and local upload, 4kB/s for modem users.
Server.ScriptTimeout = 400

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" for get the fields
' BeginTimer 'Starts timer.
'************************************************* Main Upload - start
Dim Fields
' on error resume next
'Set upload limit to 10M
UploadSizeLimit = 10000000

'Gets uploaded fields
Set Fields = GetUpload()

'There are all of form fields in the Fields object. Example :
'Fields("File1").ContentType - content type of File1 field
'Fields("File1").Value - Binary value of File1 field
ResultHTML = ""
If Err = 0 Then 'Upload was OK
'Write statistics about upload
dim Field
For Each Field In Fields.Items
ResultHTML = ResultHTML & "<br>Field : <b>" & LogF(Field.name) & "</b>, Length : <b>" & LogFn(Field.Length) & "</b>, Content-Type : <b>" & LogF(Field.ContentType) & "</b>, SourceFileName :?b>" & LogF(Field.FileName) & "</b>"
Next

'Saves the fields to the disk, writes result to the client and writes log.
'See utils.inc. You can change the function to save the files to another location.
ResultHTML = ResultHTML & "<BR>" & SaveUpload(Fields, Server.MapPath("."), LogFolder)
Else 'Error in upload. Write the error
ResultHTML = ResultHTML & "<br>Error : " & Err.Description
End If
On Error GoTo 0
Fields = Empty 'Clear the variable
'************************************************* Main Upload - end
' EndTimer 'Writes info about consumed time.
End If 'Request method must be "POST"

%>


<%'upload.inc, contains GetUpload function, Required for upload - only the one file%>
<!--#INCLUDE FILE="fupload.inc"-->
<%'utils.inc, contains SaveUpload function%>
<!--#INCLUDE FILE="futils.inc"-->
<%'format.inc, contains head and Foot function, optional.%>
<!--#INCLUDE FILE="fformat.inc"-->
<%=Head("Sample multiple binary files upload via ASP", "Demonstrates using of the ByteArray class for working with binary data from Request.BinaryRead.")%>

<Table>
<form method=post ENCTYPE="multipart/form-data">
<TR BGColor=Silver><TD></TD><TD Align=Right><input type="submit" Name="Action" value="Upload the files >>"></TD></TR>
<TR><TD ColSpan=2>
<Table Width=100% Border=0 cellpadding=0 cellspacing=0><tr><TD>
<Div ID=files>
File???input type="file" name="File1"><br>
File???input type="file" name="File2">
</Div>
<TD><TD Align=right VAlign=top>
<A style=cursor:hand onclick=return(Expand())><Font COlor=Blue><U>add a file</U></Font></a>
</TD></TR></Table>
</TD></TR>
<TR><TD>Checkbox</TD><TD><input type="CHECKBOX" name="Check1" Checked></TD></TR>
<TR><TD>Password</TD><TD><input type="PASSWORD" name="PASSWORD"></TD></TR>
<TR><TD>Comments</TD><TD><input size="60" name="Comments" value="Some comments."></TD></TR>
<TR><TD>Description</TD><TD><textarea cols="60" rows="8" name="Description">Some long text of any size - without 80k limit of ASP Request.Form("...").</textarea></TD></TR>
</form>
</Table>
<HR>?%=ResultHTML%>
<Script>
var nfiles = 2;
function Expand(){
nfiles++
files.insertAdjacentHTML('BeforeEnd','<BR>File?+nfiles+'??input type="file" name="File'+nfiles+'">');

return false
}
</Script>
<%=Foot%>

文件fdbutl.asp将文件内容保存如数据库中
<%'upload.inc, contains GetUpload function, Required for upload - only the one file%>
<!--#INCLUDE FILE="fupload.inc"-->
<%'format.inc, contains head and Foot function, optional.%>
<!--#INCLUDE FILE="fformat.inc"-->
<%=Head("Sample database upload via ASP", "Demonstrates using of the ByteArray class for working with binary data from Request.BinaryRead.")%>

<Table>
<form method=post ENCTYPE="multipart/form-data">
<TR><TD></TD><TD Align=Right><input type="submit" Name="Action" value="Upload the file >>"></TD></TR>
<TR><TD>File to upload</TD><TD><input type="file" name="DBFile"></TD></TR>
<TR><TD>Title</TD><TD><input size="60" name="Title" value="Title of the file."></TD></TR>
<TR><TD>Description</TD><TD><textarea cols="60" rows="8" name="Description">Type description of the file.</textarea></TD></TR>
</form>
</Table>

<%=Foot%>

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'Some value greater than default of 60s (According to upload size.)
'The maximum speed is about 100kB/s for IIS4, P200 and local upload, 4kB/s for modem users.
Server.ScriptTimeout = 200


If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST" for get the fields
'************************************************* Main Upload - start
Dim Fields
' on error resume next
'Gets uploaded fields
Set Fields = GetUpload()
'There are all of form fields in the Fields object. Example :
'Fields("File1").ContentType - content type of File1 field
'Fields("File1").Value.String - File1 field converted to a string
'Fields("File1").Value.ByteArray - File1 field as safearray to store in binary RS field or file
'Fields("Comments").Value.String - value of Comments field

If Err = 0 Then 'Upload was OK
'Saves fields to the database and returns result to the client.
Response.Write DBSaveUpload(Fields)
Else 'Error in upload. Write the error
Response.Write Err.Description
End If
On Error GoTo 0
Fields = Empty 'Clear the variable
'************************************************* Main Upload - end
End If 'Request method must be "POST"


function DBSaveUpload(Fields)
dim Conn, RS
Set Conn = GetConnection
Set RS = Server.CreateObject("ADODB.Recordset")
RS.Open "Upload", Conn, 2, 2
RS.AddNew
RS("UploadDT") = Now()

RS("RemoteIP") = Request.ServerVariables("REMOTE_ADDR")
RS("ContentType") = Fields("DBFile").ContentType
RS("SouceFileName") = Fields("DBFile").FileName

RS("Description") = BinaryToString(Fields("Description").Value)
RS("Title") = BinaryToString(Fields("Title").Value)
RS("Data").AppendChunk Fields("DBFile").Value
RS.Update
RS.Close
Conn.Close
DBSaveUpload = "<br>File <b>" & Fields("DBFile").FileName & "</b>, length : <b>" & Fields("DBFile").Length & " B</b> was saved to the database. "
end function

function GetConnection()
dim Conn, AuthConnectionString
Set Conn = Server.CreateObject("ADODB.Connection")
'MDB connection
AuthConnectionString = "DBQ=" & Server.MapPath(".") & "\fupload.mdb;DefaultDir=" & Server.MapPath("/") & ";" & _
"Driver={Microsoft Access Driver (*.mdb)}; DriverId=25;FIL=MS Access;MaxBufferSize=512;PageTimeout=5;UID=;"
Conn.open AuthConnectionString
'SQL connection
'Simply change connection and create table to upload to MS SQL
' Conn.Provider = "SQLOLEDB"
' Conn.Open "Server=(Local);Database=Auth", "sa", "password"
set GetConnection = Conn
end function

function CreateUploadTable(Conn)
dim SQL
SQL = SQL & "CREATE TABLE Upload ("
SQL = SQL & " UploadID int IDENTITY (1, 1) NOT NULL ,"
SQL = SQL & " UploadDT datetime NULL ,"
SQL = SQL & " RemoteIP char (15) NULL ,"
SQL = SQL & " ContentType char (64) NULL ,"
SQL = SQL & " SouceFileName varchar (255) NULL ,"
SQL = SQL & " Title varchar (255) NULL ,"
SQL = SQL & " Description text NULL ,"
SQL = SQL & " Data image NULL "
SQL = SQL & ")"
Conn.Execute SQL
end function
</SCRIPT>
--------------------------------------------------------------------------
华南虎哥 2000-07-17
  • 打赏
  • 举报
回复
------------------不使用组件源代码------------------
主题:不用组件上载文件代码段
下面将介绍一系列可以不用组件,而使用纯粹的ASP代码来上传文件
呵呵,我想这将给很多拥有个人主页的网友带来极大的方便。
这个纯ASP代码由三个包含文件组成,代码中只使用了FileSystemObject
和Direction两个ASP固有对象。而不需要任何附加的组件,注意,为了保证
这段代码的出处,我没有对代码中的任何地方进行过修改。
希望能够对大家有所帮助:
文件fupload.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'Sample multiple binary files upload via ASP - upload include
'c1997-1999 Antonin Foller, PSTRUH Software, http://www.pstruh.cz
'The file is part of ScriptUtilities library
'The file enables http upload to ASP without any components.
'But there is a small problem - ASP does not allow save binary data to the disk.
' So you can use the upload for :
' 1. Upload small text (or HTML) files to server-side disk (Save the data by filesystem object)
' 2. Upload binary/text files of any size to server-side database (RS("BinField") = Upload("FormField").Value


'Limit of upload size
Dim UploadSizeLimit

'********************************** GetUpload **********************************
'This function reads all form fields from binary input and returns it as a dictionary object.
'The dictionary object containing form fields. Each form field is represented by six values :
'.Name name of the form field (<Input Name="..." Type="File,...">)
'.ContentDisposition = Content-Disposition of the form field
'.FileName = Source file name for <input type=file>
'.ContentType = Content-Type for <input type=file>
'.Value = Binary value of the source field.
'.Length = Len of the binary data field
Function GetUpload()
Dim Result
Set Result = Nothing
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST"
Dim CT, PosB, Boundary, Length, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'reads Content-Type header
If LCase(Left(CT, 19)) = "multipart/form-data" Then 'Content-Type header must be "multipart/form-data"
'This is upload request.
'Get the boundary and length from Content-Type header
PosB = InStr(LCase(CT), "boundary=") 'Finds boundary
If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
if "" & UploadSizeLimit<>"" then
UploadSizeLimit = clng(UploadSizeLimit)
if Length > UploadSizeLimit then
' on error resume next 'Clears the input buffer
' response.AddHeader "Connection", "Close"
' on error goto 0
Request.BinaryRead(Length)
Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length,0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit,0) & "B"
exit function
end if
end if

If Length > 0 And Boundary <> "" Then 'Are there required informations about upload ?
Boundary = "--" & Boundary
Dim Head, Binary
Binary = Request.BinaryRead(Length) 'Reads binary data from client

'Retrieves the upload fields from binary data
Set Result = SeparateFields(Binary, Boundary)
Binary = Empty 'Clear variables
Else
Err.Raise 10, "GetUpload", "Zero length request ."
End If
Else
Err.Raise 11, "GetUpload", "No file sent."
End If
Else
Err.Raise 1, "GetUpload", "Bad request method."
End If
Set GetUpload = Result
End Function

'********************************** SeparateFields **********************************
'This function retrieves the upload fields from binary data and retuns the fields as array
'Binary is safearray of all raw binary data from input.
Function SeparateFields(Binary, Boundary)
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Dim Fields
Boundary = StringToBinary(Boundary)

PosOpenBoundary = InstrB(Binary, Boundary)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
'Header and file/source field data
Dim HeaderContent, FieldContent
'Header fields
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Helping variables
Dim Field, TwoCharsAfterEndBoundary
'Get end of header
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Separates field header
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Separates field content
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Separates header fields from header
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Create one field and assign parameters
Set Field = CreateUploadField()
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Field.Value = FieldContent
Field.Length = LenB(FieldContent)

Fields.Add FormFieldName, Field

'Is this ending boundary ?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
If Not isLastBoundary Then 'This is not ending boundary - go to next form field.
PosOpenBoundary = PosCloseBoundary
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
End If
Loop
Set SeparateFields = Fields
End Function

'********************************** Utilities **********************************
Function BinaryToString(Binary)
Dim I, S
For I=1 to LenB(Binary)
S = S & Chr(AscB(MidB(Binary,I,1)))
Next
BinaryToString = S
End Function

Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next
StringToBinary = B
End Function

'Separates header fields from upload header
Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Name = (SeparateField(Head, "name=", ";")) 'ltrim
If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function

'Separets one filed between sStart and sEnd
Function SeparateField(From, ByVal sStart, ByVal sEnd)
Dim PosB, PosE, sFrom
sFrom = LCase(From)
PosB = InStr(sFrom, sStart)
If PosB > 0 Then
PosB = PosB + Len(sStart)
PosE = InStr(PosB, sFrom, sEnd)
If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
If PosE = 0 Then PosE = Len(sFrom) + 1
SeparateField = Mid(From, PosB, PosE - PosB)
Else
SeparateField = Empty
End If
End Function

'Separetes file name from the full path of file
Function GetFileName(FullPath)
Dim Pos, PosF
PosF = 0
For Pos = Len(FullPath) To 1 Step -1
Select Case Mid(FullPath, Pos, 1)
Case "/", "\": PosF = Pos + 1: Pos = 0
End Select
Next
If PosF = 0 Then PosF = 1
GetFileName = Mid(FullPath, PosF)
End Function
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
//The function creates Field object.
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
this.Name = null
this.ContentDisposition = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>



文件futils.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'True PureASP upload - enables save of uploaded text fields to the disk.
'c1997-1999 Antonin Foller, PSTRUH Software, http://www.pstruh.cz
'The file is part of ScriptUtilities library
'The file enables http upload to ASP without any components.
'But there is a small problem - ASP does not allow save binary data to the disk.
' So you can use the upload for :
' 1. Upload small text (or HTML) files to server-side disk (Save the data by filesystem object)
' 2. Upload binary/text files of any size to server-side database (RS("BinField") = Upload("FormField").Value

'All uploaded files and log file will be saved to the next folder :
Dim LogFolder
LogFolder = Server.MapPath(".")

'********************************** SaveUpload **********************************
'This function creates folder and saves contents of the source fields to the disk.
'The fields are saved as files with names of form-field names.
'Also writes one line to the log file with basic informations about upload.
Function SaveUpload(Fields, DestinationFolder, LogFolder)
if DestinationFolder = "" then DestinationFolder = Server.MapPath(".")

Dim UploadNumber, OutFileName, FS, OutFolder, TimeName, Field
Dim LogLine, pLogLine, OutLine

'Create unique upload folder
Application.Lock
if Application("UploadNumber") = "" then
Application("UploadNumber") = 1
else
Application("UploadNumber") = Application("UploadNumber") + 1
end if
UploadNumber = Application("UploadNumber")
Application.UnLock

TimeName = Right("0" & Year(Now), 2) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2) & "_" & Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2) & "-" & UploadNumber
Set FS = CreateObject("Scripting.FileSystemObject")
Set OutFolder = FS.CreateFolder(DestinationFolder + "\" + TimeName)

Dim TextStream
'Save the uploaded fields and create log line
For Each Field In Fields.Items
'Write content of the field to the disk
'!!!! This function uses FileSystemObject to save the file. !!!!!
'So you can only use text files to upload. Save binary files by the function takes undefined results.
'To upload binary files see ScriptUtilities, http://www.pstruh.cz

'You can save files with original file names :
'Set TextStream = FS.CreateTextFile(OutFolder & "\" & Field.FileName )

'Or with names of the fields
Set TextStream = FS.CreateTextFile(OutFolder & "\" & Field.Name & ".")

'And this is the problem why only short text files - BinaryToString uses char-to-char conversion. It takes a lot of computer time.
TextStream.Write BinaryToString(Field.Value) ' BinaryToString is in upload.inc.
TextStream.Close


'Create log line with info about the field
LogLine = LogLine & """" & LogF(Field.name) & LogSeparator & LogF(Field.Length) & LogSeparator & LogF(Field.ContentDisposition) & LogSeparator & LogF(Field.FileName) & LogSeparator & LogF(Field.ContentType) & """" & LogSeparator
Next

'Creates line with global request info
pLogLine = pLogLine & Request.ServerVariables("REMOTE_ADDR") & LogSeparator
pLogLine = pLogLine & LogF(Request.ServerVariables("LOGON_USER")) & LogSeparator
pLogLine = pLogLine & Request.ServerVariables("HTTP_Content_Length") & LogSeparator
pLogLine = pLogLine & OutFolder & LogSeparator
pLogLine = pLogLine & LogLine
pLogLine = pLogLine & LogF(Request.ServerVariables("HTTP_USER_AGENT")) & LogSeparator
pLogLine = pLogLine & LogF(Request.ServerVariables("HTTP_COOKIE"))

'Create output line for the client
OutLine = OutLine & "Fields was saved to the <b>" & OutFolder & "</b> folder.<br>"

DoLog pLogLine, "UP"

OutFolder = Empty 'Clear variables.
SaveUpload = OutLine
End Function

'Writes one log line to the log file
Function DoLog(LogLine, LogPrefix)
if LogFolder = "" then LogFolder = Server.MapPath(".")
Const LogSeparator = ", "
Dim OutStream, FileName
FileName = LogPrefix & Right("0" & Year(Now), 2) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2) & ".LOG"

Set OutStream = Server.CreateObject("Scripting.FileSystemObject").OpenTextFile(LogFolder & "\" & FileName, 8, True)
OutStream.WriteLine Now() & LogSeparator & LogLine
OutStream = Empty
End Function

'Returns field or "-" if field is empty
Function LogF(ByVal F)
If "" & F = "" Then LogF = "-" Else LogF = "" & F
End Function

'Returns field or "-" if field is empty
Function LogFn(ByVal F)
If "" & F = "" Then LogFn = "-" Else LogFn = formatnumber(F,0)
End Function

Dim Kernel, TickCount, KernelTime, UserTime
Sub BeginTimer()
on error resume next
Set Kernel = CreateObject("ScriptUtils.Kernel") 'Creates the Kernel object
'Get start times
TickCount = Kernel.TickCount
KernelTime = Kernel.CurrentThread.KernelTime
UserTime = Kernel.CurrentThread.UserTime
on error goto 0
End Sub

Sub EndTimer()
'Write times
on error resume next
Response.Write "<br>Script time : " & (Kernel.TickCount - TickCount) & " ms"
Response.Write "<br>Kernel time : " & CLng((Kernel.CurrentThread.KernelTime - KernelTime) * 86400000) & " ms"
Response.Write "<br>User time : " & CLng((Kernel.CurrentThread.UserTime - UserTime) * 86400000) & " ms"
on error goto 0
Kernel = Empty
End Sub
</SCRIPT>



文件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/download via ASP from <a href=http://www.pstruh.cz>PSTRUH Software</a>.</font>"
HTML = HTML & "</td><td Align=right><Font Size=1><A HRef=http://www.pstruh.cz/help/ScptUtl/library.htm>Activex Upload</A>?A HRef=http://www.pstruh.cz/help/usrmgr/library.htm>ActiveX UserManager</A>?A HRef=http://www.pstruh.cz/help/RSConv/library.htm>DBF on-the-fly</A>?A HRef=http://www.pstruh.cz/help/tcpip/library.htm>ActiveX DNS+TraceRoute</A>?A HRef=http://www.pstruh.cz/help/urlrepl/library.htm>URL Replacer</A>?/Font>"
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-left:0pt;">
end function

function Style()
Style = "<STYLE TYPE=""text/css""><--BODY{font-size:10pt;font-family:Arial,Arial CE,Helvetica,sans-serif }--></STYLE>"
'<LeftMargin=0 TopMargin=0 Style="margin-right:0pt; margin-top:0pt; margin-left:0pt;">
end function

function ClHead()
DIM HTML
HTML = HTML & "<TABLE width=100% border=1 cellpadding=1 cellspacing=0 BORDERCOLOR=WHITE><tr bgcolor=SILVER>"
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>View source</a></th>"
HTML = HTML & "</tr></table>"
ClHead = HTML
end function

function Source()
DIM HTML
if request.querystring("S")<>"" then
HTML = HTML & "<pre>" & server.htmlencode(CreateObject("Scripting.FileSystemObject").OpenTextFile _
(server.mappath(request.servervariables("script_name")), 1, False, False).readall) & "</pre>"
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), ucase(VBCode), ucase(sBegin))
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
</SCRIPT>
------------------------------------------------------------------------
代码来源:http://xxling.com/blog/article/75.aspx 我只是将其代码中asp实例改成了php,转载及使用必须注明原作者。 请遵循原作者开放享的方式,请勿用来赚取积!!! 代码做的非常简单,只是用于演示,没有加入任何过滤函数。请务必修改(加入过滤函数)后使用,【坚决不能】直接用于网站!! 之前没怎么接触过js,也是随手做一个。如果不满意请各位多包含,毕竟我不是骗,也请您高抬贵手。 目前网上看到最好的一个HTML5批量上传程序,它使用纯html+js进行批量上传,不需要flash、jquery等额外组件,大小只有10KB左右。 主要是我想研究一下html5批量上传,但发现纯html5在php中会出现超时、没有进度等问题,于是这网上找了一圈。发现目前的代码,要不就是传统的flash,要不就是调用臃肿的jquery,要不就是代码动辄几百K,根本没法析。而且CSDN上资源骗居多,找了一圈花了几十,还是没下载到一个真正满意的代码。 于是根据这位博主的享,把原程序精简,并改为了php脚本。因为我php也是初学,之前一直出现只上传1个文件的问题。后来发现是由于定义秒为文件名,本地速度过快将前面的函数覆盖了。多亏了php的sleep,才将这个问题解决。 于是这个简单的批量上传组件就这样做好了,欢迎各位测试和修改。 最后再次提醒各位务必牢记原作者xiaolingzi和其博客地址地址: http://xxling.com/blog/article/75.aspx 转载请注明原作者,修改和使用也不要去掉js的作者标记。 毕竟那标记就一行,人家写个程序很不容易,请各位尊重作者的劳动。谢谢各位配合!
书名:JSP 2.0 技术手册(电子书) 格式:PDF 出版:电子工业出版社 作者:林上杰、林康司 本书图文并茂,以丰富的实例为引导,全面介绍了主流的 Java Web 开发技术—— JSP 2.0,重点介绍Java在展示层的两项重要技术:Java Servlet与JavaServer Pages。 它们是最重要的 Java 核心技术。对这两项技术的深入了解,将有助于您未来对于 JavaServer Faces(JSF)技术以及Java Web Services技术的学习 目录 第一章 安装执行环境 1-1 安装 J2SDK 1.4.2 1-2 安装 Tomcat 5.0.16 1-3 安装 JSPBook 站台范例 1-4 安装 Ant 1.6 第二章 Servlet 2.4 简介 2-1 Servlet 简介 2-2 First Servlet Sample Code 2-3 Servlet 的生命周期 2-4 Servlet 范例程序 2-5 Servlet 2.4 的新功能 第三章 JSP 2.0 简介 3-1 JavaServer Pages 技术 3-2 What is JSP 3-3 JSP 与 Servlet 的比较 3-4 JSP 的执行过程 3-5 JSP 与 ASPASP+ 的比较 3-6 JSP 2.0 新功能 第四章 JSP 语法 4-1 Elements 和 Template Data 4-2 批注(Comments) 4-3 Quoting 和 Escape 规则 4-4 Directives Elements 4-5 Scripting Elements 4-6 Action Elements 4-7 错误处理 第五章 隐含对象(Implicit Object) 5-1 属性( Attribute ) 与范围( Scope ) 5-2 与 Servlet 有关的隐含对象 5-3 与 Input / Output 有关的隐含对象 5-4 与 Context 有关的隐含对象 5-5 与 Error 有关的隐含对象 第六章 Expression Language 6-1 EL 简介 6-2 EL 语法 6-3 EL 隐含对象 6-4 EL 算术运算符 6-5 EL 关系运算符 6-6 EL 逻辑运算符 6-7 EL 其他运算符 6-8 EL Functions 第七章 JSTL 1.1 7-1 JSTL 1.1 简介 7-2 核心标签库(Core tag library) 7-3 I18N 格式标签库(I18N-capable formatting tags library) 7-4 SQL 标签库(SQL tag library) 7-5 XML 标签库(XML tag library) 7-6 函数标签库(Functions tag library) 第八章 JSP 与 JavaBean 8-1 JavaBean 的简介 8-2 JSP 与 JavaBean 8-3 JavaBean 的范围 8-4 JavaBean 的移除 第九章 网页窗体的处理 9-1 HTML 窗体如何传送数据 9-2 窗体中常见的输入类型 9-3 JSP 处理窗体 9-4 文件上传—— Oreilly 上传组件 9-5 jspSmartUpload ——上传和下载 9-6 本文区输入类型(Textarea) 第十章 Session Tracking 10-1 Stateful & Stateless 10-2 Session Tracking 的四种方法 10-3 Session 的生命周期 10-4 HttpSessionBindingListener 接口 10-5 Shopping Cart 范例程序一 10-6 Shopping Cart 范例程序二 第十一章 Filter 与 Listener 11-1 Filter 简介 11-2 Filter 的运作方式 11-3 实现阶段第一个 Filter 11-4 对请求做统一的认证处理 11-5 ServletRequest 和 ServletResponse 之 Wrapper 类 11-6 使用 Filter 来解决中文问题 11-7 Listener 接口简介 11-8 ServletContext Listener 11-9 HttpSession Listener 11-10 ServletRequest Listener 第十二章 JSP 执行环境与开发工具 12-1 Tomcat 5.0 的介绍 12-2 JSP 开发工具介绍 12-3 Eclipse 简介与安装 12-4 使用 Eclipse 开发 Hello

28,390

社区成员

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧