在无组件上传我刚试成功，所以提供代码给大家一起共享。
/* addemployee.asp */
1<html>
2<head>
3<title>职工之家</title>
4<meta content="text/html; charset=utf-8" http-equiv="Content-Type"/>
5<link href="../css/site_css.css" rel="stylesheet" type="text/css"/>
6</head>
7<script language="javascript">
8<!--
9//选择分类
10///////////////////////////////////////////////////////////////////////
11function selectsort(txtSubject){
12var returnValue
13returnValue=window.showModalDialog("selMode.htm",null,"center:1;status:0;help:0;resized:0;dialogheight:300px;dialogwidth:206px");
14if (returnValue!="" && returnValue!=null){
15txtSubject.value=returnValue
16}
17}
18///////////////////////////////////////////////////////////////////////
19//合法性检查
20function isOK(thisForm){
21var strTemp,strValue,strLen,strExName
22if(thisForm.txtTitle.value==""){
23alert("提示：标题不能为空，请正确输入")
24thisForm.txtTitle.focus()
25return false
26}
27if(thisForm.txtSort.value==""){
28alert("提示：请正确选择分类")
29thisForm.txtSort.focus()
30return false
31}
32/*检查图片类型*/
33if(thisForm.file.value!=""){
34strTemp=thisForm.file.value
35strValue=strTemp.toLowerCase()
36strLen=strTemp.length
37strExName=strValue.substring(strLen-4,strLen)
38if (strExName!=".jpg" && strExName!=".gif"){
39alert("请选择jpg或者gif文件！")
40return false
41}
42return true
43}
44}
45//-->
46</script>
47<body bgcolor="#FFFFFF" leftmargin="1" text="#000000" topmargin="1">
48<form action="transact1.asp" enctype="multipart/form-data" method="post" name="form1">
49<table border="0" cellpadding="0" cellspacing="0">
50<tr>
51<td bgcolor="#006699" colspan="2" height="15"> </td>
52</tr>
53<tr>
54<td class="textBlack">
55<div align="right">标题：</div>
56</td>
57<td>
58<input class="textarea" name="txtTitle" size="52" type="text"/>
59</td>
60</tr>
61<tr>
62<td class="textBlack">
63<div align="right">分类：</div>
64</td>
65<td>
66<input class="textarea" name="txtSort" size="35" type="text"/>
67<input class="buttonSkid" name="Submit2" onclick="selectsort(txtSort);" type="button"/>
68</td>
69</tr>
70<tr>
71<td class="textBlack" valign="top">
72<div align="right">正文：</div>
73</td>
74<td>
75<textarea class="textarea" cols="50" name="txtContent" rows="15"></textarea>
76</td>
77</tr>
78<tr>
79<td class="textBlack" height="14" valign="top">
80<div align="right">图片：</div>
81</td>
82<td class="textBlack" height="14">
83<div align="left">
84<input class="textarea" name="file" size="35" type="file"/>
85</div>
86</td>
87</tr>
88<tr>
89<td class="textBlack" height="42" valign="top"> </td>
90<td class="textBlack" height="42" valign="middle">
91<p>1、您上传的图片大小请控制在<font color="#FF0000"><b>500K</b></font>以内,否则不允许上传<br/>
922、你上传的图片必须为<font color="#FF0000"><b>150*130象素</b></font><br/>
933、上传上传图片的格式为JPG或者GIF</p>
94</td>
95</tr>
96<tr>
97<td class="textBlack" height="39"> </td>
98<td height="39" valign="middle">
99<div align="center"><img height="19" onclick="if(isOK(form1)){form1.submit()}" src="../images/save.gif" width="85"/>
100<img height="19" onclick="self.close();" src="../images/close.gif" width="85"/></div>
101</td>
102</tr>
103</table>
104</form>
105</body>
106</html>
/* transact1.asp*/
1
2If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
3Dim Fields
4Dim strTitle,strSort,strContent
5Dim rs,sSql
6Dim iMaxid
7Dim strMaxid
8Dim strlen
9
10Set Fields = GetUpload()
11strTitle=BinaryToString(Fields("txtTitle").value)
12strSort=BinaryToString(Fields("txtSort").value)
13strContent=BinaryToString(Fields("txtContent").value)
14strSort=split(trim(strSort),"-")
15
16if instr(1,lcase(Fields("file").FileName),".jpg")=0 and instr(1,lcase(Fields("file").FileName),".gif")=0 then
17response.write "
<script language="javascript">alert('上传的图片必须是gif或者jpg格式的图片')</script>
1"
2response.write "
<script language="javascript">window.location='addemployee.asp';</script>
1"
2Response.end
3end if
4
5if Fields("file").Length>500000 then
6response.write "
<script language="javascript">alert('只允许不大于500k的图片上传');</script>
1"
2response.write "
<script language="javascript">window.location='addemployee.asp';</script>
1"
2response.end
3end if
4
5'/*存至数据库*/
6if Fields("file").FileName<>"" then
7Set rs=Server.CreateObject("ADODB.Recordset")
8sSql="select * from employee order by id desc"
9rs.open sSql,conn,2,2
10if not rs.eof then
11iMaxid=Clng(rs("id"))+1
12strlen=4-len(cstr(iMaxid))
13strMaxid=string(strlen,"0") & cstr(iMaxid)
14else
15strMaxid="0001"
16end if
17rs.addnew
18rs("id")=strMaxid
19rs("title")=strTitle
20rs("sort")=strSort(0)
21rs("img").AppendChunk Fields("file").Value
22rs("content")=quoteChg(strContent)
23rs("todate")=date()
24rs.update
25rs.close
26response.write "
<script language="javascript">alert('添加记录成功')</script>
1"
2end if
3end if
/fupload.inc/
1<script language="VBSCRIPT" runat="SERVER">
2Dim UploadSizeLimit
3
4'********************************** GetUpload **********************************
5'.Name name of the form field (<Input Name="..." Type="File,...">)
6'.ContentDisposition = Content-Disposition of the form field
7'.FileName = Source file name for <input type=file>
8'.ContentType = Content-Type for <input type=file>
9'.Value = Binary value of the source field.
10'.Length = Len of the binary data field
11Function GetUpload()
12Dim Result
13Set Result = Nothing
14If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 'Request method must be "POST"
15Dim CT, PosB, Boundary, Length, PosE
16CT = Request.ServerVariables("HTTP_Content_Type") 'reads Content-Type header
17'response.write CT
18'application/x-www-form-urlencoded
19If LCase(Left(CT, 19)) = "multipart/form-data" Then 'Content-Type header must be "multipart/form-data"
20'This is upload request.
21'Get the boundary and length from Content-Type header
22PosB = InStr(LCase(CT), "boundary=") 'Finds boundary
23If PosB > 0 Then Boundary = Mid(CT, PosB + 9) 'Separetes boundary
24Length = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Get Content-Length header
25if "" & UploadSizeLimit<>"" then
26UploadSizeLimit = clng(UploadSizeLimit)
27if Length > UploadSizeLimit then
28' on error resume next 'Clears the input buffer
29' response.AddHeader "Connection", "Close"
30' on error goto 0
31Request.BinaryRead(Length)
32Err.Raise 2, "GetUpload", "Upload size " & FormatNumber(Length,0) & "B exceeds limit of " & FormatNumber(UploadSizeLimit,0) & "B"
33exit function
34end if
35end if
36
37If Length > 0 And Boundary <> "" Then 'Are there required informations about upload ?
38Boundary = "--" & Boundary
39Dim Head, Binary
40Binary = Request.BinaryRead(Length) 'Reads binary data from client
41
42'Retrieves the upload fields from binary data
43Set Result = SeparateFields(Binary, Boundary)
44Binary = Empty 'Clear variables
45Else
46Err.Raise 10, "GetUpload", "Zero length request ."
47End If
48Else
49Err.Raise 11, "GetUpload", "No file sent."
50End If
51Else
52Err.Raise 1, "GetUpload", "Bad request method."
53End If
54Set GetUpload = Result
55End Function
56
57'********************************** SeparateFields **********************************
58'This function retrieves the upload fields from binary data and retuns the fields as array
59'Binary is safearray of all raw binary data from input.
60Function SeparateFields(Binary, Boundary)
61Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
62Dim Fields
63Boundary = StringToBinary(Boundary)
64
65PosOpenBoundary = InstrB(Binary, Boundary)
66PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)
67
68Set Fields = CreateObject("Scripting.Dictionary")
69
70Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
71'Header and file/source field data
72Dim HeaderContent, FieldContent
73'Header fields
74Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
75'Helping variables
76Dim Field, TwoCharsAfterEndBoundary
77'Get end of header
78PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))
79
80'Separates field header
81HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)
82
83'Separates field content
84FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)
85
86'Separates header fields from header
87GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type
88
89'Create one field and assign parameters
90Set Field = CreateUploadField()
91Field.Name = FormFieldName
92Field.ContentDisposition = Content_Disposition
93Field.FilePath = SourceFileName
94Field.FileName = GetFileName(SourceFileName)
95Field.ContentType = Content_Type
96Field.Value = FieldContent
97Field.Length = LenB(FieldContent)
98
99Fields.Add FormFieldName, Field
100
101'Is this ending boundary ?
102TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
103'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
104isLastBoundary = TwoCharsAfterEndBoundary = "--"
105If Not isLastBoundary Then 'This is not ending boundary - go to next form field.
106PosOpenBoundary = PosCloseBoundary
107PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
108End If
109Loop
110Set SeparateFields = Fields
111End Function
112
113'********************************** Utilities **********************************
114Function BinaryToString(str)
115strto = ""
116for i=1 to lenb(str)
117if AscB(MidB(str, i, 1)) > 127 then
118strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
119i = i + 1
120else
121strto = strto & Chr(AscB(MidB(str, i, 1)))
122end if
123next
124BinaryToString=strto
125
126End Function
127
128Function StringToBinary(String)
129Dim I, B
130For I=1 to len(String)
131B = B & ChrB(Asc(Mid(String,I,1)))
132Next
133StringToBinary = B
134End Function
135
136'Separates header fields from upload header
137Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
138Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
139Name = (SeparateField(Head, "name=", ";")) 'ltrim
140If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
141FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
142If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
143Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
144End Function
145
146'Separets one filed between sStart and sEnd
147Function SeparateField(From, ByVal sStart, ByVal sEnd)
148Dim PosB, PosE, sFrom
149sFrom = LCase(From)
150PosB = InStr(sFrom, sStart)
151If PosB > 0 Then
152PosB = PosB + Len(sStart)
153PosE = InStr(PosB, sFrom, sEnd)
154If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
155If PosE = 0 Then PosE = Len(sFrom) + 1
156SeparateField = Mid(From, PosB, PosE - PosB)
157Else
158SeparateField = Empty
159End If
160End Function
161
162'Separetes file name from the full path of file
163Function GetFileName(FullPath)
164Dim Pos, PosF
165PosF = 0
166For Pos = Len(FullPath) To 1 Step -1
167Select Case Mid(FullPath, Pos, 1)
168Case "/", "": PosF = Pos + 1: Pos = 0
169End Select
170Next
171If PosF = 0 Then PosF = 1
172GetFileName = Mid(FullPath, PosF)
173End Function
174</script>
1<script language="JSCRIPT" runat="SERVER">
2//The function creates Field object.
3function CreateUploadField(){ return new uf_Init() }
4function uf_Init(){
5this.Name = null
6this.ContentDisposition = null
7this.FileName = null
8this.FilePath = null
9this.ContentType = null
10this.Value = null
11this.Length = null
12}
13</script>