<% ' Copyright (C) 1998-2005 Cyberstrong Internet Services, Inc. All Rights Reserved ' ' This file has been seeded with unique information at point of sale and ' is traceable to its purchaser. ' ' Your license agreement forbids the removal of this notice. ' upload.asp - Upload one or more files. Dim FileIndex, FormErrorMsg FileIndex = 1 Public Sub uplUploadFile(ByVal argUploadFolder) Dim FormSize, FormData, FormScan, FormDelimiter, SectionScan Dim FileName, FileContents, FormSection, bnCrLf, s FormSize = Request.TotalBytes FormData = Request.BinaryRead(FormSize) ' Response.Write("FormData: " & StrToAsc(BinToStr(FormData)) & "" & "
" & vbCrLf) FormScan = OpenScanB(FormData) bnCrLf = chrB(13) & chrB(10) FormDelimiter = BreakStrB(FormScan, bnCrLf) s = SpanCharsB(FormScan, 2) FormSection = BreakStrB(FormScan, FormDelimiter) Do While (FormSection <> "") SectionScan = OpenScanB(FormSection) ' Break to filename=", span it, then pick up the file name ... s = BreakStrB(SectionScan, StrToBin("filename=""")) s = SpanCharsB(SectionScan, 10) FileName = BinToStr(BreakStrB(SectionScan, StrToBin(""""))) ' Response.Write("FileName: '" & FileName & "'" & "
" & vbCrLf) ' Break to double CrLf, slide over them, then pick up file contents ... s = BreakStrB(SectionScan, bnCrLf & bnCrLf) s = SpanCharsB(SectionScan, 4) FileContents = BreakStrB(SectionScan, "") ' Remove the bnCrLF at the end ... FileContents = LeftB(FileContents, LenB(FileContents) - 2) ' Display what we got (debug only) ... ' Response.ContentType = "image/gif" ' Response.BinaryWrite FileContents ' Write it to a file If (FileName <> "") Then Select Case LCase(GetFileExt(FileName)) Case "gif", "jpg", "jpeg", "pic", "png", "tif", "tiff", "bmp" Call uplWriteToFileB(argUploadFolder & "\" & GetFileName(FileName), FileContents) Case Else Call Log(0, "Attempt to upload non-image file '" & FileName & "' to folder '" & argUploadFolder & "'") End Select End If ' Close section scan ... Call CloseScanB(SectionScan) ' Get the next form section ... s = SpanCharsB(FormScan, LenB(FormDelimiter)) FormSection = BreakStrB(FormScan, FormDelimiter) Loop Call CloseScanB(FormScan) End Sub ' WriteToFileB() - Write binary string to file. Public Sub uplWriteToFileB(ByVal argFileName, ByVal argFileContents) Dim FileObj, FileOut On Error Resume Next Set FileObj = Server.CreateObject("Scripting.FileSystemObject") ' If full or UNC path use it, otherwise map it... If ((Mid(argFileName, 2, 1) = ":") Or (Mid(argFileName, 1, 2) = "\\")) Then Err.Clear Set FileOut = FileObj.CreateTextFile(argFileName, True) Else Err.Clear Set FileOut = FileObj.CreateTextFile(Server.MapPath(argFileName), True) End If If (Err) Then Call Log(0, "Upload.asp: File create failed for file '" & argFileName & "'. Check folder permissions.") Err.Clear FileOut.Write(BinToStr(argFileContents)) If (Err) Then Call Log(0, "Upload.asp: File write failed for file '" & argFileName & "'. Check folder permissions.") FileOut.Close Set FileObj = Nothing Set FileOut = Nothing ' Pass uploaded file names back to caller, ' Used in mProduct.asp to plug file names into products table ... Session("UploadFile" & FileIndex) = argFileName FileIndex = FileIndex + 1 End Sub ' uplDisplayForm() - Call this function where you need to upload Public Sub uplDisplayForm(ByVal argUploadFolder, ByVal argNumInputBoxes) Dim i ' Upload not allowed in online demo mode... FormErrorMsg = "" If (isOnlineDemo(FormErrorMsg)) Then wl(FormErrorMsg) Exit Sub End If If (Request.TotalBytes > 0) Then Call uplUploadFile(argUploadFolder) End If ' Display the upload form ... wl("

") For i = 1 To argNumInputBoxes Step 1 wl("

") Next wl(" ") wl("") wl("

") End Sub %>