File upload using Classic Asp ,Save It On Server How It possible


File upload using Classic Asp ,Save It On Server How It possible
1
bharat_kumar
2/1/2008 5:24:10 AM
📁 asp.net.free-for-all
📃 9281 articles.
⭐ 0 followers.

💬 2 Replies
👁️‍🗨️ 2642 Views



aspalliance.com/Michiel/uploadscript.asp 
search.techrepublic.com.com/404.php?page=5100-6371-5031731 upload images
classicasp.aspfaq.com/forms/how-do-i-upload-files-from-the-client-to-the-server.html

Always "Mark an Answer" to all those posts which gave you solution so other people could know the solutions.

Muhammad Adnan
.Net Evangelist
http://weblogs.asp.net/muhammadadnan
http://realfantasy.wordpress.com
0
realfantasy
2/1/2008 6:52:40 AM

Take a new asp page and save it as clsUpload and  remove alla html tags and paste the following code in the page.
<%
' ------------------------------------------------------------------------------
' Container of Field Properties
Class clsField
 Public FileName
 Public ContentType
 Public Value
 Public FieldName
 Public Length
 Public BinaryData
End Class
' ------------------------------------------------------------------------------
Class clsUpload
' ------------------------------------------------------------------------------
 Private nFieldCount
 Private oFields()
 Private psFileFullPath
 Private psError
 Private psFileInputName
' ------------------------------------------------------------------------------
 Public Property Get Count()
  Count = nFieldCount
 End Property
' ------------------------------------------------------------------------------
 Public Default Property Get Field(ByRef asFieldName)
  Dim lnLength
  Dim lnIndex
  
  lnLength = UBound(oFields)
  
  If IsNumeric(asFieldName) Then
   If lnLength >= asFieldName And asFieldName > -1 Then
    Set Field = oFields(asFieldName)
   Else
    Set Field = New clsField
   End If
  Else
   For lnIndex = 0 To lnLength
    If LCase(oFields(lnIndex).FieldName) = LCase(asFieldName) Then
     Set Field = oFields(lnIndex)
     Exit Property
    End If
   Next
   Set Field = New clsField
  End If
 End Property
' ------------------------------------------------------------------------------
 Public Function Exists(ByRef avKeyIndex)
  Exists = Not IndexOf(avKeyIndex) = -1
 End Function
' ------------------------------------------------------------------------------
 Public Property Get ValueOf(ByRef avKeyIndex)
  Dim lnIndex
  lnIndex = IndexOf(avKeyIndex)
  if lnIndex = -1 Then Exit Property
  ValueOf = oFields(lnIndex).Value
 End Property
' ------------------------------------------------------------------------------
 Public Property Get FileNameOf(ByRef avKeyIndex)
  Dim lnIndex
  lnIndex = IndexOf(avKeyIndex)
  if lnIndex = -1 Then Exit Property
  FileNameOf = oFields(lnIndex).FileName
 End Property
' ------------------------------------------------------------------------------
 Public Property Get LengthOf(ByRef avKeyIndex)
  Dim lnIndex
  lnIndex = IndexOf(avKeyIndex)
  if lnIndex = -1 Then Exit Property
  LengthOf = oFields(lnIndex).Length
 End Property
' ------------------------------------------------------------------------------
 Public Property Get BinaryDataOf(ByRef avKeyIndex)
  Dim lnIndex
  lnIndex = IndexOf(avKeyIndex)
  if lnIndex = -1 Then Exit Property
  BinaryDataOf = oFields(lnIndex).BinaryData
 End Property
' ------------------------------------------------------------------------------
 Private Function IndexOf(ByVal avKeyIndex)
  Dim lnIndex
  
  If avKeyIndex = "" Then
   IndexOf = -1
  ElseIf IsNumeric(avKeyIndex) Then
   avKeyIndex = CLng(avKeyIndex)
   If nFieldCount > avKeyIndex And avKeyIndex > -1 Then
    IndexOf = avKeyIndex
   Else
    IndexOf = -1
   End If
  Else
   For lnIndex = 0 To nFieldCount - 1
    If LCase(oFields(lnIndex).FieldName) = LCase(avKeyIndex) Then
     IndexOf = lnIndex
     Exit Function
    End If
   Next
   IndexOf = -1
  End If
 End Function
