ASP File Upload FileSystemObject Permission Denied

/// FILESYSTEMOBJECT CODE ///
 
<%
Dim uploadsDirRemote, uploadsDirLocal, filename
uploadsDirLocal = Server.MapPath("\") & "\Public\doc_transfer\"
If request.querystring("interface") = "Event" Then
uploadsDirRemote = Server.MapPath("/Remote/public_files/") & "\DeptStorage\Files\" & request.querystring("id") & "\"
End If
filename = request.querystring("filename")
 
response.write uploadsDirRemote
 
    '### CREATE REMOTE STORAGE FOLDER ###
    Set fs = Server.CreateObject("Scripting.FileSystemObject")
    If fs.FolderExists(uploadsDirRemote) = true then
    'Folder already exists, do not create folder
    Else
    fs.createfolder(uploadsDirRemote) 
    End If
    '### TRANSFER TEMP FILE TO REMOTE STORAGE ###
    Set f = fs.GetFile(uploadsDirLocal & filename)
    f.Copy uploadsDirRemote & "\" & filename,true
    Set f = Nothing
    '### DELETE TEMP FILE ###
    fs.CreateTextFile uploadsDirLocal & filename,True
    If fs.FileExists(uploadsDirLocal & filename) then
    fs.DeleteFile(uploadsDirLocal & filename)
    End If
    Set fs = Nothing
Response.Write("<SCRIPT>window.close()</SCRIPT>")
%>
 
 
/// FREEASPUPLOAD CODE ///
 
<%@ Language=VBScript %>
<% 
option explicit 
Response.Expires = -1
Server.ScriptTimeout = 600
%>
<!-- #include file="..\database_connect\mssql_connect.asp" -->
 
<%
Class FreeASPUpload
	Public UploadedFiles
	Public FormElements
 
	Private VarArrayBinRequest
	Private StreamRequest
	Private uploadedYet
 
	Private Sub Class_Initialize()
		Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")
		Set FormElements = Server.CreateObject("Scripting.Dictionary")
		Set StreamRequest = Server.CreateObject("ADODB.Stream")
		StreamRequest.Type = 1 'adTypeBinary
		StreamRequest.Open
		uploadedYet = false
	End Sub
	
	Private Sub Class_Terminate()
		If IsObject(UploadedFiles) Then
			UploadedFiles.RemoveAll()
			Set UploadedFiles = Nothing
		End If
		If IsObject(FormElements) Then
			FormElements.RemoveAll()
			Set FormElements = Nothing
		End If
		StreamRequest.Close
		Set StreamRequest = Nothing
	End Sub
 
	Public Property Get Form(sIndex)
		Form = ""
		If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))
	End Property
 
	Public Property Get Files()
		Files = UploadedFiles.Items
	End Property
 
	'Calls Upload to extract the data from the binary request and then saves the uploaded files
 
' ///// START OF CUSTOM CODE /////
 
	Public Function FilesSave(path, linkid, interface)
		Dim streamFile, fileItem, SQL, record_check, rs, total, rs1, SQL1, doctitle
 
		doctitle = Request.QueryString("title")
 
		if Right(path, 1) <> "\" then path = path & "\"
 
		if not uploadedYet then Upload
 
		For Each fileItem In UploadedFiles.Items
			Set streamFile = Server.CreateObject("ADODB.Stream")
			streamFile.Type = 1
			streamFile.Open
			StreamRequest.Position=fileItem.Start
			StreamRequest.CopyTo streamFile, fileItem.Length
			streamFile.SaveToFile path & fileItem.FileName, 2
			streamFile.close
			Set streamFile = Nothing
			Response.Write "<SCRIPT type='text/javascript'>self.setTimeout('window.open(\'../Modules/upload_sub.asp?id=" & linkid & "&interface=" & interface & "&filename=" & fileItem.FileName & "&title=" & doctitle & "&size=" & fileItem.Length & "\');$(\'#uploading\').hide();$(\'#fileresults\').show();', 10000)</SCRIPT>"
'Response.Redirect "../Modules/upload_sub.asp?id=" & linkid & "&interface=" & interface & "&filename=" & fileItem.FileName & "&title=" & doctitle & "&size=" & fileItem.Length
			response.write "<span id=fileresults><br><B>File uploaded successfully!</B><br><br><br><table><tr><td><u>File Details</u><br>"
			response.write "File Title: " & doctitle & "<br>File Name: " & fileItem.FileName & " <br>File Size: " & fileItem.Length & " Bytes</td></tr></table></span>"
		 Next
	End Function
 
