|
-
ASP- Image upload to access database
i am new to asp and no idea about image upload ,so i followed one tutorial from stardeveloper.com which is written by faisel khan. That code is working fine,. but now my html form have one listbox control where the user can select multiple values,In this case when the user select more than one value in the list item my code is not working. and i have no idea about what modification have to be done . any suggestions.
or is there any other way for doing the same. any other tutorials?.
i am posting my code here.
This is my html form
Code:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
<title>Untitled Document</title>
<script language="JavaScript" type="text/javascript">
<!--
function checkform ( form )
{
if (form.txtName.value == "") {
alert( "Please enter your name " );
form.txtName.focus();
return false ;
}
if (form.txtEmail.value == "") {
alert( "Please Enter your Email Address " );
form.txtEmail.focus();
return false ;
}
if (form.lstDescription.value == "") {
alert( "Please Select Project Description " );
form.lstDescription.focus();
return false ;
}
return true ;
}
//-->
</script>
</head>
<body>
<form method="POST" enctype="multipart/form-data" action="insert_request_quote.asp" onsubmit="return checkform(this);">
<table width="472" border="1">
<tr valign="top">
<td width="279" class="style2">Your name <font color="red">*</font><br /></td>
<td width="254"><input class="inputbox" maxlength="50" size="35"
name="txtName" /></td></tr>
<tr valign="top">
<td class="style2">Your email address <font color="red">*</font><br /></td>
<td><input class="inputbox" maxlength="50" size="35"
name="txtEmail" /></td>
</tr>
<tr valign="top">
<td><span class="style2">Please select to best describe this project <font
color="red">*</font><br />
</span><span class="style13"><small>Use the CTRL key to select all that apply</small></span></td>
<td><select multiple="multiple" size="6"
name="lstDescription">
<option value="">-------- Select all that apply ---------</option>
<option
value="Develop a new site">Develop a new site</option>
<option
value="Redesign an existing site">Redesign an existing site</option>
<option
value="Subcontract web design or programming">Subcontract design or programming</option>
<option
value="Make existing site accessible (ADA)">Make existing site accessible (ADA)</option>
<option
value="Make existing site multilingual">Make existing site multilingual</option>
<option value="other (specify below)">Other (specify below)</option>
</select></td>
</tr>
<td class="style2">You can upload a spec document, file or image from your computer</td>
<td><input class="inputbox" type="file" size="30"
name="uploads" /></td>
<tr>
<td height="50" align="middle"> </td>
<td height="50" align="middle">
<div align="left">
<input class="command_button" type="submit" value="Submit" name="submitbt" />
<img
height="8" alt=""
src="Custom quote - the best prices on web site design from India_files/blank.gif"
width="20" border="0" />
<input name="reset" type="reset" class="command_button" value="Reset" />
</div></td></tr>
</table>
</form>
</body>
</html>
THis is my asp code
Code:
<% ' insert_request_quote.asp %>
<!--#include file="Loader.asp"-->
<%
Response.Buffer = True
' load object
Dim load
Set load = new Loader
' calling initialize method
load.initialize
' File binary data
Dim fileData
fileData = load.getFileData("uploads")
' File name
Dim fileName
fileName = LCase(load.getFileName("uploads"))
' File path
Dim filePath
filePath = load.getFilePath("uploads")
' File path complete
Dim filePathComplete
filePathComplete = load.getFilePathComplete("uploads")
' File size
Dim fileSize
fileSize = load.getFileSize("uploads")
' File size translated
Dim fileSizeTranslated
fileSizeTranslated = load.getFileSizeTranslated("uploads")
' Content Type
Dim contentType
contentType = load.getContentType("uploads")
' No. of Form elements
Dim countElements
countElements = load.Count
' Value of text input field "name"
Dim nameInput
nameInput = load.getValue("txtName")
' Value of text input field "email"
Dim EmailAddress
EmailAddress = load.getValue("txtEmail")
Dim projectDescription
projectDescription = load.getValue("lstDescription")
' destroying load object
Set load = Nothing
' Connection string
Dim connStr
connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source="
connStr = connStr & Server.MapPath("db/requestAQuote.mdb")
' Recordset object
Dim rs
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open "requestQuote", connStr, 2, 2
' Checking to make sure if file was uploaded
If fileSize > 0 Then
' Adding data
rs.AddNew
rs("Name") = nameInput
rs("EmailAddress") = EmailAddress
rs("DescriptionOfProject") = projectDescription
rs("Upload").AppendChunk fileData
rs("File Name") = fileName
rs("File Size") = fileSize
rs("Content Type") = contentType
rs.Update
rs.Close
Set rs = Nothing
Response.Write "<font color=""green"">File was successfully uploaded..."
Response.Write "</font>"
Else
Response.Write "<font color=""brown"">No File Selected For Uploading"
Response.Write "...</font>"
End If
If Err.number <> 0 Then
Response.Write "<br><font color=""red"">Something went wrong..."
Response.Write "</font>"
End If
%>
-
And code for Loader.asp is
Code:
<%
Class Loader
Private dict
Private Sub Class_Initialize
Set dict = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate
If IsObject(intDict) Then
intDict.RemoveAll
Set intDict = Nothing
End If
If IsObject(dict) Then
dict.RemoveAll
Set dict = Nothing
End If
End Sub
Public Property Get Count
Count = dict.Count
End Property
Public Sub Initialize
If Request.TotalBytes > 0 Then
Dim binData
binData = Request.BinaryRead(Request.TotalBytes)
getData binData
End If
End Sub
Public Function getFileData(name)
If dict.Exists(name) Then
getFileData = dict(name).Item("Value")
Else
getFileData = ""
End If
End Function
Public Function getValue(name)
Dim gv
If dict.Exists(name) Then
gv = CStr(dict(name).Item("Value"))
gv = Left(gv,Len(gv)-2)
getValue = gv
Else
getValue = ""
End If
End Function
Public Function saveToFile(name, path)
If dict.Exists(name) Then
Dim temp
temp = dict(name).Item("Value")
Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Dim file
Set file = fso.CreateTextFile(path)
For tPoint = 1 to LenB(temp)
file.Write Chr(AscB(MidB(temp,tPoint,1)))
Next
file.Close
saveToFile = True
Else
saveToFile = False
End If
End Function
Public Function getFileName(name)
If dict.Exists(name) Then
Dim temp, tempPos
temp = dict(name).Item("FileName")
tempPos = 1 + InStrRev(temp, "\")
getFileName = Mid(temp, tempPos)
Else
getFileName = ""
End If
End Function
Public Function getFilePath(name)
If dict.Exists(name) Then
Dim temp, tempPos
temp = dict(name).Item("FileName")
tempPos = InStrRev(temp, "\")
getFilePath = Mid(temp, 1, tempPos)
Else
getFilePath = ""
End If
End Function
Public Function getFilePathComplete(name)
If dict.Exists(name) Then
getFilePathComplete = dict(name).Item("FileName")
Else
getFilePathComplete = ""
End If
End Function
Public Function getFileSize(name)
If dict.Exists(name) Then
getFileSize = LenB(dict(name).Item("Value"))
Else
getFileSize = 0
End If
End Function
Public Function getFileSizeTranslated(name)
If dict.Exists(name) Then
temp = LenB(dict(name).Item("Value"))
If temp <= 1024 Then
getFileSizeTranslated = temp & " bytes"
Else
temp = FormatNumber((temp / 1024), 2)
getFileSizeTranslated = temp & " kilobytes"
End If
Else
getFileSizeTranslated = ""
End If
End Function
Public Function getContentType(name)
If dict.Exists(name) Then
getContentType = dict(name).Item("ContentType")
Else
getContentType = ""
End If
End Function
Private Sub getData(rawData)
Dim separator
separator = MidB(rawData, 1, InstrB(1, rawData, ChrB(13)) - 1)
Dim lenSeparator
lenSeparator = LenB(separator)
Dim currentPos
currentPos = 1
Dim inStrByte
inStrByte = 1
Dim value, mValue
Dim tempValue
tempValue = ""
While inStrByte > 0
inStrByte = InStrB(currentPos, rawData, separator)
mValue = inStrByte - currentPos
If mValue > 1 Then
value = MidB(rawData, currentPos, mValue)
Dim begPos, endPos, midValue, nValue
Dim intDict
Set intDict = Server.CreateObject("Scripting.Dictionary")
begPos = 1 + InStrB(1, value, ChrB(34))
endPos = InStrB(begPos + 1, value, ChrB(34))
nValue = endPos
Dim nameN
nameN = MidB(value, begPos, endPos - begPos)
Dim nameValue, isValid
isValid = True
If InStrB(1, value, stringToByte("Content-Type")) > 1 Then
begPos = 1 + InStrB(endPos + 1, value, ChrB(34))
endPos = InStrB(begPos + 1, value, ChrB(34))
If endPos = 0 Then
endPos = begPos + 1
isValid = False
End If
midValue = MidB(value, begPos, endPos - begPos)
intDict.Add "FileName", trim(byteToString(midValue))
begPos = 14 + InStrB(endPos + 1, value, stringToByte("Content-Type:"))
endPos = InStrB(begPos, value, ChrB(13))
midValue = MidB(value, begPos, endPos - begPos)
intDict.Add "ContentType", trim(byteToString(midValue))
begPos = endPos + 4
endPos = LenB(value)
nameValue = MidB(value, begPos, ((endPos - begPos) - 1))
Else
nameValue = trim(byteToString(MidB(value, nValue + 5)))
End If
If isValid = True Then
intDict.Add "Value", nameValue
intDict.Add "Name", nameN
dict.Add byteToString(nameN), intDict
End If
End If
currentPos = lenSeparator + inStrByte
Wend
End Sub
End Class
Private Function stringToByte(toConv)
Dim tempChar
For i = 1 to Len(toConv)
tempChar = Mid(toConv, i, 1)
stringToByte = stringToByte & chrB(AscB(tempChar))
Next
End Function
Private Function byteToString(toConv)
For i = 1 to LenB(toConv)
byteToString = byteToString & Chr(AscB(MidB(toConv,i,1)))
Next
End Function
%>
Similar Threads
-
By Chicho in forum VB Classic
Replies: 11
Last Post: 10-01-2003, 12:00 AM
-
Replies: 0
Last Post: 01-16-2002, 08:03 PM
-
By greg greg32HOME.COM in forum ASP.NET
Replies: 1
Last Post: 01-04-2002, 09:51 PM
-
By Mike H in forum VB Classic
Replies: 4
Last Post: 03-20-2001, 10:50 AM
-
By deane in forum authorevents.mitchell
Replies: 0
Last Post: 10-16-2000, 10:41 PM
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Development Centers
-- Android Development Center
-- Cloud Development Project Center
-- HTML5 Development Center
-- Windows Mobile Development Center
|
Reply With Quote
