<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%> <% '*** File Upload to: ../uploadarea, Extensions: "", Form: form1, Redirect: "/contactinformation/upload-info.asp" '*** 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 "Form was submitted with no ENCTYPE=""multipart/form-data""
" 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 "") Then if UploadQueryString <> "" then GP_uploadAction = GP_uploadAction & "&" & UploadQueryString end if End If If (CStr(Request.QueryString("GP_upload")) <> "") Then GP_redirectPage = "/contactinformation/upload-info.asp" 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 "An error has occured saving uploaded file!

" Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "
" Response.Write "File does not exists or is empty.
" Response.Write "Please correct and try again" 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,"/")) & "../uploadarea") 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 "An error has occured saving uploaded file!

" Response.Write "Filename: " & Trim(GP_curPath) & UploadRequest.Item(GP_curKey).Item("FileName") & "
" Response.Write "Maybe the destination directory does not exist, or you don't have write permission.
" Response.Write "Please correct and try again" err.clear response.End end if end if next '***GP BEGIN REDIRECT: with URL parameters (only if no Insert/Update) If (GP_redirectPage <> "") Then If (InStr(1, GP_redirectPage, "?", vbTextCompare) = 0 And UploadQueryString <> "") Then GP_redirectPage = GP_redirectPage & "?" & UploadQueryString End If strEmailBody = "" Set objNewMail = Server.CreateObject("CDONTS.NewMail") objNewMail.From = "sie@eightlegged.com" 'Trim(Request.Form("text1")) objNewMail.To = "sie@eightlegged.com" objNewMail.Subject = "Badge Shop Enquiry" objNewMail.BodyFormat = 0 objNewMail.MailFormat = 0 objNewMail.Body = "
Email Address
" + request("text1") + "
Name
" + request("text2") + "
Company Name
" + request("text3") + "
Address
" + request("textarea4") + "
Postcode
" + request("text5") + "
Telephone Number
" + request("text6") + "
I would like samples of ID Cards
" + request("checkbox7") + "
I would like samples of Name Badges
" + request("checkbox8") + "
Any Other Comments
" + request("textarea10") + "
Approx number of badges/cards needed
" + request("text11") + "
If you have an urgent deadline, please enter the date by which you must receive delivery
" + request("text12") + "
File Uploaded ( click to download )
" + session("filename") + "
" objNewMail.Send Set objNewMail = Nothing 'Response.redirect("thanks.asp") end if '***GP END REDIRECT end if if UploadQueryString <> "" then UploadQueryString = UploadQueryString & "&GP_upload=true" else UploadQueryString = "GP_upload=true" end if %> Tiffany Badges - Contact Information


contact us 
  Tiffany Badges 




 Company


welcome


why use us?


special offer


more examples


photo ID - online!


 Badge Options


backgrounds


typeface options


layouts


fastenings


membership cards


 The Badge Shop


sample request


prices


 Communications


link to us


links to others


help page


contact us


why 'tiffany'?






Please upload your logo to us by clicking on the 'Browse' button and selecting your logo from your hard disk. Logos are best sent as windows bitmaps (.bmp), tiff files (.tif), jpeg files (.jpg) or EPS files. Files should be no smaller than 100K. Alternatively you can also send us your letterhead which we will scan for you.

Please do not send WORD documents.

<% if (Request.QueryString("code") <> "" ) then Response.Write("
Invalid code
") End If if (Request.QueryString("ext") <> "" ) then Response.Write("
Please upload .jpg, .png, .gif, .bmp file formats only.
") End If if ( Request.QueryString("filename") <> "") then Response.Write("
Enter the Uploaded Filename

") End If %>
Email Address
 " >
Contact Name
 " >
Company Name
 " id="Company">
Address
Postcode
 " id="Postcode">
Telephone Number
 " id="Telephone">
I need Photo ID Cards
 "" THEN response.Write "checked" END IF %> value=Yes>
I need Name Badges
 "" THEN response.Write "checked" END IF %> id="Name_Badges" value=Yes>
Your Logo (NOT WORD DOCUMENTS please!!)

Type the name of the file uploaded here

" id="Upload_Filename">

Any Other Comments
Number of badges in any resulting order (not number of samples)

" id="Amount">

Urgent deadline for final order? (not samples)
 " id="Deadline">
 
Enter the code as you see it, click submit and wait for "successful" message
    
 







Tiffany Badges
Quality, Value and Speed
0131 447 5371