' ------------------------------------------------------------------------------
Public Property Let FileFullPath(sValue)
 psFileFullPath = sValue
End Property
'___________________________________________________________________________________
Public Property Get FileFullPath()
 FileFullPath = psFileFullPath
End Property
' ------------------------------------------------------------------------------
Public Property Let FileInputName(sValue)
 psFileInputName = sValue
End Property
' -------------------- ----------------------------------------------------------
Public Function Save()
 if psFileFullPath <> "" and psFileInputName <> "" then
  'Save to connectionless client side recordset, write to stream,
  'and persist stream.
  'would think you should be able to write directly to
  'stream without recordset, but I could not get that to work
  On error resume next
  binData = o.BinaryDataOf(psFileInputName)
  set rs = server.createobject("ADODB.RECORDSET")
  rs.fields.append "FileName", 205, LenB(binData)
  rs.open
  rs.addnew
   rs.fields(0).AppendChunk binData
  
  if err.number = 0 then
   set objStream = Server.CreateObject("ADODB.Stream")
     objStream.Type  = 1
      objStream.Open
    objStream.Write rs.fields("FileName").value
   objStream.SaveToFile psFileFullPath, 2
   objStream.close
   set objStream = Nothing
  ENd if
  rs.close
  set rs = nothing
  psError = Err.Description
else
  psError = "One or more required properties (FileFullPath and/or FileInputName) not set"
  End If
End Function
Public Property Get Error()
 Error = psError
End Property
' ------------------------------------------------------------------------------
 Public Property Get ContentTypeOf(ByRef avKeyIndex)
  Dim lnIndex
  lnIndex = IndexOf(avKeyIndex)
  if lnIndex = -1 Then Exit Property
  ContentTypeOf = oFields(lnIndex).ContentType
 End Property
' ------------------------------------------------------------------------------
 Private Sub Class_Terminate()
  Dim lnIndex
  For lnIndex = 0 To nFieldCount - 1
   Set oFields(0) = Nothing
  Next
 End Sub
