求同时上传多张图片进数据库源码.

[gwc0744]

求同时上传多张图片进数据库源码.Access
现在遇到麻烦了！！~~希望各位能帮一下忙。。在线等...

[笨笨兔兔兔兔兔]

'Dim write_application, write_request, write_response, write_server, write_session
Dim RequestData
Dim objform As New Scripting.Dictionary
Dim objfile As New Scripting.Dictionary
Dim requestbytes As New ADODB.Stream
'On Error Resume Next

Public Sub init(write_application1, write_request1, write_response1, write_server1, write_session1)
Set write_application = write_application1
Set write_request = write_request1
Set write_response = write_response1
Set write_server = write_server1
Set write_session = write_session1
End Sub

Public Function Form(strForm)
strForm = LCase(strForm)
If Not objform.Exists(strForm) Then
Form = ""
Else
Form = objform(strForm)
End If
End Function
Public Function theobjfile()
'write_response.Write TypeName(objfile)
Set theobjfile = objfile
End Function

Public Function File(strFile)
strFile = LCase(strFile)
If Not objfile.Exists(strFile) Then
Set File = New File
Else
Set File = objfile(strFile)
End If
End Function

Public Sub getfileinfo(write_application, write_request, write_response, write_server, write_session)
On Error Resume Next

Dim tStream As New ADODB.Stream
With requestbytes
.Type = 1
.Mode = 3
.Open
.Write write_request.BinaryRead(write_request.TotalBytes)
' write_response.Write write_request.TotalBytes
.Position = 0
RequestData = .Read
End With

iFormStart = 1

iFormEnd = LenB(RequestData)
theCrLf = ChrB(13) & ChrB(10)


sStart = MidB(RequestData, 1, InStrB(iFormStart, RequestData, theCrLf) - 1)
iStart = LenB(sStart)
iFormStart = iFormStart + iStart + 1

While (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart, RequestData, theCrLf & theCrLf) + 3
With tStream
.Type = 1
.Mode = 3
.Open
requestbytes.Position = iFormStart
requestbytes.CopyTo tStream, iInfoEnd - iFormStart
.Position = 0
.Type = 2
.Charset = "gb2312" '这句要改。。。。
sInfo = .ReadText
.Close
End With
'取得表单项目名称
iFormStart = InStrB(iInfoEnd, RequestData, sStart)
iFindStart = InStr(22, sInfo, "name=""", 1) + 6
iFindEnd = InStr(iFindStart, sInfo, """", 1)
sFormName = LCase(Mid(sInfo, iFindStart, iFindEnd - iFindStart))
'如果是文件
If InStr(45, sInfo, "filename=""", 1) > 0 Then
Set theFile = New File

dataend = iFormStart - iInfoEnd - 1
image = MidB(RequestData, iInfoEnd + 1, dataend)

