Programalama > ASP

Etiketler: fso, ile, upload

Ort. 5
Puan ver:
Web alanımıza her ne kadar sadece biz ftp ile dosya yüklüyorsak ta bazen kullanıcıdan dosya almamız yada yaptığımız uygulama gereği web üzerinden dosya yüklememiz gerekiyor. Mesela sitenizin yönetim bölümünde haber eklediğinizde habere ait birde resim yüklemek isteyebilirsiniz. Eğer kendi bilgisayarınız yada ftp kurulu bir bilgisayarda iseniz ftp ile bu resmi yükleyebilirsiniz. Ancak bu hem zaman kaybı gereksiz bir işlem olur. Bu durumda yardımımıza Upload komponentleri yetişir. Peki kullandığınız server herhangi bir komponent kullanmanıza izin vermiyorsa. İşte bu durumda da yardımımıza ASP'nin File System Object nesnesi yetişiyor. Aşağıdaki kodlarla serverinizde hiçbir upload komponenti olmasa bile dosya yükleyebilirsiniz. Ancak tabiki yüklenecek klasöre yazma izni verilmiş olmalı. Yoksa hata alırsınız.



Dosya seçeceğimiz sayfa. İsmi önemli değil.

------------ UploadForm.htm----------------

<FORM METHOD="Post" ENCTYPE="multipart/form-data" ACTION="Upload.asp">
Dosya:<INPUT NAME="dosya" TYPE="file" size="25"><BR>
<INPUT TYPE="submit" Value="Kaydet">
</FORM>
------------


Ve bu formdan dosyayı alıp servera yükleyecek Upload.asp sayfamız. Bu kod üzerinde sadece 5.satırda Yol isimli değişkende yüklenecek klasörü belirleyin. Sondaki \ işaretini ise kaldırmayın.

-----------Upload.asp--------
<%
Set Yukle = New DosyaYukleme

Yol = Server.Mappath("dosyalar")&"\"

DosyaIsmi = Yukle.FileName (" dosya ")

Set FSO = Server.CreateObject("Scripting.FileSystemObject>" )

Set YeniDosya = FSO.CreateTextFile(Yol & DosyaIsmi)

For i = 1 To LenB(Yukle.Value("dosya" )) 
   YeniDosya.Write Chr(AscB(MidB(Yukle.Value("dosya" ), i, 1))) 
Next 


YeniDosya.Close 
Set YeniDosya = Nothing 
Set FSO = Nothing 

Set Yukle = Nothing 
%> 
Yüklendi.

<!-- ***** Bu bölümden aşağısını değiştirmeyin **** -->