' ------------------------------------------------------------------------------
 Private Sub Class_Initialize()
  
  Dim lnBytes    ' Bytes received from the client
  Dim lnByteCount   ' Number of bytes received
  Dim lnStartPosition  ' Position at which content begins
  Dim lnEndPosition  ' Position at which content ends
  
  Dim loDic    ' Contains properties of each
        ' specific field
        ' Local dictionary object(s)
        ' to be appended to class-scope
        ' dictioary object.
        
  Dim lnBoundaryBytes  ' Bytes contained within the current boundary
  Dim lnBoundaryStart  ' Position at wich the current boundary begins
        ' within the lnBytes binary data.
  Dim lnBoundaryEnd  ' Position at wich the current boundary ends
        ' within the lnBytes binary data.
  Dim lnDispositionPosition
  
  Dim lsFieldName   ' Name of the current field being parsed from
        ' Binary Data
  Dim lsFileName   ' Name of the file within the current boundary
  Dim lnFileNamePosition ' Location of file name within current boundary
  Dim loField    ' clsField Object
  Dim lsValue    ' Value of the current field
  Dim lsContentType  ' ContentType of the binary file (MIME Type)
  
  ' Initialize Fields
  nFieldCount = 0
  ReDim oFields(-1)
  
  ' Read the bytes (binary data) into memory 
  lnByteCount = Request.TotalBytes
  lnBytes = Request.BinaryRead(lnByteCount)
  
  'Get the lnBoundaryBytes
  lnStartPosition = 1
  lnEndPosition = InstrB(lnStartPosition, lnBytes, CStrB(vbCr))
  
  If lnEndPosition >= lnStartPosition Then
   lnBoundaryBytes = MidB(lnBytes, lnStartPosition, lnEndPosition - lnStartPosition)
  End If
  
  lnBoundaryStart = InstrB(1, lnBytes, lnBoundaryBytes)
  
  
  ' Loop until the BoundaryBytes begin with "--"
  Do Until (lnBoundaryStart = InstrB(lnBytes, lnBoundaryBytes & CStrB("--")))
  
   ' All data within this boundary is stored within a local dictionary
   ' to be appended to the class-scope dictionary.
   
   ReDim Preserve oFields(nFieldCount)
   nFieldCount = nFieldCount + 1
   
   Set loField = New clsField
   lnDispositionPosition = InstrB(lnBoundaryStart, lnBytes, CStrB("Content-Disposition"))
   
   ' Get an object name
   lnStartPosition = InstrB(lnDispositionPosition, lnBytes, CStrB("name=")) + 6
   lnEndPosition = InstrB(lnStartPosition, lnBytes, CStrB(""""))
   lsFieldName = CStrU(MidB(lnBytes, lnStartPosition, lnEndPosition - lnStartPosition))
   loField.FieldName = lsFieldName
   
   ' Get the location fo the file name.
   lnFileNamePosition = InstrB(lnBoundaryStart, lnBytes, CStrB("filename="))
   lnBoundaryEnd = InstrB(lnEndPosition, lnBytes, lnBoundaryBytes)
   
   'Test if object is a file
   If Not lnFileNamePosition = 0 And lnFileNamePosition < lnBoundaryEnd Then
   
    ' Parse Filename
    lnStartPosition = lnFileNamePosition + 10
    lnEndPosition =  InstrB(lnStartPosition, lnBytes, CStrB(""""))
    lsFileName = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
    loField.FileName = lsFileName    
    
    ' Parse Content-Type
    lnStartPosition = InstrB(lnEndPosition,lnBytes,CStrB("Content-Type:")) + 14
    lnEndPosition = InstrB(lnStartPosition,lnBytes,CStrB(vbCr))
    lsContentType = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
    loField.ContentType = lsContentType
    ' Parse Content
    lnStartPosition = lnEndPosition + 4
    lnEndPosition = InstrB(lnStartPosition,lnBytes,lnBoundaryBytes)-2
    lsValue = MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition)
    loField.BinaryData = lsValue & CStrB(vbNull)
    loField.Length = LenB(lsValue)
   Else
    ' Parse Content
    lnStartPosition = InstrB(lnDispositionPosition, lnBytes, CStrB(vbCr)) + 4
    lnEndPosition = InstrB(lnStartPosition, lnBytes, lnBoundaryBytes) - 2
    lsValue = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
    loField.Value = lsValue
    loField.Length = Len(lsValue)
   End If
   Set oFields(UBound(oFields)) = loField
   'Loop to next object
   lnBoundaryStart = InstrB(lnBoundaryStart + LenB(lnBoundaryBytes), lnBytes, lnBoundaryBytes)
   
   Set loField = Nothing
   
  Loop
 End Sub
' ------------------------------------------------------------------------------
 Private Function CStrU(ByRef psByteString)
  Dim lnLength
  Dim lnPosition
  lnLength = LenB(psByteString)
  For lnPosition = 1 To lnLength
   CStrU = CStrU & Chr(AscB(MidB(psByteString, lnPosition, 1)))
  Next
 End Function
' ------------------------------------------------------------------------------
 Private Function CStrB(ByRef psUnicodeString)
  Dim lnLength
  Dim lnPosition
  lnLength = Len(psUnicodeString)
  For lnPosition = 1 To lnLength
   CStrB = CStrB & ChrB(AscB(Mid(psUnicodeString, lnPosition, 1)))
  Next
 End Function
' ------------------------------------------------------------------------------
End Class
' ------------------------------------------------------------------------------
%>
Now write the following code to the page where you want to upload the file.
<!--#include file="clsUpload.asp"-->
<form name="frmupload" ENCTYPE="multipart/form-data" method= "post">
 <%    
      
      
           
       
       set o = new clsUpload
    
        
       sFileSplit = split(o.FileNameOf("txtFile"), "\")
       sFile = sFileSplit(Ubound(sFileSplit))
       flname = Split(sFile,".")
       
       
        if flname(1) <> "jpg" and flname(1) <> "jpeg" and flname(1) <> "gif" then
        
        
        Response.Redirect("upload_tools.asp?act=invalid")
        
       else
       
         
         o.FileInputName = "txtFile"
         o.FileFullPath = Server.MapPath(".") & "\Uploads\" & sFile
         o.save
        
       
       
       end if
             
     
    %>
</form>
0
bhanupochampally
2/1/2008 6:55:25 AM
Reply: