目前网络上有很多文件上传的组件如：Upload等，但是功能不全，无法自己修改其中的设计，我想知道如何自己用VB写一个DLL的组件实现上传文件到数据库的功能。组件要实现将上一个网页通过method="POST" enctype="multipart/form-data" 传来的数据保存到数据库中，写出的代码要放在W98+PWS中运行正常，如果哪位知道怎样写请告诉我啊，最好有源代码，要VB的啊，或是介绍一些有相关文章的电子书给我看看也可以。（给200分啊）
---------------------------------------------------------------
这里有一个无组件的方法,很简单自己可以修改其中的设计.动网论坛也用这种方法,我的网站也是http://www.tcsysb.com/musclecn/addstar.asp,这里有使用方法以及源代码下载地址:http://www.5xsoft.com/data/200104/2822340301.htm
---------------------------------------------------------------
我有段vb写的dll的原码，你看看！
（一）
类模块
-----------------------------
Option Explicit
Option Compare Text
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private poContext As ASPTypeLibrary.ScriptingContext
Private poRequest As ASPTypeLibrary.Request
Private psPath As String
Private psSaveAs As String
Private sData As String
Private poSavedRequest As New Scripting.Dictionary
Private psUserFileName As String
Private plFileStart As Long
Private plFileEnd As Long
Private pbNoFileName As Boolean
Private pbNoFileContents As Boolean
Private pbytArrContents() As Byte
Private pbytArrInput() As Byte
Private psError As String
'Header/content delimiter per RFC1867
Private Const HTTP_DELIMITER = "-----------------------------"
Private FORM_DATA As String
Public Sub OnStartPage(Sc As ScriptingContext)
'IIS Passes the scripting context to
'any component contained with the
'requested page
Dim iCtr As Integer
Set poContext = Sc
Set poRequest = poContext.Request
PopulateForm
End Sub
Public Property Get Path() As String
Dim s As String
If psPath = "" Then ResolveFileName (s)
Path = psPath
End Property
Public Property Let Path(ByVal NewValue As String)
If Right(NewValue, 1) <> "" Then NewValue = NewValue & ""
psPath = NewValue
End Property
Public Property Get FileName() As String
Dim s As String
If psSaveAs = "" Then ResolveFileName (s)
FileName = psSaveAs
End Property
Public Property Let FileName(ByVal NewValue As String)
Dim sFileName As String
sFileName = NewValue
'the replace statement is necessary probably due to a bug in
'in the populate form procedure.
'but it works, so do we care?
sFileName = Replace(NewValue, vbLf, "")
If InStr(sFileName, "") > 0 Then
psSaveAs = NameFromFullPath(sFileName)
Path = PathOnly(sFileName)
Else
psSaveAs = TrimWithoutPrejudice(sFileName)
End If
End Property
---------------------------------------------------------------
倒，我写的那个就是VBS的
要转到VB中很容易~~~
1<script language="JScript" runat="Server">
2/****************************************************************\
3<lostinet:source xmlns:lostinet="lostinet-d2g-com/source">
4<lostinet:source-info>
5<lostinet:name>Lostinet_ASP_Upload</lostinet:name>
6<lostinet:description>用ASP处理multipart/form-data上传来的数据</lostinet:description>
7</lostinet:source-info>
8<lostinet:author-info>
9<lostinet:name>Lostinet</lostinet:name>
10<lostinet:email>[email protected];[email protected];</lostinet:email>
11<lostinet:homepage>http://lostinet.d2g.com</lostinet:homepage>
12</lostinet:author-info>
13<lostinet:copyright-info>
14<lostinet:copyright>版权声明:这个软件可以随意发布。也可以根据具体情况进行优化修改。但是请保留作者的相关信息。</lostinet:copyright>
15</lostinet:copyright-info>
16</lostinet:source>
17\\****************************************************************/
18</script>
1<script language="VBScript" runat="Server">
2Option Explicit
3
4'替换内容，用来提取信息
5Function GetFormData_ReplacePattern(str1,p,str2)
6Dim re
7Set re=new RegExp
8re.IgnoreCase=true
9re.Global=true
10re.Pattern=p
11GetFormData_ReplacePattern=re.Replace(str1,str2)
12End Function
13
14'二进制到Unicode
15Function ASCII2Unicode(str)
16dim strLen,res,I
17strLen=LenB(str)
18I=1
19While I < strLen+1
20If I<>strLen And AscB(MidB(str,I,1))>127 Then
21res=res&Chr(AscB(MidB(str,I,1))*256+AscB(MidB(str,I+1,1)))
22I=I+1
23Else
24res=res&ChrW(AscB(MidB(str,I,1)))
25End If
26I=I+1
27Wend
28ASCII2Unicode=res
29End Function
30
31
32'公共属性：
33'IsFile 是否为File类型
34'Name 表单的名字
35'Size,Length 数据的长度
36
37'非文件类型的表单数据
38Class GetFormData_FormObject
39Dim Value '表单的值
40Dim IsFile,Name,Size,Length
41Private Sub Class_Initialize
42IsFile=false
43End Sub
44End Class
45
46'文件类型的数据
47Class GetFormData_FileObject
48Dim FileName '文件在客户端时的路径
49Dim ShortName '文件的短名字
50Dim ContentType '文件的MIME类型
51Dim Stream '公用的Stream
52Dim StreamStart '这个FileObject的数据，在Stream的开始位置
53Dim IsFile,Name,Size,Length
54Private Sub Class_Initialize
55IsFile=true
56End Sub
57Public Function GetData()
58If Size=0 Then
59GetData=""
60Exit Function
61End If
62Stream.Position=StreamStart
63GetData=Stream.Read(Size)
64End Function
65End Class
66
67'从fn:filename 返回短文件名
68Function GetFormData_ShortName(fn)
69Dim pos1,pos2
70pos1=InStrRev(fn,"\")
71pos2=InStrRev(fn,"/")
72If pos2>pos1 Then
73pos1=pos2
74End If
75GetFormData_ShortName=Mid(fn,pos1+1,Len(fn)-pos1)
76End Function
77
78''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
79'调用这个取得表单数据，详细用法，请看例子vbscript.asp
80''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
81Sub GetFormData(ByRef funcForm,ByRef funcFile)
82Dim ContentType
83ContentType=CStr(Request.ServerVariables("Content_Type"))
84If InStr(1,LCase(ContentType),"multipart/form-data",1) = 0 Then
85Err.Raise -1,"","只能是multipart/form-data","",0
86End If
87Dim data,Stream
88data=Request.BinaryRead(Request.TotalBytes)
89Set Stream=Server.CreateObject("ADODB.Stream")
90Stream.Mode=3
91Stream.Type=1
92Stream.Open
93Stream.Write(data)
94Dim lb,pos,pos1,pos2,pos3,oldpos,spliter,spliterlen
95lb=ChrW(2573)
96pos=InStrB(1,data,lb,0)
97spliter=LeftB(data,pos-1)
98spliterlen=LenB(spliter)
99pos=1
100oldpos=1
101
102Dim subdata,subdatalen,line1,line2
103Dim objForm,objFile
104Do
105If pos <> 1 Then
106subdatalen=pos-oldpos-spliterlen-4
107subdata=MidB(data,oldpos+spliterlen+2,subdatalen)
108pos1=InStrB(1,subdata,lb,0)
109pos2=InStrB(pos1+2,subdata,lb,0)
110pos3=InStrB(pos2+2,subdata,lb,0)
111line1=ASCII2Unicode(LeftB(subdata,pos1-1))
112If pos1+2 <> pos2 Then
113Set objFile=new GetFormData_FileObject
114objFile.Name=GetFormData_ReplacePattern(line1,"(^([^;]*)\s*;\s*name=\x22([^\s]*)\x22\s*;\s*filename=\x22([^\x22]*)\x22$)","$3")
115objFile.FileName=GetFormData_ReplacePattern(line1,"(^([^;]*)\s*;\s*name=\x22([^\s]*)\x22\s*;\s*filename=\x22([^\x22]*)\x22$)","$4")
116objFile.ShortName=GetFormData_ShortName(objFile.FileName)
117line2=ASCII2Unicode(MidB(subdata,pos1+2,pos2-pos1-2))
118objFile.ContentType=GetFormData_ReplacePattern(line2,"(\s*content-type\s*:\s*(\S)\s*)","$2")
119objFile.Size=subdatalen-pos3-1
120objFile.Length=objFile.Size
121Set objFile.Stream=Stream
122objFile.StreamStart=oldpos+spliterlen+2+pos3
123Stream.Position=objFile.StreamStart
124funcFile objFile
125objFile=null
126Else
127Set objForm=new GetFormData_FormObject
128objForm.Name=GetFormData_ReplacePattern(line1,"(([^;]*)\s*;\s*name=\x22([^\s]*)\x22)","$3")
129objForm.Value=ASCII2Unicode(RightB(subdata,subdatalen-pos2-1))
130objForm.Size=Len(objForm.Value)
131objForm.Length=objForm.Size
132funcForm objForm
133objForm=null
134End If
135End If
136oldpos=pos
137pos=InStrB(pos+2,data,spliter,0)
138Loop Until pos = 0
139End Sub
140</script>