● 不用组件上载文件代码具体例子[转载] - 荔园在线 | 深圳大学学生论坛,荔园晨风BBS,深大在线网站

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

发信人: gary (★有所属), 信区: Homepage
标  题: 不用组件上载文件代码具体例子[转载]
发信站: BBS 荔园晨风站 (Sat Oct 14 08:30:09 2000), 转信

下面的第一个例子为只是将客户端的文件上传到服务端的例子
第二个例子为将文件内容保存入数据库中。
文件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
.
Server.ScriptTimeout = 400

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method
musts
'  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>,
"
      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
.
      ResultHTML = ResultHTML & "<BR>" & SaveUpload(Fields, Server.MapPath(".
"))
    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
>

<%'utils.inc, contains SaveUpload function%>

<%'format.inc, contains head and Foot function, optional.%>

<%=Head("Sample multiple binary files upload via ASP", "Demonstrates using of
t>

<Table>
  <form method=post ENCTYPE="multipart/form-data">
    <TR BGColor=Silver><TD></TD><TD Align=Right><input type="submit"
Name="Acti>
    <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>
      </TD></TR></Table>
    </TD></TR>
    <TR><TD>Checkbox</TD><TD><input type="CHECKBOX" name="Check1"
Checked></TD>>
    <TR><TD>Password</TD><TD><input type="PASSWORD" name="PASSWORD"></TD></TR>
    <TR><TD>Comments</TD><TD><input size="60" name="Comments" value="Some
comme>
    <TR><TD>Description</TD><TD><textarea cols="60" rows="8"
name="Description">
  </form>
</Table>
<HR>?%=ResultHTML%>
<Script>
  var nfiles = 2;
  function Expand(){
    nfiles++
    files.insertAdjacentHTML('BeforeEnd','<BR>File?+nfiles+'??input
type="file";

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

文件fdbutl.asp将文件内容保存如数据库中
<%'upload.inc, contains GetUpload function, Required for upload - only the one
>

<%'format.inc, contains head and Foot function, optional.%>

<%=Head("Sample database upload via ASP", "Demonstrates using of the ByteArray
>

<Table>
  <form method=post ENCTYPE="multipart/form-data">
    <TR><TD></TD><TD Align=Right><input type="submit" Name="Action"
value="Uplo>
    <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
fil>
    <TR><TD>Description</TD><TD><textarea cols="60" rows="8"
name="Description">
  </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
.
Server.ScriptTimeout = 200

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method
musts
  '*************************************************   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
bine
    '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 :
<"
end function

function GetConnection()
  dim Conn, AuthConnectionString
  Set Conn = Server.CreateObject("ADODB.Connection")
  'MDB connection
  AuthConnectionString = "DBQ=" & Server.MapPath(".") & "\fupload.mdb;
DefaultDi_
      "Driver={Microsoft Access Driver (*.mdb)}; DriverId=25;FIL=MS Access;
MaxB"
  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 ,"
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>
--
   Ｉ　Ｂelieve　Ｉ　Ｃan ...
_____________________________________________________
欢迎光临我的主页          Ｎｅｔｄｒｅａｍｓ!

※ 来源:·BBS 荔园晨风站 bbs.szu.edu.cn·[FROM: 192.168.28.86]

荔园在线首页友情链接：深圳大学深大招生荔园晨风BBS S-Term软件网络书店