PDA

Bekijk Volledige Versie : uploadsysteem bijna klaar...



mdekker
31/10/04, 13:26
Hoi Allemaal,

Ik zit met een klein probleem die ik zelf niet kan oplossen.

Ik heb een uploadscript en het gedeelte hieronder is het wat de file's upload(3 files upload ie):

<!--#include file="requestobjects.asp"-->

<%

Option Explicit

Response.Buffer = False

Server.ScriptTimeOut = 300

Dim oPseudoRequest, element, i, bTest

Set oPseudoRequest = new PseudoRequestDictionary

oPseudoRequest.ReadRequest()

oPseudoRequest.ReadQuerystring(Request.Querystring )

%>

<html>

<head>

<title>Demo and Instruction PseudoRequestDictionary Script Class</title>

</head>

<body bgcolor="#F6FFFF" link="green" vlink="green" alink="green">

<center><table width="80%"><tr><td>

<a href="default.asp"><b>back to index</b></a> | <a href="fileupload.asp"><b>back to form</b></a><br>

<center>

<h2>Demo and Instruction PseudoRequestDictionary Script Class</h2>

<h3>FileUpload Options</h3>

</center>

<p>

<table width="100%" border="1">

<tr>

<td colspan="2" nowrap bgcolor="yellow">

&lt;%<br>

Dim oPseudoRequest, element<br>

Set oPseudoRequest = new PseudoRequestDictionary<br>

oPseudoRequest.ReadRequest()<br>

oPseudoRequest.ReadQuerystring(Request.Querystring )<br>

%&gt;<br>

</td>

</tr>

<tr>

<td>oPseudoRequest</td>

<td><%=oPseudoRequest%></td>

</tr>

<tr>

<td>oPseudoRequest.Boundary</td>

<td><%=oPseudoRequest.Boundary%></td>

</tr>

<tr>

<td>oPseudoRequest.BinaryReadDone</td>

<td><%=oPseudoRequest.BinaryReadDone%></td>

</tr>

<tr>

<td>oPseudoRequest.TotalFormBytes</td>

<td><%=oPseudoRequest.TotalFormBytes%></td>

</tr>

<tr>

<td valign="top">oPseudoRequest.Count</td>

<td><%=oPseudoRequest.Count%></td>

</tr>

<tr>

<td valign="top">oPseudoRequest.ContainsFile</td>

<td><%=oPseudoRequest.ContainsFile%></td>

</tr>

<tr>

<td valign="top">oPseudoRequest.Files.Count</td>

<td><%=oPseudoRequest.Files.Count%></td>

</tr>

<tr>

<td valign="top">oPseudoRequest.Form("file_1").ContainsFile</td>

<td><%=oPseudoRequest.Form("file_1").ContainsFile%></td>

</tr>

<tr>

<td valign="top">looping through elements</td>

<td>

<%

For each element in oPseudoRequest.Keys

Response.write element & " = " & oPseudoRequest.Form(element) & "<br>"

Next

%>

</td>

</tr>

<%If oPseudoRequest.Form("file_1").Count <=1 Then %>

<tr>

<td valign="top">all properties from "file_1"</td>

<td>

<%

Response.write "complete path: " & oPseudoRequest.Form("file_1") & "<br>"

Response.write "filename: " & oPseudoRequest.Form("file_1").FileName & "<br>"

Response.write "filesize: " & oPseudoRequest.Form("file_1").FileSize & "<br>"

Response.write "contenttype: " & oPseudoRequest.Form("file_1").ContentType & "<br>"

%>

</td>

</tr>



<tr>