' ///// END OF CUSTOM CODE /////
 
	Public Function SaveBinRequest(path) ' For debugging purposes
		StreamRequest.SaveToFile path & "\debugStream.bin", 2
	End Function
 
	Public Sub DumpData() 'only works if files are plain text
		Dim i, aKeys, f
		response.write "Form Items:<br>"
		aKeys = FormElements.Keys
		For i = 0 To FormElements.Count -1 ' Iterate the array
			response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"
		Next
		response.write "Uploaded Files:<br>"
		For Each f In UploadedFiles.Items
			response.write "Name: " & f.FileName & "<br>"
			response.write "Type: " & f.ContentType & "<br>"
			response.write "Start: " & f.Start & "<br>"
			response.write "Size: " & f.Length & "<br>"
		 Next
   	End Sub
 
	Private Sub Upload()
		Dim nCurPos, nDataBoundPos, nLastSepPos
		Dim nPosFile, nPosBound
		Dim sFieldName, osPathSep, auxStr
 
		'RFC1867 Tokens
		Dim vDataSep
		Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
		tNewLine = Byte2String(Chr(13))
		tDoubleQuotes = Byte2String(Chr(34))
		tTerm = Byte2String("--")
		tFilename = Byte2String("filename=""")
		tName = Byte2String("name=""")
		tContentDisp = Byte2String("Content-Disposition")
		tContentType = Byte2String("Content-Type:")
 
		uploadedYet = true
 
		on error resume next
		VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)
		if Err.Number <> 0 then 
			response.write "<br><br><B>System reported this error:</B><p>"
			response.write Err.Description & "<p>"
			response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>"
			Exit Sub
		end if
		on error goto 0 'reset error handling
 
		nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)
 
		If nCurPos <= 1  Then Exit Sub
		 
		'vDataSep is a separator like -----------------------------21763138716045
		vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)
 
		'Start of current separator
		nDataBoundPos = 1
 
		'Beginning of last line
		nLastSepPos = FindToken(vDataSep & tTerm, 1)
 
		Do Until nDataBoundPos = nLastSepPos
			
			nCurPos = SkipToken(tContentDisp, nDataBoundPos)
			nCurPos = SkipToken(tName, nCurPos)
			sFieldName = ExtractField(tDoubleQuotes, nCurPos)
 
			nPosFile = FindToken(tFilename, nCurPos)
			nPosBound = FindToken(vDataSep, nCurPos)
			
			If nPosFile <> 0 And  nPosFile < nPosBound Then
				Dim oUploadFile
				Set oUploadFile = New UploadedFile
				
				nCurPos = SkipToken(tFilename, nCurPos)
				auxStr = ExtractField(tDoubleQuotes, nCurPos)
                ' We are interested only in the name of the file, not the whole path
                ' Path separator is \ in windows, / in UNIX
                ' While IE seems to put the whole pathname in the stream, Mozilla seem to 
                ' only put the actual file name, so UNIX paths may be rare. But not impossible.
                osPathSep = "\"
                if InStr(auxStr, osPathSep) = 0 then osPathSep = "/"
				oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep))
 
				if (Len(oUploadFile.FileName) > 0) then 'File field not left empty
					nCurPos = SkipToken(tContentType, nCurPos)
					
                    auxStr = ExtractField(tNewLine, nCurPos)
                    ' NN on UNIX puts things like this in the streaa:
                    '    ?? python py type=?? python application/x-python
					oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " "))
					nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
					
					oUploadFile.Start = nCurPos-1
					oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos
					
					If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile
				End If
			Else
				Dim nEndOfData
				nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
				nEndOfData = FindToken(vDataSep, nCurPos) - 2
				If Not FormElements.Exists(LCase(sFieldName)) Then 
					FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
				else
                    FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) 
                end if 
 
			End If
 
			'Advance to next separator
			nDataBoundPos = FindToken(vDataSep, nCurPos)
		Loop
		StreamRequest.Write(VarArrayBinRequest)
	End Sub
 
	Private Function SkipToken(sToken, nStart)
		SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
		If SkipToken = 0 then
			Response.write "Error in parsing uploaded binary request."
			Response.End
		end if
		SkipToken = SkipToken + LenB(sToken)
	End Function
 
	Private Function FindToken(sToken, nStart)
		FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
	End Function
 
	Private Function ExtractField(sToken, nStart)
		Dim nEnd
		nEnd = InstrB(nStart, VarArrayBinRequest, sToken)
		If nEnd = 0 then
			Response.write "Error in parsing uploaded binary request."
			Response.End
		end if
		ExtractField = String2Byte(MidB(VarArrayBinRequest, nStart, nEnd-nStart))
	End Function
 
	'String to byte string conversion
	Private Function Byte2String(sString)
		Dim i
		For i = 1 to Len(sString)
		   Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)))
		Next
	End Function
 
	'Byte string to string conversion
	Private Function String2Byte(bsString)
		Dim i
		String2Byte =""
		For i = 1 to LenB(bsString)
		   String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1))) 
		Next
	End Function
End Class
 