iFindStart = InStr(iFindEnd, sInfo, "filename=""", 1) + 10
iFindEnd = InStr(iFindStart, sInfo, """", 1)
sFileName = Mid(sInfo, iFindStart, iFindEnd - iFindStart)

theFile.FileName = getfilename(sFileName)
theFile.filepath = GetFilePath(sFileName)

'取得文件类型
iFindStart = InStr(iFindEnd, sInfo, "Content-Type: ", 1) + 14 '文件的起始位置
iFindEnd = InStr(iFindStart, sInfo, Chr(13))

With theFile
.filetype = Mid(sInfo, iFindStart, iFindEnd - iFindStart)
.filestart = iInfoEnd
.filesize = iFormStart - iInfoEnd - 3
.formname = sFormName
.image = dataend
End With
If Not objfile.Exists(sFormName) Then
objfile.Add sFormName, theFile
End If
Else


'如果是表单项目

With tStream
.Type = 1
.Mode = 3
.Open
requestbytes.Position = iInfoEnd
requestbytes.CopyTo tStream, iFormStart - iInfoEnd - 3
.Position = 0
.Type = 2
.Charset = "gb2312"
sFormValue = .ReadText
.Close
End With
If objform.Exists(sFormName) Then
objform(sFormName) = objform(sFormName) & ", " & sFormValue
Else
objform.Add sFormName, sFormValue
End If
End If
iFormStart = iFormStart + iStart + 1
Wend

RequestData = ""
Set tStream = Nothing


End Sub

Private Function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = Left(FullPath, InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End Function

Private Function getfilename(FullPath)
If FullPath <> "" Then
getfilename = Mid(FullPath, InStrRev(FullPath, "\") + 1)
Else
getfilename = ""
End If
End Function

Public Sub saveindisk(thefilename, filestart, filesize)
Dim dr As New ADODB.Stream
dr.Mode = 3
dr.Type = 1
dr.Open
requestbytes.Position = filestart
requestbytes.CopyTo dr, filesize
dr.SaveToFile thefilename, 2
dr.Close
Set dr = Nothing
End Sub

[笨笨兔兔兔兔兔]

Dim theformname, thefilename, thefilepath, thefilesize, thefiletype, thefilestart, JpgWidth, JpgHeight, theimage
Private Sub Class_Initialize()
FileName = ""
filepath = ""
filesize = 0
filestart = 0
formname = ""
filetype = ""
JpgWidth = 0
JpgHeight = 0
image = 0
End Sub

Public Property Let FileName(thefilename1)
thefilename = thefilename1
End Property

Public Property Get FileName()
FileName = thefilename
End Property

Public Property Let filepath(thefilepath1)
thefilepath = thefilepath1
End Property

Public Property Get filepath()
filepath = thefilepath
End Property

Public Property Let filetype(thefiletype1)
thefiletype = thefiletype1
End Property

Public Property Get filetype()
filetype = thefiletype
End Property

Public Property Let filestart(thefilestart1)
thefilestart = thefilestart1
End Property

Public Property Get filestart()
filestart = thefilestart
End Property

Public Property Let filesize(thefilesize1)
thefilesize = thefilesize1
End Property

Public Property Get filesize()
filesize = thefilesize
End Property

Public Property Let formname(theformname1)
theformname = theformname1
End Property

Public Property Get formname()
formname = theformname
End Property

Public Property Let image(theimage1)
theimage = theimage1
End Property

Public Property Get image()
image = theimage
End Property

[笨笨兔兔兔兔兔]

Public write_script As ScriptingContext
Public write_application As Application
Public write_request As Request
Public write_response As Response
Public write_server As Server
Public write_session As Session
Dim conn

Dim thefile_upload
Dim RequestData
Dim requestbytes As New Stream

Dim upfilefalse As New Scripting.Dictionary
Dim upfilesuccess As New Scripting.Dictionary




Public Sub OnStartPage(MyscriptingContext As ScriptingContext)


Set write_script = MyscriptingContext
Set write_application = MyscriptingContext.Application
Set write_request = MyscriptingContext.Request
Set write_response = MyscriptingContext.Response
Set write_server = MyscriptingContext.Server
Set write_session = MyscriptingContext.Session

End Sub

Public Sub the_upload()
Set thefile_upload = New upload
user_id = write_session("id")
'write_response.Write user_id

' i = 1
'Call thefile_upload.init(write_application, write_request, write_response, write_server, write_session)
Call thefile_upload.getfileinfo(write_application, write_request, write_response, write_server, write_session)
foldernum = thefile_upload.Form("albumsel")
foldernum = getthefoldernum(foldernum)
' Call thefile_upload.theobjfile(write_response)
' write_response.Write TypeName(upload.theobjfile)
For Each formname In thefile_upload.theobjfile ''列出所有上传了的文件
Set File = thefile_upload.File(formname) ''生成一个文件对象
If File.filesize > 0 Then ''如果 FileSize > 0 说明有文件数据
thetype = getthetype(File.FileName)
therealname = getfilename(foldernum, user_id, File.FileName, File.filesize, thetype)
' thefilename = "pic_" & therealname
theaddr = write_server.MapPath("\website\piclibrary") & "\" & therealname & "." & thetype
' theaddr = write_server.MapPath("\website\piclibrary") & "\" & i & "." & thetype
' write_response.Write foldernum
Call thefile_upload.saveindisk(theaddr, File.filestart, File.filesize)
Call thefinalupfile(therealname, theaddr, thefilename)
' write_response.Write thetype

' Call thefile_upload.saveindisk("d:\xxx.jpg", File.filestart, File.filesize)
End If
Next

End Sub
Private Function getthefoldernum(foldernum)
Dim a
a = Split(foldernum, "_")
getthefoldernum = a(1)
End Function

Public Sub thefinalupfile(therealname, theaddr, thefilename)
Dim pic1 As StdPicture
Set pic1 = LoadPicture(theaddr)
If Err.Number = 0 Then
thewidth = pic1.Width
theheight = pic1.Height
Dim MyCommand As New ADODB.Command
Set MyCommand.ActiveConnection = conn
MyCommand.CommandType = 4
MyCommand.CommandText = "updatefileindb"
Set Myparam = MyCommand.CreateParameter("filename", 3, 1, 4, therealname)
MyCommand.Parameters.Append Myparam
Set Myparam = MyCommand.CreateParameter("picwidth", 3, 1, 4, thewidth)
MyCommand.Parameters.Append Myparam

Set Myparam = MyCommand.CreateParameter("picheight", 3, 1, 4, theheight)
MyCommand.Parameters.Append Myparam
MyCommand.Execute
upfilesuccess.Add thefilename, therealname

Else
Err.Clear
sql = "delete from pic where filename='" & therealname & "'"
conn.Execute sql
upfilefalse.Add thefilename, therealname


End If

End Sub

Private Function getthetype(thefilename)
a = Split(thefilename, ".")
getthetype = a(1)
End Function
Public Sub getconn(conntemp)
Set conn = conntemp
End Sub


Private Function getfilename(foldernum, user_id, FileName, filesize, filetype)
'On Error Resume Next
'保存图片到数据库

Dim MyCommand As New ADODB.Command
Set MyCommand.ActiveConnection = conn
MyCommand.CommandType = 4
MyCommand.CommandText = "upfileindb"
Set Myparam = MyCommand.CreateParameter("filename", 200, 1, 50, FileName)
MyCommand.Parameters.Append Myparam
Set Myparam = MyCommand.CreateParameter("id", 3, 1, 4, user_id)
MyCommand.Parameters.Append Myparam
Set Myparam = MyCommand.CreateParameter("filesize", 3, 1, 4, filesize)
MyCommand.Parameters.Append Myparam
Set Myparam = MyCommand.CreateParameter("foldernum", 3, 1, 4, foldernum)
MyCommand.Parameters.Append Myparam
Set Myparam = MyCommand.CreateParameter("pictype", 200, 1, 50, filetype)
MyCommand.Parameters.Append Myparam
Set Myparam = MyCommand.CreateParameter("thefilename", 3, 2, 4)
MyCommand.Parameters.Append Myparam
MyCommand.Execute
thefilename = MyCommand("thefilename")
Set MyCommand = Nothing
getfilename = thefilename
End Function

[笨笨兔兔兔兔兔]

这个是sql server的,access的要稍微改改

[gwc0744]

谢谢!!~~~各位