I posted something a few weeks ago here it is again (sorry for the broken lines of the code - please correct them manually). The SaveFile Function is a bit specific - keeps the file extensions, but uses name passed as parameter - if you want something else - modify the naming logic or may be add a similar method that does the job otherwise. Well, the so called "ASP Only" upload always uses components - usually the ADO Stream object, but my component set is free and much more powerful. I'll try to prepare sample that uses it better and avoids part of the code you will see below by passing the work to the binary Find method, but ... when I got some time to do it I'll write it for sure ;).
The old message follows: Hi, If you want to do it your self. You need some kind of binary stream object. ADO has one, but I am posting here code written to run with my own components (free) because ... everybody likes his own works ;). Ok - the URL for the components is: http://www.newobjects.com/prodct/Category/63 And here is the code. It is a VBScript class intended for include file. E.g. you create it and use it in manner very similar to the Request object. If you have some problems with the code - ask me. Pay attention to the properties: Item, File and IsFile and SaveFile function. They are mainly for usage from the other code in the page. As you can see the object reads the request during the initialization therfore you just create it: Set 0 = New CUpluad and then use its members for example: o.SaveFile "File1","images/","img221",True Will save the file from the field File1 in the images directory (mapped by the Server.MapPath to a physical location) under the name img221.xxx where xxx will be the original file exttension. Of course you may want to change this function or add a copy and modify it to meet your needs better ... CODE BEGIN <% ' Upload helper class Class CUpload Dim BinData,nBinData,Coll Dim SFMain ' Construction Private Sub Class_Initialize() nBinData = Request.TotalBytes BinData = Request.BinaryRead(nBinData) Set Coll = Server.CreateObject(ClassVarDictionary) Set SFMain = Server.CreateObject(ClassSFMain) BuildUploadRequest BinData, Coll End Sub ' Public access methods Public Default Property Get Item(v) If IsObject(Coll(v)) Then Set Item = Coll.Item(CStr(v)) Else Item = Coll.Item(CStr(v)) End If End Property Public Property Get IsFile(v) IsFile = False If Item(v)("Type") = "File" Then IsFile = True End Property Public Property Get File(v) If Not IsFile(v) Then Err.Raise 1,"CUpload.File","The requested field is not a file" Dim ValueBeg,ValueLen ValueBeg = Item(v)("ValueBeg") ValueLen = Item(v)("ValueLen") Set strm = SFMain.CreateMemoryStream strm.WriteBin BinData strm.Pos = ValueBeg File = strm.ReadBin(ValueLen) End Property Public Function SaveFile(v,whereIn,namePref,boolReplace) Dim f, name, fso, strm, ext, where name = Item(v)("Value") ext = SFMain.GetExtensionName(name) where = Server.MapPath(whereIn) If Right(where,1) <> "\" Then where = where & "\" If SFMain.FileExists(where & namePref & "." & ext) Then If boolReplace Then SFMain.DeleteFile where & namePref & "." & ext Else SaveFile = "" Exit Function End If End If f = File(v) Set strm = SFMain.CreateFile(where & namePref & "." & ext) strm.WriteBin f strm.Close Set strm = Nothing SaveFile = whereIn & namePref & "." & ext End Function ' Private routines - used internally Private Sub BuildUploadRequest(RequestBin, ByRef UploadRequest) 'Get the boundary Dim boundary,boundaryPos,PosBeg,PosEnd PosBeg = 1 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13))) ' Part delimiter - boundary 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,Pos, Name, PosFile, PosBound, FileName, ContentType Set UploadControl = Server.CreateObject(ClassVarDictionary) UploadControl.firstItemAsRoot = True UploadControl.itemsAssignmentAllowed = True '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)) 'Get content of object (file in this case) PosBeg = PosEnd+4 PosEnd = InstrB(PosBeg,RequestBin,boundary) - 2 Value = FileName ValueBeg = PosBeg - 1 ValueLen = PosEnd - PosBeg UploadControl.Add "Value" , Value UploadControl.Add "ContentType",ContentType UploadControl.Add "Type" , "File" Else 'Get content of object (just a field) 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 UploadControl.Add "Value" , Value UploadControl.Add "Type" , "Field" End If UploadControl.Add "ValueBeg" , ValueBeg UploadControl.Add "ValueLen" , ValueLen ' Response.Write "Field: <B>" & Name & "</B> (" & UploadControl("Type") & ")<BR>" UploadRequest.Add Name, UploadControl BoundaryPos = InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary) Loop End Sub Private Function getByteString(StringStr) For i=1 to Len(StringStr) char=Mid(StringStr,i,1) getByteString=getByteString & chrB(AscB(char)) Next End Function Private Function getString(StringBin) getString ="" For intCount=1 to LenB(StringBin) getString=getString & chr(AscB(MidB(StringBin,intCount,1))) Next End Function End Class %> CODE END -----Original Message----- From: Craig [mailto:[EMAIL PROTECTED]] Sent: Monday, September 09, 2002 9:00 PM To: ActiveServerPages Subject: ASPUpload My ISP doesn't provide any components other than an SMTP mail one. They tell me that they will install ASPUpload if I provide a license. Anyone know where I can buy it at the best price please? On the ASPUpload site it sells for US$150.00 for a single server license but that seems a big steep for me to have to pay the whole thing. Is it normal for an ISP to insist I buy the thing or do some ISP's actually provide them in their plan prices? I've got a reseller account but it's getting very expensive with all the service charges that I have to pay. Thanks. --- You are currently subscribed to activeserverpages as: [EMAIL PROTECTED] To unsubscribe send a blank email to %%email.unsub%% --- You are currently subscribed to activeserverpages as: [email protected] To unsubscribe send a blank email to [EMAIL PROTECTED]