Class UploadedFile
	Public ContentType
	Public Start
	Public Length
	Public Path
	Private nameOfFile
 
    ' Need to remove characters that are valid in UNIX, but not in Windows
    Public Property Let FileName(fN)
        nameOfFile = fN
        nameOfFile = SubstNoReg(nameOfFile, "\", "_")
        nameOfFile = SubstNoReg(nameOfFile, "/", "_")
        nameOfFile = SubstNoReg(nameOfFile, ":", "_")
        nameOfFile = SubstNoReg(nameOfFile, "*", "_")
        nameOfFile = SubstNoReg(nameOfFile, "?", "_")
        nameOfFile = SubstNoReg(nameOfFile, """", "_")
        nameOfFile = SubstNoReg(nameOfFile, "<", "_")
        nameOfFile = SubstNoReg(nameOfFile, ">", "_")
        nameOfFile = SubstNoReg(nameOfFile, "|", "_")
    End Property
 
    Public Property Get FileName()
        FileName = nameOfFile
    End Property
 
    'Public Property Get FileN()ame
End Class
 
 
' Does not depend on RegEx, which is not available on older VBScript
' Is not recursive, which means it will not run out of stack space
Function SubstNoReg(initialStr, oldStr, newStr)
    Dim currentPos, oldStrPos, skip
    If IsNull(initialStr) Or Len(initialStr) = 0 Then
        SubstNoReg = ""
    ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then
        SubstNoReg = initialStr
    Else
        If IsNull(newStr) Then newStr = ""
        currentPos = 1
        oldStrPos = 0
        SubstNoReg = ""
        skip = Len(oldStr)
        Do While currentPos <= Len(initialStr)
            oldStrPos = InStr(currentPos, initialStr, oldStr)
            If oldStrPos = 0 Then
                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1)
                currentPos = Len(initialStr) + 1
            Else
                SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr
                currentPos = oldStrPos + skip
            End If
        Loop
    End If
End Function
%>
 
 
 
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<script type="text/javascript" src="../java/jquery-1.2.6.min.js"></script>
<script type="text/javascript" src="../java/ajax.js"></script>
<script type="text/javascript" src="../java/functions.js"></script>
<link rel="stylesheet" href="../style/default.css">
</head>
 
<% If Request.QueryString("tabupdated") = 2 Then %>
<body onload='$("#fileselected").hide();$("#fileresults").hide();'>
<% Else %>
<body onload='$("#fileselected").hide();'>
<% End If %>
<%
 
 
' *********************** START VARIABLE EDIT ***********************
 
  Dim uploadsDirRemote, uploadsDirLocal
 
  uploadsDirLocal = Server.MapPath("\") & "\Public\doc_transfer"
 
' ************************ END VARIABLE EDIT ************************
 
function OutputForm()
%>
 
 
<% Response.Write "<form name='frmSend' method='POST' enctype='multipart/form-data' action='#'>" %>
 
<center><br><br>
Enter a file description: <input type="text" size=35 name="doctitle"><br><br>
    Select a document: <input type="button" value="Browse..." class="btn" onmouseover="this.className='btn btnhov'" onmouseout="this.className='btn'"/><input name="attach1" type="file" size=35 class="hidebrowse" onchange="$('#fileselected').show();">
&nbsp;&nbsp;<span id="fileselected"><img src="../images/checkmark.gif" border="0" height="16" width="16"></span>
<br><br>
 
    <input style="margin-top:4" type=button value="Upload File" onclick="fileuploadverify_events();" class="btn" onmouseover="this.className='btn btnhov'" onmouseout="this.className='btn'"/>
    </form>
</center>
 
<%
end function
 
function SaveFiles
    Dim Upload, fileName, fileSize, ks, i, fileKey, fs, f
 
    Set Upload = New FreeASPUpload
 
    Upload.FilesSave uploadsDirLocal, request.querystring("id"), "Event"
 
	' If something fails inside the script, but the exception is handled
	If Err.Number<>0 then Exit function
 
    SaveFiles = ""
    ks = Upload.UploadedFiles.keys
 
 
    if (UBound(ks) <> -1) then
 
'
 
    else
      SaveFiles = "<br>The file you have entered does not appear to be valid or already exists. Please select another file."
    end if
 
 
end function
%>
 
<%
Dim diagnostics
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
        response.write "<div align=""center"">"
        OutputForm()
        response.write "</div>"
else
    response.write "<div align=""center"">"
    OutputForm()
If Request.QueryString("tabupdated") = 2 Then
    response.write SaveFiles()
%>
<span id="uploading">
      <div align="center"><font size="2" face="Arial, Helvetica, sans-serif"> 
          <image src="../images/indicator.gif" border="0"> <i>Uploading File... Please Wait.</i>
          </font></div>
</span>
<%
End If
    response.write "<br><br></div>"
End If
 
%>
 
</body>
</html>

                                  

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427: