Toon posts:

[ASP] INSERT pad naar database

Pagina: 1
Acties:
  • 61 views sinds 30-01-2008

Verwijderd

Topicstarter
Voor school ben ik aan t stoeien met ASP. (in Dreamweaver MX) Mijn achtergrond qua ASPcode schrijven is drama. Dus Dreamweaver is voor mij de tool. Het is de bedoeling dat ik een CMS opstel. Bijna aan het eind stuit ik nu op het probleem met het uploaden van een image naar een MS database.

Onderstaande code schrijft een image naar de map "image/" en schrijft de image naam naar de database. In de kolom "filename" komt dan bv "image.jpeg" te staan. Wat ik wil bereiken is dat er standaard image/ voor de filename komt te staan zodat het plaatje goed wordt uitgelezen en vertoond wordt op de website. Dus uiteindelijk bereik in de database moet worden "images/image.jpg

ik neem aan dat het een simpel iets is en dat er alleen maar ergens images/ moet komen staan, maar ik heb geen flauw idee!!!

Zou iemand mij hiermee kunnen helpen?

<%@LANGUAGE="VBSCRIPT"%>
<!--#include file="../../Connections/lynxVB.asp" -->
<%
'*** File Upload to: images, Extensions: "GIF,JPG,JPEG,BMP,PNG", Form: fmupload, Redirect: ""
'*** Pure ASP File Upload -----------------------------------------------------
' Copyright 2000 (c) George Petrov
'
' Script partially based on code from Philippe Collignon
' (http://www.asptoday.com/articles/20000316.htm)
'
' New features from GP:
' * Fast file save with ADO 2.5 stream object
' * new wrapper functions, extra error checking
' * UltraDev Server Behavior extension
'
' Version: 1.5.0
'------------------------------------------------------------------------------
Sub BuildUploadRequest(RequestBin)
'Get the boundary
PosBeg = 1
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
if PosEnd = 0 then
Response.Write "<b>Form was submitted with no ENCTYPE=""multipart/form-data""</b><br>"
Response.Write "Please correct the form attributes and try again."
Response.End
end if
boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
boundaryPos = InstrB(1,RequestBin,boundary)
'Get all data inside the boundaries
Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
'Members variable of objects are put in a dictionary object
Dim UploadControl
Set UploadControl = CreateObject("Scripting.Dictionary")
'Get an object name
Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
Pos = InstrB(Pos,RequestBin,getByteString("name="))
PosBeg = Pos+6
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
PosBound = InstrB(PosEnd,RequestBin,boundary)
'Test if object is of file type
If PosFile<>0 AND (PosFile<PosBound) Then
'Get Filename, content-type and content of file
PosBeg = PosFile + 10
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
FileName = Mid(FileName,InStrRev(FileName,"\")+1)
'Add filename to dictionary object
UploadControl.Add "FileName", FileName
Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
PosBeg = Pos+14
PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
'Add content-type to dictionary object
ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
UploadControl.Add "ContentType",ContentType
'Get content of object
PosBeg = PosEnd+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = FileName
ValueBeg = PosBeg-1
ValueLen = PosEnd-Posbeg
Else
'Get content of object
Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
PosBeg = Pos+4
PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
ValueBeg = 0
ValueEnd = 0
End If
'Add content to dictionary object
UploadControl.Add "Value" , Value
UploadControl.Add "ValueBeg" , ValueBeg
UploadControl.Add "ValueLen" , ValueLen
'Add dictionary object to main dictionary
UploadRequest.Add name, UploadControl
'Loop to next object
BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
Loop
End Sub

'String to byte string conversion
Function getByteString(StringStr)
For i = 1 to Len(StringStr)
char = Mid(StringStr,i,1)
getByteString = getByteString & chrB(AscB(char))
Next
End Function

'Byte string to string conversion
Function getString(StringBin)
getString =""
For intCount = 1 to LenB(StringBin)
getString = getString & chr(AscB(MidB(StringBin,intCount,1)))
Next
End Function

Function UploadFormRequest(name)
on error resume next
if UploadRequest.Item(name) then
UploadFormRequest = UploadRequest.Item(name).Item("Value")
end if
End Function

'Process the upload
UploadQueryString = Replace(Request.QueryString,"GP_upload=true","")
if mid(UploadQueryString,1,1) = "&" then
UploadQueryString = Mid(UploadQueryString,2)
end if

GP_uploadAction = CStr(Request.ServerVariables("URL")) & "?GP_upload=true"
If (Request.QueryString <> "") Then
if UploadQueryString <> "" then
GP_uploadAction = GP_uploadAction & "&" & UploadQueryString
end if
End If

If (CStr(Request.QueryString("GP_upload")) <> "") Then
GP_redirectPage = ""
If (GP_redirectPage = "") Then
GP_redirectPage = CStr(Request.ServerVariables("URL"))
end if

RequestBin = Request.BinaryRead(Request.TotalBytes)
Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest RequestBin

GP_keys = UploadRequest.Keys
for GP_i = 0 to UploadRequest.Count - 1
GP_curKey = GP_keys(GP_i)
'Save all uploaded files
if UploadRequest.Item(GP_curKey).Item("FileName") <> "" then
GP_value = UploadRequest.Item(GP_curKey).Item("Value")
GP_valueBeg = UploadRequest.Item(GP_curKey).Item("ValueBeg")
GP_valueLen = UploadRequest.Item(GP_curKey).Item("ValueLen")

if GP_valueLen = 0 then
Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br>"
Response.Write "File does not exists or is empty.<br>"
Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
response.End
end if

'Create a Stream instance
Dim GP_strm1, GP_strm2
Set GP_strm1 = Server.CreateObject("ADODB.Stream")
Set GP_strm2 = Server.CreateObject("ADODB.Stream")

'Open the stream
GP_strm1.Open
GP_strm1.Type = 1 'Binary
GP_strm2.Open
GP_strm2.Type = 1 'Binary

GP_strm1.Write RequestBin
GP_strm1.Position = GP_ValueBeg
GP_strm1.CopyTo GP_strm2,GP_ValueLen

'Create and Write to a File
GP_curPath = Request.ServerVariables("PATH_INFO")
GP_curPath = Trim(Mid(GP_curPath,1,InStrRev(GP_curPath,"/")) & "images")
if Mid(GP_curPath,Len(GP_curPath),1) <> "/" then
GP_curPath = GP_curPath & "/"
end if
on error resume next
GP_strm2.SaveToFile Trim(Server.mappath(GP_curPath))& "\" & UploadRequest.Item(GP_curKey).Item("FileName"),2
if err then
Response.Write "<B>An error has occured saving uploaded file!</B><br><br>"
Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "<br>"
Response.Write "Maybe the destination directory does not exist, or you don't have write permission.<br>"
Response.Write "Please correct and <A HREF=""javascript:history.back(1)"">try again</a>"
err.clear
response.End
end if
end if
next

'*** GP NO REDIRECT
end if
if UploadQueryString <> "" then
UploadQueryString = UploadQueryString & "&GP_upload=true"
else
UploadQueryString = "GP_upload=true"
end if

%>
<%
' *** Edit Operations: (Modified for File Upload) declare variables

MM_editAction = CStr(Request.ServerVariables("URL")) 'MM_editAction = CStr(Request("URL"))
If (UploadQueryString <> "") Then
MM_editAction = MM_editAction & "?" & UploadQueryString
End If

' boolean to abort record edit
MM_abortEdit = false

' query string to execute
MM_editQuery = ""
%>
<%
' *** Insert Record: (Modified for File Upload) set variables

If (CStr(UploadFormRequest("MM_insert")) <> "") Then

MM_editConnection = MM_lynxVB_STRING
MM_editTable = "Images"
MM_editRedirectUrl = "gelukt.html"
MM_fieldsStr = "fmfile|value"
MM_columnsStr = "filename|',none,''"

' create the MM_fields and MM_columns arrays
MM_fields = Split(MM_fieldsStr, "|")
MM_columns = Split(MM_columnsStr, "|")

' set the form values
For i = LBound(MM_fields) To UBound(MM_fields) Step 2
MM_fields(i+1) = CStr(UploadFormRequest(MM_fields(i)))
Next

' append the query string to the redirect URL
If (MM_editRedirectUrl <> "" And UploadQueryString <> "") Then
If (InStr(1, MM_editRedirectUrl, "?", vbTextCompare) = 0 And UploadQueryString <> "") Then
MM_editRedirectUrl = MM_editRedirectUrl & "?" & UploadQueryString
Else
MM_editRedirectUrl = MM_editRedirectUrl & "&" & UploadQueryString
End If
End If

End If
%>
<%
' *** Insert Record: (Modified for File Upload) construct a sql insert statement and execute it

If (CStr(UploadFormRequest("MM_insert")) <> "") Then

' create the sql insert statement
MM_tableValues = ""
MM_dbValues = ""
For i = LBound(MM_fields) To UBound(MM_fields) Step 2
FormVal = MM_fields(i+1)
MM_typeArray = Split(MM_columns(i+1),",")
Delim = MM_typeArray(0)
If (Delim = "none") Then Delim = ""
AltVal = MM_typeArray(1)
If (AltVal = "none") Then AltVal = ""
EmptyVal = MM_typeArray(2)
If (EmptyVal = "none") Then EmptyVal = ""
If (FormVal = "") Then
FormVal = EmptyVal
Else
If (AltVal <> "") Then
FormVal = AltVal
ElseIf (Delim = "'") Then ' escape quotes
FormVal = "'" & Replace(FormVal,"'","''") & "'"
Else
FormVal = Delim + FormVal + Delim
End If
End If
If (i <> LBound(MM_fields)) Then
MM_tableValues = MM_tableValues & ","
MM_dbValues = MM_dbValues & ","
End if
MM_tableValues = MM_tableValues & MM_columns(i)
MM_dbValues = MM_dbValues & FormVal
Next
MM_editQuery = "insert into " & MM_editTable & " (" & MM_tableValues & ") values (" & MM_dbValues & ")"

If (Not MM_abortEdit) Then
' execute the insert
Set MM_editCmd = Server.CreateObject("ADODB.Command")
MM_editCmd.ActiveConnection = MM_editConnection
MM_editCmd.CommandText = MM_editQuery
MM_editCmd.Execute
MM_editCmd.ActiveConnection.Close

If (MM_editRedirectUrl <> "") Then
Response.Redirect(MM_editRedirectUrl)
End If
End If

End If
%>
<%
set RsUpload = Server.CreateObject("ADODB.Recordset")
RsUpload.ActiveConnection = MM_lynxVB_STRING
RsUpload.Source = "SELECT * FROM Images"
RsUpload.CursorType = 0
RsUpload.CursorLocation = 2
RsUpload.LockType = 3
RsUpload.Open()
RsUpload_numRows = 0
%>
<html>
<head>
<title>PureASPUpload</title>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<script language="JavaScript">
<!--

function getFileExtension(filePath) { //v1.0
fileName = ((filePath.indexOf('/') > -1) ? filePath.substring(filePath.lastIndexOf('/')+1,filePath.length) : filePath.substring(filePath.lastIndexOf('\\')+1,filePath.length));
return fileName.substring(fileName.lastIndexOf('.')+1,fileName.length);
}

function checkFileUpload(form,extensions) { //v1.0
document.MM_returnValue = true;
if (extensions && extensions != '') {
for (var i = 0; i<form.elements.length; i++) {
field = form.elements[i];
if (field.type.toUpperCase() != 'FILE') continue;
if (field.value == '') {
alert('File is required!');
document.MM_returnValue = false;field.focus();break;
}
if (extensions.toUpperCase().indexOf(getFileExtension(field.value).toUpperCase()) == -1) {
alert('This file is not allowed for uploading!');
document.MM_returnValue = false;field.focus();break;
} } }
}
//-->
</script>
</head>
<body bgcolor="#FFFFFF" text="#000000" leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<br>
<br>
<br>
<table width="400" border="0" cellspacing="0" cellpadding="0" align="center">
<tr>
<td>
<form name="fmupload" method="POST" action="<%=MM_editAction%>" enctype="multipart/form-data" onSubmit="checkFileUpload(this,'GIF,JPG,JPEG,BMP,PNG');return document.MM_returnValue">
<table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td> <input type="file" name="fmfile"> </td>
</tr>
<tr>
<td> <input type="submit" name="fmsubmit" value="Upload"> </td>
</tr>
</table>
<input type="hidden" name="MM_insert" value="fmupload">
</form>
</td>
</tr>
</table>
</body>
</html>
<%
RsUpload.Close()
%>

  • gorgi_19
  • Registratie: Mei 2002
  • Laatst online: 10-05 18:52

gorgi_19

Kruimeltjes zijn weer op :9

Zie P&W FAQ - Installatie c.q. SA vragen
P&W FAQ - De "quickstart" :) Ik gok dat weinig mensen 100+ regels code gaan doorpluizen, zonder enige vorm van opmaak, om te kijken wat je precies wilt. Sowieso is debuggen iets wat je zelf moet kunnen en geven we geen support op scripts van anderen. :)

Digitaal onderwijsmateriaal, leermateriaal voor hbo


Dit topic is gesloten.