<% 
Class DosyaYukleme 

     Private pvObjUploadRequest 
      
     Private Sub Class_Initialize 
          Dim RequestBin, Boundary, Value 
          Dim lngPosBegin, lngPosEnd, lngBoundaryPos 
          Dim lngPos, lngPosFile, lngPosBound 
          Dim strName, strFileName, strContentType 
          Dim objUploadControl 

           
          Set pvObjUploadRequest = Server.CreateObject("Scripting.Dictionary" ) 
           
           
          RequestBin = Request.BinaryRead(Request.TotalBytes) 
           
           
          lngPosBegin = 1 
          lngPosEnd = InStrB(lngPosBegin, RequestBin, GetByteString(Chr(13))) 
          Boundary = MidB(RequestBin, lngPosBegin, lngPosEnd - lngPosBegin) 
          lngBoundaryPos = InstrB(1, RequestBin, Boundary) 
           
           
          Do Until (lngBoundaryPos = InstrB(RequestBin, Boundary & getByteString("--" ))) 
                
               Set objUploadControl = CreateObject("Scripting.Dictionary" ) 
                
                
               lngPos = InstrB(lngBoundaryPos, RequestBin, GetByteString("Content-Disposition" )) 
               lngPos = InstrB(lngPos, RequestBin, GetByteString("name=" )) 
               lngPosBegin = lngPos + 6 
               lngPosEnd = InstrB(lngPosBegin, RequestBin, GetByteString(Chr(34))) 
               strName = LCase(GetString(MidB(RequestBin, lngPosBegin, lngPosEnd - lngPosBegin))) 
               lngPosFile = InstrB(lngBoundaryPos, RequestBin, GetByteString("filename=" )) 
               lngPosBound = InstrB(lngPosEnd, RequestBin, Boundary) 
                
                
               If lngPosFile <> 0 AND lngPosFile < lngPosBound Then 
                     
                    lngPosBegin = lngPosFile + 10 
                    lngPosEnd = InStrB(lngPosBegin, RequestBin, GetByteString(Chr(34))) 
                    strFileName = GetString(MidB(RequestBin, lngPosBegin, lngPosEnd - lngPosBegin)) 
                     
                     
                    objUploadControl.Add "FileName" , strFileName 
                    lngPos = InStrB(lngPosEnd, RequestBin, GetByteString("Content-Type:" )) 
                    lngPosBegin = lngPos + 14 
                    lngPosEnd = InStrB(lngPosBegin, RequestBin, GetByteString(Chr(13))) 
                     
                     
                    strContentType = GetString(MidB(RequestBin, lngPosBegin, lngPosEnd - lngPosBegin)) 
                    objUploadControl.Add "ContentType" , strContentType 

                     
                    lngPosBegin = lngPosEnd + 4 
                    lngPosEnd = InstrB(lngPosBegin, RequestBin, Boundary) - 2 
                    Value = MidB(RequestBin, lngPosBegin, lngPosEnd - lngPosBegin) 
               Else 
                     
                    lngPos = InstrB(lngPos, RequestBin, GetByteString(Chr(13))) 
                    lngPosBegin = lngPos + 4 
                    lngPosEnd = InStrB(lngPosBegin, RequestBin, Boundary) - 2 
                    Value = GetString(MidB(RequestBin, lngPosBegin, lngPosEnd - lngPosBegin)) 
               End If 
                
                
               objUploadControl.Add "Value" , Value      
                
                
               pvObjUploadRequest.Add strName, objUploadControl 
                
                
               lngBoundaryPos = InStrB(lngBoundaryPos + LenB(Boundary), RequestBin, Boundary) 
          Loop 
     End Sub 
      
      
     Private Sub Class_TerMINate 
          Dim objDictionary 

          For Each objDictionary In pvObjUploadRequest.Items 
               objDictionary.RemoveAll 
               Set objDictionary = Nothing 
          Next 
          pvObjUploadRequest.RemoveAll 
          Set pvObjUploadRequest = Nothing 
     End Sub 
      

      
     Private Function GetByteString(strString) 
          Dim Char 
          Dim i 
       
          For i = 1 To Len(strString) 
                Char = Mid(strString, i , 1) 
               GetByteString = GetByteString & ChrB(AscB(Char)) 
          Next 
     End Function 


      
     Private Function GetString(strBin) 
          Dim intCount 
           
          GetString = "" 
           
          For intCount = 1 To LenB(strBin) 
               GetString = GetString & Chr(AscB(MidB(strBin, intCount, 1)))  
          Next 
     End Function 
      
      
     Public Function Value(Name) 
          Name = LCase(Name) 
          If pvObjUploadRequest.Exists(Name) Then 
               Value = pvObjUploadRequest.Item(Name).Item("Value" ) 
          Else 
               Value = Empty 
          End If 
     End Function 
      
      
     Public Function ContentType(Name) 
          Name = LCase(Name) 
          If pvObjUploadRequest.Exists(Name) Then 
               If pvObjUploadRequest.Item(Name).Exists("ContentType" ) Then 
                    ContentType = pvObjUploadRequest.Item(Name).Item("ContentType" ) 
               Else 
                    ContentType = Empty 
               End If 
          Else 
               ContentType = Empty 
          End If 
     End Function 
      
      
     Public Function FileNamePath(Name) 
          Name = LCase(Name) 
          If pvObjUploadRequest.Exists(Name) Then 
               If pvObjUploadRequest.Item(Name).Exists("FileName" ) Then 
                    FileNamePath = pvObjUploadRequest.Item(Name).Item("FileName" ) 
               Else 
                    FileNamePath = Empty 
               End If 
          Else 
               FileNamePath = Empty 
          End If 
     End Function 
      
      
     Public Function FileName(Name) 
          Dim strFileName 
           
          Name = LCase(Name) 
          If pvObjUploadRequest.Exists(Name) Then 
               If pvObjUploadRequest.Item(Name).Exists("FileName" ) Then 
                    strFileName = pvObjUploadRequest.Item(Name).Item("FileName" ) 
                    FileName = Right(strFileName, Len(strFileName) - InStrRev(strFileName, "\" )) 
               Else 
                    FileName = Empty 
               End If 
          Else 
               FileName = Empty 
          End If 
     End Function 
      
End Class 
%>


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.