<td valign="top">oPseudoRequest.Form("file_1").SaveAs("c:\temp\" & oPseudoRequest.Form("file_1").FileName)</td>

<td>

<%

If oPseudoRequest.Form("file_1").ContainsFile Then

bTest = SaveFileAs(oPseudoRequest, "file_1", "c:\temp\")

If bTest Then

Response.write "saving of file succeeded"

Else

Response.write "an error occurred during saving of the file"

End If

Else

Response.write "field did not contain a file"

End If

%>

</td>

</tr>

<%Else%>

<tr>

<td valign="top">all properties from "file_1"</td>

<td>

<%

For i = 1 To oPseudoRequest.Form("file_1").Count

If oPseudoRequest.Form("file_1").IsFile(i) Then

Response.write "oPseudoRequest.Form(""file_1"")(" & i & ") is a fileupload-field:<br>"

Response.write "complete path: " & oPseudoRequest.Form("file_1").ValueNumber(i) & "<br>"

Response.write "filename: " & oPseudoRequest.Form("file_1").FileNameNumber(i) & "<br>"

Response.write "filesize: " & oPseudoRequest.Form("file_1").FileSizeNumber(i) & "<br>"

Response.write "contenttype: " & oPseudoRequest.Form("file_1").ContentTypeNumber(i) & "<br>"

Else

Response.write "oPseudoRequest.Form(""file_1"")(" & i & ") is a normal formfield:<br>"

Response.write "value: " & oPseudoRequest.Form("file_1").ValueNumber(i) & "<br>"

End If

Response.write "<br>"

Next

%>

</td>

</tr>



<tr>

<td valign="top">oPseudoRequest.Form("file_1").SaveAsNumber("c:\temp\" & oPseudoRequest.Form("file_1").FileNameNumber(i),i)</td>

<td>

<%

For i = 1 To oPseudoRequest.Form("file_1").Count

Response.write "processing oPseudoRequest(""file_1"")(" & i & ")<br>"

If oPseudoRequest.Form("file_1").ContainsFileNumber(i) Then

bTest = SaveFileAsWithNumber(oPseudoRequest, "file_1", "c:\temp\",i)

If bTest Then

Response.write "saving of file succeeded<br>"

Else

Response.write "an error occurred during saving of the file<br>"

End If

Else

Response.write "field did not contain a file<br>"

End If

Response.write "<br>"

Next

%>

</td>

</tr>





<%End If%>



<%If oPseudoRequest.Exists("file_2") Then %>

<tr>

<td valign="top">all properties from "file_2"</td>

<td>

<%

Response.write "complete path: " & oPseudoRequest.Form("file_2") & "<br>"

Response.write "filename: " & oPseudoRequest.Form("file_2").FileName & "<br>"

Response.write "filesize: " & oPseudoRequest.Form("file_2").FileSize & "<br>"

Response.write "contenttype: " & oPseudoRequest.Form("file_2").ContentType & "<br>"

%>

</td>

</tr>

<tr>

<td valign="top">oPseudoRequest.Form("file_2").SaveAs("c:\temp\" & oPseudoRequest.Form("file_2").FileName)</td>

<td>

<%

If oPseudoRequest.Form("file_2").ContainsFile Then

bTest = SaveFileAs(oPseudoRequest, "file_2", "c:\temp\")

If bTest Then

Response.write "saving of file succeeded"

Else

Response.write "an error occurred during saving of the file"

End If

Else

Response.write "field did not contain a file"

End If

%>

</td>

</tr>

<%End If%>

<%If oPseudoRequest.Exists("file_3") Then %>

<tr>

<td valign="top">all properties from "file_3"</td>

<td>

<%

Response.write "complete path: " & oPseudoRequest.Form("file_3") & "<br>"

Response.write "filename: " & oPseudoRequest.Form("file_3").FileName & "<br>"

Response.write "filesize: " & oPseudoRequest.Form("file_3").FileSize & "<br>"

Response.write "contenttype: " & oPseudoRequest.Form("file_3").ContentType & "<br>"

%>

</td>

</tr>

<tr>

<td valign="top">oPseudoRequest.Form("file_3").SaveAs("c:\temp\" & oPseudoRequest.Form("file_3").FileName)</td>

<td>

<%

If oPseudoRequest.Form("file_3").ContainsFile Then

bTest = SaveFileAs(oPseudoRequest, "file_3", "c:\temp\")

If bTest Then

Response.write "saving of file succeeded"

Else

Response.write "an error occurred during saving of the file"

End If

Else

Response.write "field did not contain a file"

End If

%>

</td>

</tr>

<%End If%>



</td></tr></table></center>

</body>

</html>

<%

Function SaveFileAs(oPseudoRequest, sItem, sSaveDirectory)

SaveFileAs = False

'On Error Resume Next

oPseudoRequest.Form(sItem).SaveAs(sSaveDirectory & oPseudoRequest.Form(sItem).FileName)

If Not Err Then SaveFileAs = True

End Function



Function SaveFileAsWithNumber(oPseudoRequest, sItem, sSaveDirectory, i)

SaveFileAsWithNumber = False

'On Error Resume Next

oPseudoRequest.Form(sItem).SaveAsNumber sSaveDirectory & oPseudoRequest.Form(sItem).FileNameNumber(i), i

If Not Err Then SaveFileAsWithNumber = True

End Function



Set oPseudoRequest = Nothing

%>

BEKIJK SCREENSHOT:
http://members.lycos.nl/fadeawaysite/upload/screenshot.jpg

Dit is een stukje screenshot van de pagina als ik geupload heb, dit staat op de zelfde pagina als de pagina die upload.

Nu heb ik stukjes gemarkeerd met rood. Die 3 namen moetten dan op worden geslagen in een access database.

Maar nu de vraag hoe? als je dit weet zou je me dit dan zo spoedig mogelijk willen laten weten?

Alvast bedankt,

Groeten, Melis Dekker

MediaServe
31/10/04, 14:19
In je script zie ik dit staan:
Response.write "filename: " & oPseudoRequest.Form("file_1").FileName & "<br>"Dat zal dus de filename zijn die je wilt opslaan. Dan kun je een database openen en de boel in opslaan.
Set dbConn = Server.CreateObject("ADODB.Connection")
sConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Server.MapPath("database.mdb") & ";" & _
"Persist Security Info=False"

dbConn.Open(sConnection)

SqlStrng = "INSERT INTO [Index] ([bestandsnaam]) " & _
VALUES ('" & oPseudoRequest.Form("file_1").FileName & "')"

SET rs = dbConn.Execute(SqlStrng)
dbConn.CloseZoiets moet denk ik wel lukken :)

mdekker
31/10/04, 17:40
ga het proberen, BEDANKT

mdekker
31/10/04, 18:28
kheb dit:


<%
Dim adoCon
Dim rsAddBericht
Dim strSQL

Set adoCon = Server.CreateObject("ADODB.Connection")
adoCon.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("db.mdb")

Set rsAddBericht = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM filenames;"

rsAddBericht.CursorType = 2
rsAddBericht.LockType = 3
rsAddBericht.Open strSQL, adoCon
rsAddBericht.AddNew

rsAddBericht.Fields("file_1") = oPseudoRequest.Form("file_1").FileName
rsAddBericht.Fields("file_2") = oPseudoRequest.Form("file_2").FileName
rsAddBericht.Fields("file_3") = oPseudoRequest.Form("file_3").FileName

rsAddBericht.Update

rsAddBericht.Close
Set rsAddBericht = Nothing
Set adoCon = Nothing

server.transfer "toevoegen.html"

%>

er nu onder staan maar dan krijg ik OBJECT VEREIST

The MAzTER
31/10/04, 18:44
Je bent onderstaande regels vergeten


Set oPseudoRequest = new PseudoRequestDictionary
oPseudoRequest.ReadRequest()


niet zeker of dit 100% goed is, is 2 jaar geleden dat ik me laatste opdracht in ASP had ;)

mdekker
31/10/04, 19:45
ik krijg nu de volgende fout:

Runtimefout Microsoft VBScript error '800a0005'

Ongeldige procedure-aanroep of ongeldig argument: 'MidB'

/systeem/b/requestobjects.asp, line 111

The MAzTER
31/10/04, 20:04
dan staat er nog wat fout in requestobjects.asp ;)

daar heb je hier de code niet van neer gezet

post hier is de totale code (gebruik code tags!!) of voeg het toe als bijlage (dus bijde bestanden)

mdekker
31/10/04, 20:15
BESTAND: UploadAction.asp:


<!--#include file="requestobjects.asp"-->
<%
Option Explicit
Response.Buffer = False
Server.ScriptTimeOut = 300

Dim oPseudoRequest, element, i, bTest

Set oPseudoRequest = new PseudoRequestDictionary
oPseudoRequest.ReadRequest()
oPseudoRequest.ReadQuerystring(Request.Querystring )
%>

<html>
<head>
<title>Demo and Instruction PseudoRequestDictionary Script Class</title>
</head>
<body bgcolor="#F6FFFF" link="green" vlink="green" alink="green">
<center><table width="80%"><tr><td>
<a href="default.asp"><b>back to index</b></a> | <a href="fileupload.asp"><b>back to form</b></a><br>

<center>
<h2>Demo and Instruction PseudoRequestDictionary Script Class</h2>
<h3>FileUpload Options</h3>
</center>
<p>
<table width="100%" border="1">
<tr>
<td colspan="2" nowrap bgcolor="yellow">
&lt;%<br>
Dim oPseudoRequest, element<br>
Set oPseudoRequest = new PseudoRequestDictionary<br>
oPseudoRequest.ReadRequest()<br>
oPseudoRequest.ReadQuerystring(Request.Querystring )<br>
%&gt;<br>
</td>
</tr>
<tr>
<td>oPseudoRequest</td>
<td><%=oPseudoRequest%></td>
</tr>
<tr>
<td>oPseudoRequest.Boundary</td>
<td><%=oPseudoRequest.Boundary%></td>
</tr>
<tr>
<td>oPseudoRequest.BinaryReadDone</td>
<td><%=oPseudoRequest.BinaryReadDone%></td>
</tr>
<tr>
<td>oPseudoRequest.TotalFormBytes</td>
<td><%=oPseudoRequest.TotalFormBytes%></td>
</tr>
<tr>
<td valign="top">oPseudoRequest.Count</td>
<td><%=oPseudoRequest.Count%></td>
</tr>
<tr>
<td valign="top">oPseudoRequest.ContainsFile</td>
<td><%=oPseudoRequest.ContainsFile%></td>
</tr>
<tr>
<td valign="top">oPseudoRequest.Files.Count</td>
<td><%=oPseudoRequest.Files.Count%></td>
</tr>
<tr>
<td valign="top">oPseudoRequest.Form("file_1").ContainsFile</td>
<td><%=oPseudoRequest.Form("file_1").ContainsFile%></td>
</tr>
<tr>
<td valign="top">looping through elements</td>
<td>
<%
For each element in oPseudoRequest.Keys
Response.write element & " = " & oPseudoRequest.Form(element) & "<br>"
Next
%>
</td>
</tr>

<%If oPseudoRequest.Form("file_1").Count <=1 Then %>

<tr>
<td valign="top">all properties from "file_1"</td>
<td>
<%
Response.write "complete path: " & oPseudoRequest.Form("file_1") & "<br>"
Response.write "filename: " & oPseudoRequest.Form("file_1").FileName & "<br>"
Response.write "filesize: " & oPseudoRequest.Form("file_1").FileSize & "<br>"
Response.write "contenttype: " & oPseudoRequest.Form("file_1").ContentType & "<br>"
%>
</td>
</tr>


<tr>
<td valign="top">oPseudoRequest.Form("file_1").SaveAs("c:\temp\" & oPseudoRequest.Form("file_1").FileName)</td>
<td>
<%
If oPseudoRequest.Form("file_1").ContainsFile Then
bTest = SaveFileAs(oPseudoRequest, "file_1", "c:\temp\")
If bTest Then
Response.write "saving of file succeeded"
Else
Response.write "an error occurred during saving of the file"
End If
Else
Response.write "field did not contain a file"
End If
%>
</td>
</tr>
<%Else%>

<tr>
<td valign="top">all properties from "file_1"</td>
<td>
<%
For i = 1 To oPseudoRequest.Form("file_1").Count
If oPseudoRequest.Form("file_1").IsFile(i) Then
Response.write "oPseudoRequest.Form(""file_1"")(" & i & ") is a fileupload-field:<br>"
Response.write "complete path: " & oPseudoRequest.Form("file_1").ValueNumber(i) & "<br>"
Response.write "filename: " & oPseudoRequest.Form("file_1").FileNameNumber(i) & "<br>"
Response.write "filesize: " & oPseudoRequest.Form("file_1").FileSizeNumber(i) & "<br>"
Response.write "contenttype: " & oPseudoRequest.Form("file_1").ContentTypeNumber(i) & "<br>"
Else
Response.write "oPseudoRequest.Form(""file_1"")(" & i & ") is a normal formfield:<br>"
Response.write "value: " & oPseudoRequest.Form("file_1").ValueNumber(i) & "<br>"
End If
Response.write "<br>"
Next
%>
</td>
</tr>


<tr>
<td valign="top">oPseudoRequest.Form("file_1").SaveAsNumber("c:\temp\" & oPseudoRequest.Form("file_1").FileNameNumber(i),i)</td>
<td>
<%
For i = 1 To oPseudoRequest.Form("file_1").Count
Response.write "processing oPseudoRequest(""file_1"")(" & i & ")<br>"
If oPseudoRequest.Form("file_1").ContainsFileNumber(i) Then
bTest = SaveFileAsWithNumber(oPseudoRequest, "file_1", "c:\temp\",i)
If bTest Then
Response.write "saving of file succeeded<br>"
Else
Response.write "an error occurred during saving of the file<br>"
End If
Else
Response.write "field did not contain a file<br>"
End If
Response.write "<br>"
Next
%>
</td>
</tr>



<%End If%>


<%If oPseudoRequest.Exists("file_2") Then %>
<tr>
<td valign="top">all properties from "file_2"</td>
<td>
<%
Response.write "complete path: " & oPseudoRequest.Form("file_2") & "<br>"
Response.write "filename: " & oPseudoRequest.Form("file_2").FileName & "<br>"
Response.write "filesize: " & oPseudoRequest.Form("file_2").FileSize & "<br>"
Response.write "contenttype: " & oPseudoRequest.Form("file_2").ContentType & "<br>"
%>
</td>
</tr>
<tr>
<td valign="top">oPseudoRequest.Form("file_2").SaveAs("c:\temp\" & oPseudoRequest.Form("file_2").FileName)</td>
<td>
<%
If oPseudoRequest.Form("file_2").ContainsFile Then
bTest = SaveFileAs(oPseudoRequest, "file_2", "c:\temp\")
If bTest Then
Response.write "saving of file succeeded"
Else
Response.write "an error occurred during saving of the file"
End If
Else
Response.write "field did not contain a file"
End If
%>
</td>
</tr>
<%End If%>

<%If oPseudoRequest.Exists("file_3") Then %>
<tr>
<td valign="top">all properties from "file_3"</td>
<td>
<%
Response.write "complete path: " & oPseudoRequest.Form("file_3") & "<br>"
Response.write "filename: " & oPseudoRequest.Form("file_3").FileName & "<br>"
Response.write "filesize: " & oPseudoRequest.Form("file_3").FileSize & "<br>"
Response.write "contenttype: " & oPseudoRequest.Form("file_3").ContentType & "<br>"
%>
</td>
</tr>
<tr>
<td valign="top">oPseudoRequest.Form("file_3").SaveAs("c:\temp\" & oPseudoRequest.Form("file_3").FileName)</td>
<td>
<%
If oPseudoRequest.Form("file_3").ContainsFile Then
bTest = SaveFileAs(oPseudoRequest, "file_3", "c:\temp\")
If bTest Then
Response.write "saving of file succeeded"
Else
Response.write "an error occurred during saving of the file"
End If
Else
Response.write "field did not contain a file"
End If
%>
</td>
</tr>
<%End If%>


</td></tr></table></center>
</body>
</html>

<%
Function SaveFileAs(oPseudoRequest, sItem, sSaveDirectory)
SaveFileAs = False
'On Error Resume Next
oPseudoRequest.Form(sItem).SaveAs(sSaveDirectory & oPseudoRequest.Form(sItem).FileName)
If Not Err Then SaveFileAs = True
End Function


Function SaveFileAsWithNumber(oPseudoRequest, sItem, sSaveDirectory, i)
SaveFileAsWithNumber = False
'On Error Resume Next
oPseudoRequest.Form(sItem).SaveAsNumber sSaveDirectory & oPseudoRequest.Form(sItem).FileNameNumber(i), i
If Not Err Then SaveFileAsWithNumber = True
End Function


Set oPseudoRequest = Nothing
%>
<%
Dim adoCon
Dim rsAddBericht
Dim strSQL

Set adoCon = Server.CreateObject("ADODB.Connection")
adoCon.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("db.mdb")

Set rsAddBericht = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM filenames;"

Set oPseudoRequest = new PseudoRequestDictionary
oPseudoRequest.ReadRequest()

rsAddBericht.CursorType = 2
rsAddBericht.LockType = 3
rsAddBericht.Open strSQL, adoCon
rsAddBericht.AddNew

rsAddBericht.Fields("file_1") = oPseudoRequest.Form("file_1").FileName
rsAddBericht.Fields("file_2") = oPseudoRequest.Form("file_2").FileName
rsAddBericht.Fields("file_3") = oPseudoRequest.Form("file_3").FileName

rsAddBericht.Update

rsAddBericht.Close
Set rsAddBericht = Nothing
Set adoCon = Nothing

server.transfer "toevoegen.html"

%>


Bestand: RequestObjects.asp


<SCRIPT LANGUAGE="VBScript" RUNAT="SERVER">
' ================================================== ==========
' version 1.5.00.00
'
' (c) Sybe Visser, October 2001 - June 2004
' ================================================== ==========
' thanks to:
' Antonin Foller, for providing the ADODB.Recordset Byte2String and String2Byte conversions (http://www.pstruh.cz)
' Faisal Khan, for creating the Loader VBScript Class, that inspired me (http://www.stardeveloper.com)
' ================================================== ==========

Class PseudoRequestDictionary
Private oDic, bBinaryReadDone, dtStartTime, oEmptyPseudoStringList, oFiles
Private iTotalFormBytes, sBoundary, bt13, bt34, btFileName, sEncoding, btBinaryRequest, bMultipartFormdataBoundaryBug

Private Sub Class_Initialize
bMultipartFormdataBoundaryBug = False
Set oDic = Server.CreateObject("Scripting.Dictionary")
bBinaryReadDone = False
dtStartTime = Timer
iTotalFormBytes = 0
Set oEmptyPseudoStringList = new PseudoStringList
Set oFiles = new PseudoStringList
bt13 = ChrB(13)
bt34 = ChrB(34)
btFileName = ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61) & ChrB(34)
End Sub

Private Sub Class_Terminate
RemoveAll
Set oDic = Nothing
Set oEmptyPseudoStringList = Nothing
Set oFiles = Nothing
btBinaryRequest = Null
End Sub

Private Function Byte2String(s)
Byte2String = oEmptyPseudoStringList.Byte2String(s)
End Function

Private Function RSBinaryToString(ByVal btBinary)
Dim oRS, iLen
Set oRS = Server.CreateObject("ADODB.Recordset")
iLen = LenB(btBinary)

If iLen > 0 Then
oRS.Fields.Append "mBinary", 201, iLen
oRS.Open
oRS.AddNew
oRS("mBinary").AppendChunk btBinary
oRS.Update
RSBinaryToString = oRS("mBinary").Value
oRS.Close
Else
RSBinaryToString = ""
End If
Set oRS = Nothing
End Function

Private Sub AddFile(ByVal sKey, ByVal btValue)
Dim oFileLoader, element, i

sKey = LCase(sKey)
If oDic.Exists(sKey) Then
oDic.Item(sKey).AddRaw btValue
Else
Set oFileLoader = new PseudoStringList
Set oDic.Item(sKey) = oFileLoader
oFileLoader.AddRaw btValue
Set oFileLoader = Nothing
End If
End Sub

Private Function TimeDiff(dtLast, dtFirst)
Dim iReturn
iReturn = dtLast - dtFirst
If iReturn < 0 Then iReturn = dtLast - dtFirst + (60*60*24)
TimeDiff = 1000 * iReturn
End Function

Public Sub ReadQuerystring(ByVal s)
Dim aSplit, element, aSplitElement
aSplit = Split(Cstr("" & s),"&")
For each element in aSplit
aSplitElement = Split(element,"=")
Add aSplitElement(LBound(aSplitElement)), aSplitElement(UBound(aSplitElement))
Next
End Sub

Public Sub ReadRequest()
Dim sRequestContentType, aRequestContentType
Dim aSplit, aSplitElement, element, sRequestMethod, sFormValues, aFormValues
Dim i, j, iStartPos, iEndPos, btFormField, btBoundary
Dim sKey, sValue, bFile
Dim iFirstQuotePos, iSecondQuote

sRequestContentType = Cstr(" " & Request.ServerVariables("HTTP_CONTENT_TYPE"))
aRequestContentType = Split(sRequestContentType, ";")
sEncoding = Trim(aRequestContentType(LBound(aRequestContentTyp e)))
iTotalFormBytes = Request.TotalBytes

Select Case LCase(sEncoding)

Case "multipart/form-data"
sBoundary = Trim(aRequestContentType(UBound(aRequestContentTyp e)))
sBoundary = Right(sBoundary,Len(sBoundary)-9)
btBinaryRequest = Request.BinaryRead(Request.TotalBytes)

iStartPos = 1
iEndPos = InstrB(1,btBinaryRequest,bt13)
btBoundary = MidB(btBinaryRequest,1,iEndPos-1)
If Byte2String(btBoundary) <> "--" &sBoundary Then bMultipartFormdataBoundaryBug = True

iStartPos = iEndPos+2
iEndPos = InstrB(iStartPos, btBinaryRequest, btBoundary)

Do While iEndPos > 0
bFile = False
btFormField = MidB(btBinaryRequest,iStartPos,iEndPos-iStartPos-2)
iFirstQuotePos = InstrB(btFormField, bt34)
iSecondQuote = InstrB(iFirstQuotePos+1,btFormField, bt34)
sKey = LCase(Byte2String(MidB(btFormField,iFirstQuotePos+ 1,iSecondQuote-iFirstQuotePos-1)))
If InstrB(btFormField, btFileName) = iSecondQuote + 3 Then bFile = True

If bFile Then
AddFile sKey, btFormField
If Item(sKey).ContainsFileNumber(Item(sKey).Count) Then oFiles.AddFile(Item(sKey).ItemNumber(Item(sKey).Co unt))
Else
sValue = Byte2String(RightB(btFormField, LenB(btFormField)-iSecondQuote-4))
Add sKey, Escape(sValue)
End If

iStartPos = iEndPos+2+LenB(btBoundary)
iEndPos = InstrB(iStartPos, btBinaryRequest, btBoundary)
Loop
bBinaryReadDone = True
'btBinaryRequest = Null

Case "application/x-www-form-urlencoded"
sRequestMethod = Request.ServerVariables("REQUEST_METHOD")
If LCase(sRequestMethod) = "get" Then
sFormValues = Request.Querystring
ElseIf LCase(sRequestMethod) = "post" Then
If Request.TotalBytes > 80000 Then
' a very large form which can not be handled by normal request, the size is a bit arbitrary
btBinaryRequest = Request.BinaryRead(iTotalFormBytes)
bBinaryReadDone = True
sFormValues = RSBinaryToString(btBinaryRequest)
Else
sFormValues = Request.Form
End If
End If
aSplit = Split(sFormValues,"&")
For each element in aSplit
aSplitElement = Split(element,"=")
Add aSplitElement(LBound(aSplitElement)), aSplitElement(UBound(aSplitElement))
Next
sFormValues = Null

Case "text/plain"
' missing "&" to seperate values, not urlencoded, usually used for sending mail directly
' not really relevant, but i will work it out some day

End Select
End Sub

Public Sub Add(ByVal sKey, sValue)
Dim oStringList
sKey = LCase(sKey)

If oDic.Exists(sKey) Then
oDic.Item(sKey).Add sValue
Else
Set oDic.Item(sKey) = new PseudoStringList
oDic.Item(sKey).Add sValue
End If
End Sub

Public Sub ReplaceItem(ByVal sKey, sValue)
sKey = LCase(sKey)
Remove(sKey)
Set oDic.Item(sKey) = new PseudoStringList
oDic.Item(sKey).Add sValue
End Sub

Public Sub Remove(sKey)
oDic(Lcase(skey)).Destroy
oDic.Remove sKey
End Sub

Public Sub RemoveAll()
Dim element
For each element in oDic
oDic(element).Destroy
Next
oDic.RemoveAll
End Sub

Public Sub SaveAllFiles(ByVal sDirectory)
Dim element, i
If Not ExistDirectory(sDirectory) Then
Err.Raise 9999, "PseudoRequestDictionary.SaveAllFiles", "The folder does not exist."
Exit Sub
End If
sDirectory = Replace(sDirectory & "\","\\","\")
For i = 1 To oFiles.Count
oFiles.SaveAsNumber sDirectory & oFiles.FileNameNumber(i),i
Next
End Sub

Public Property Get Exists(sKey)
Exists = oDic.Exists(LCase(sKey))
End Property

Public Property Get Count
Count = oDic.Count
End Property

Public Property Get BinaryReadDone
BinaryReadDone = bBinaryReadDone
End Property

Public Property Get Keys
Keys = oDic.Keys
End Property

Public Property Get Version
Version = "1.5.00.00"
End Property

Public Property Get ContainsFile
ContainsFile = CBool(Files.Count > 0)
End Property

Public Property Get TotalFormBytes
TotalFormBytes = iTotalFormBytes
End Property

Public Property Get Item(ByVal sKey)
sKey = LCase(sKey)
If oDic.Exists(sKey) Then
Set Item = oDic.Item(sKey)
Else
Set Item = oEmptyPseudoStringList
End If
End Property

Public Property Get Form(ByVal sKey)
Set Form = Item(sKey)
End Property

Public Property Get ItemCount(ByVal sKey)
sKey = LCase(sKey)
ItemCount = 0
If oDic.Exists(sKey) Then ItemCount = oDic.Item(sKey).Count
End Property

Public Default Function Value()
Dim element, aElements, i, j, aSubelements
ReDim aElements(oDic.Count - 1)
i = 0
For each element in oDic.Keys
ReDim aSubelements(oDic(element).Count - 1)
For j = 1 to oDic(element).Count
aSubelements(j-1) = element & "=" & oDic(element).RawItem(j)
Next
aElements(i) = Join(aSubelements,"&")
i = i + 1
Next
Value = Join(aElements,"&")
End Function

Public Property Get ExistenceTime
ExistenceTime = Cstr("" & TimeDiff(Timer, dtStartTime)) & " ms"
End Property

Public Property Get Boundary
Boundary = sBoundary
End Property

Public Property Get Encoding
Encoding = sEncoding
End Property

Public Property Get BinaryRequest
BinaryRequest = btBinaryRequest
End Property

Private Function ExistDirectory(ByVal sDirName)
Dim oFS
Set oFS = Server.Createobject("Scripting.FileSystemObject")
ExistDirectory = oFS.FolderExists(sDirName)
Set oFS = Nothing
End Function

Public Property Get MultipartFormdataBoundaryBug
MultipartFormdataBoundaryBug = bMultipartFormdataBoundaryBug
End Property

Public Property Get Files
Set Files = oFiles
End Property


End Class




Class PseudoStringList
Private aList, bt34, bt13, btContentType

Private Sub Class_Initialize
aList = Array()
bt34 = ChrB(34)
bt13 = ChrB(13)
btContentType = ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)
End Sub

Private Sub Class_Terminate
Destroy
End Sub

Public Sub Destroy()
Dim element
For each element in aList
If TypeName(element) = "Dictionary" Then
element.RemoveAll
Set element = Nothing
End If
Next
Erase aList
End Sub

Public Sub Add(ByVal sString)
ReDim Preserve aList(Ubound(aList)+1)
aList(Ubound(aList)) = Cstr("" & sString)
End Sub

Public Property Get Count
Count = UBound(aList) + 1
End Property

Public Property Get Keys
Dim aReturn, oDic, i
If UBound(aList) => 0 Then
ReDim aReturn(Ubound(aList))
For i = 0 To Ubound(aList)
If IsObject(aList(i)) Then
aReturn(i) = aList(i)("filenamecomplete")
Else
aReturn(i) = URLDecode(aList(i))
End If
Next
Keys = aReturn
Else
Keys = aList
End If
End Property

Public Default Property Get Value
Dim element, aElements, i
Value = null
If Ubound(aList) >= 0 Then
Value = ""
ReDim aElements(Ubound(aList))
For i = Lbound(aList) To UBound(aList)
If IsObject(aList(i)) Then
aElements(i) = aList(i).Item("filenamecomplete")
Else
aElements(i) = URLDecode(aList(i))
End If
Next
Value = Join(aElements,", ")
End If
End Property

Public Property Get RawItem(i)
If i > Ubound(aList)+1 Then Exit Property
If IsObject(aList(i-1)) Then
RawItem = Server.URLEncode(aList(i-1)("filenamecomplete"))
Else
RawItem = aList(i-1)
End If
End Property

Public Property Get Version
Version = "1.5.00.00"
End Property

Public Property Get ContainsFile
Dim i
ContainsFile = False
For i = 0 To Ubound(aList)
If TypeName(aList(i)) = "Dictionary" Then
If aList(i)("filesize") > 0 Then
ContainsFile = True
Exit For
End If
End If
Next
End Property

Public Property Get Item
If TypeName(aList(0)) = "Dictionary" Then
Set Item = aList(0)
Else
Item = URLDecode(aList(0))
End If
End Property

Public Sub AddFile(ByVal oDic)
ReDim Preserve aList(Ubound(aList)+1)
Set aList(Ubound(aList)) = oDic
End Sub

Public Sub AddRaw(ByVal btValue)
Dim oDic, bFile, sFileName, sContentType
Dim iFirstFoundPos, iSecondFoundPos

Set oDic = Server.CreateObject("Scripting.Dictionary")
iFirstFoundPos = InstrB(btValue, bt34)
iSecondFoundPos = InstrB(iFirstFoundPos+1,btValue, bt34)

iFirstFoundPos = InstrB(iSecondFoundPos+1,btValue, bt34)
iSecondFoundPos = InstrB(iFirstFoundPos+1,btValue, bt34)

If iSecondFoundPos > iFirstFoundPos + 1 Then bFile = True

If bFile Then
sFileName = Byte2String(MidB(btValue,iFirstFoundPos+1,iSecondF oundPos-iFirstFoundPos-1))
oDic.Item("filenamecomplete") = sFileName
' it is not sure if the file comes from Unix or Windows ("/" or "\"), don't know about Mac
If Instr(sFileName,"\") > 0 Then ' suppose it is windows
oDic.Item("filename") = Mid(sFileName, 1 + InStrRev(sFileName, "\"))
oDic.Item("filepath") = Mid(sFileName, 1, InStrRev(sFileName, "\"))
ElseIf Instr(sFileName,"/") > 0 Then
oDic.Item("filename") = Mid(sFileName, 1 + InStrRev(sFileName, "/"))
oDic.Item("filepath") = Mid(sFileName, 1, InStrRev(sFileName, "/"))
Else
' some browsers (Mozilla engine) do not have complete path
oDic.Item("filename") = sFileName
oDic.Item("filepath") = ""
End If

iFirstFoundPos = InstrB(iSecondFoundPos,btValue,btContentType)
iSecondFoundPos = InstrB(iFirstFoundPos,btValue,bt13)
sContentType = Byte2String(MidB(btValue,iFirstFoundPos+14,iSecond FoundPos-iFirstFoundPos-14))
oDic("contenttype") = sContentType

iFirstFoundPos = iSecondFoundPos+3
oDic("binary") = RightB(btValue,LenB(btValue)-iFirstFoundPos)
oDic("filesize") = LenB(oDic("binary"))
If oDic("filesize") > 0 Then
oDic("binary") = RSString2Byte(oDic("binary"))
Else
oDic("binary") = Null
End If

AddFile(oDic)
Else
oDic.Item("filenamecomplete")= ""
oDic.Item("filename")= ""
oDic.Item("filepath")= ""
oDic.Item("contenttype")= ""
oDic("binary") = Null
oDic("filesize") = 0
AddFile(oDic)
End If

End Sub

Public Property Get FileName
If Ubound(aList) = -1 Then FileName = "": Exit Property
If TypeName(aList(0)) = "Dictionary" Then FileName = aList(0)("filename")
End Property

Public Property Get FileSize
If Ubound(aList) = -1 Then FileSize = 0: Exit Property
If TypeName(aList(0)) = "Dictionary" Then FileSize = aList(0)("filesize")
End Property

Public Property Get ContentType
If Ubound(aList) = -1 Then ContentType = "": Exit Property
If TypeName(aList(0)) = "Dictionary" Then ContentType = aList(0)("contenttype")
End Property

Public Property Get Binary
If Ubound(aList) = -1 Then Binary = Null: Exit Property
If TypeName(aList(0)) = "Dictionary" Then Binary = aList(0)("binary")
End Property

Public Property Get IsFile(i)
IsFile = False
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then IsFile = True
End Property

Public Property Get BinaryNumber(i)
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then
BinaryNumber = aList(i-1)("binary")
End If
End Property

Public Property Get ItemNumber(i)
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then
Set ItemNumber = aList(i-1)
Else
ItemNumber = aList(i-1)
End If
End Property

Public Property Get ValueNumber(i)
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then
ValueNumber = aList(i-1)("filenamecomplete")
Else
ValueNumber = URLDecode(aList(i-1))
End If
End Property

Public Sub SaveAs(ByVal sFilePath)
If Not IsNull(Binary) Then WriteBinaryFile sFilePath, Binary
End Sub

Public Property Get FileNameNumber(i)
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then
FileNameNumber = aList(i-1)("filename")
Else
FileNameNumber = ""
End If
End Property

Public Property Get FileSizeNumber(i)
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then
FileSizeNumber = aList(i-1)("filesize")
Else
FileSizeNumber = 0
End If
End Property

Public Property Get ContentTypeNumber(i)
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then
ContentTypeNumber = aList(i-1)("contenttype")
Else
ContentTypeNumber = ""
End If
End Property

Public Property Get ContainsFileNumber(i)
ContainsFileNumber = False
If i > Ubound(aList)+1 Then Exit Property
If TypeName(aList(i-1)) = "Dictionary" Then
If aList(i-1)("filesize") > 0 Then ContainsFileNumber = True
End If
End Property

Public Sub SaveAsNumber(sFilePath,i)
If ContainsFileNumber(i) Then WriteBinaryFile sFilePath, aList(i-1)("binary")
End Sub

Private Function URLDecode(ByVal v)
URLDecode = Replace(v,"+"," ")
URLDecode = Unescape(URLDecode)
End Function

Public Function Byte2String(s)
Dim i
For i = 1 to LenB(s)
Byte2String = Byte2String & CHR(AscB(MidB(s,i,1)))
Next
End Function

Private Function RSString2Byte(ByVal s)
Dim iLenString, oRS
Set oRS = Server.CreateObject("ADODB.Recordset")
iLenString = LenB(s)
If iLenString > 0 Then
oRS.Fields.Append "mBinary", 205, iLenString
oRS.Open
oRS.AddNew
oRS("mBinary").AppendChunk s & ChrB(0)
oRS.Update
RSString2Byte = oRS("mBinary").GetChunk(iLenString)
oRS.Close
End If
Set oRS = Nothing
End Function

Private Sub WriteBinaryFile(sFilePath, ByVal sStream)
Dim oStream
Set oStream = Server.CreateObject("ADODB.Stream")
oStream.Type = 1
oStream.Open
oStream.Write sStream
oStream.SaveToFile sFilePath, 2
oStream.Close
Set oStream = Nothing
End Sub

End Class


</SCRIPT>




Bedankt voor de moeite.

mdekker
01/11/04, 16:00
DUS WEET IEMAND IETS??

MediaServe
01/11/04, 17:42
Origineel geplaatst door mdekker
DUS WEET IEMAND IETS?? Je hoeft niet te schreeuwen hoor ;) (allemaal hoofdletters)
Vergeet niet dat dit een webhosting forum is! We willen best helpen, maar het stikt hier niet van de ASP programmeurs. Bovendien plak je hier een flink stuk code, dat kost veel tijd om door te spitten naar fouten. Je kunt beter het/de ASP bestand(en) meesturen in een ZIP bestandje.

mdekker
02/11/04, 21:01
Runtimefout Microsoft VBScript error '800a0005'

Ongeldige procedure-aanroep of ongeldig argument: 'MidB'

/systeem/b/requestobjects.asp, line 111

is de huidige error die ik krijg.

Ik heb het geziped toegevoegd.

Bedankt.

mdekker
04/11/04, 17:22
Ik heb Zelf nog weer wat geprobeerd... maar het wil echt niet lukken :(

mdekker
07/11/04, 18:25
Snapt iemand wat de fout is?

mdekker
12/11/04, 19:16
Hoe kan ik iets nog anders aaroepen als doormiddel van MidB??

Groeten,,,,