Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic makaleleri » ASP ile FSO işlemleri
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

ORTANCA() Fonksiyonu

Yazar: Webmaster

Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 9407
Yayın Tar:10.10.2007
Yazar : yolcu7
Hit :2969

Bu Yazarın Yazıları Sadece bu yazarın makale göster
Bu Yazıyı Tavsiye Et

Merhaba arkadaşlar bu yazımda asp ile FSO işlemlerinin genel yapısını anlatıcam.Hemen konuya giriyorum
Eğer bir sorunla karşılaşırsanız msn:turkfox13@hotmail.com
iyi çalışmalar


1)TEXT dosyaya veri yazmak
<%
Dim objfso, txtfile
Set objfso = Server.CreateObject("Scripting.FileSystemObject")
Set txtfile = objfso.CreateTextFile(Server.MapPath("upload_files/test.txt"))
txtfile.WriteLine("turkfox13@hotmail.com benim adresim ekleyin :D")
txtfile.Close
Set txtfile = Nothing
Set objfso = Nothing
%>

2)DOSYA SİLME

<%
Private Sub Kill(byVal pathname)
Dim objFSO, boolErr, strErrDesc
On Error Resume Next
Set objFSO = Server.CreateObject("scripting.filesystemobject")
objFSO.DeleteFile pathname
if Err Then
boolErr = True
strErrDesc = Err.Description
end if
Set objFSO = Nothing
On Error GoTo 0
if boolErr then Err.Raise 5102, "Kill Statement", strErrDesc
End Sub
%>

C’deki Dosyası silmek için
<% Kill "C:\deneme.txt" %>

Host’daki Dosyayı Silmek için
<% Kill server.mappath("/Klasor/deneme.txt") %>

C’Deki tüm dosyaları için
<% Kill "C:\Klasor\*" %>

Host’daki tüm dosyaları Silmek için
<% Kill server.mappath("/Klasor") & "\*" %>

3)DOSYA ADINI DEĞİŞTİRME

<%
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
Fso.moveFile "c:\deneme.asp", "c:\eski_deneme.asp"
Set Fso = Nothing
%>

4)DOSYA BİLGİLERİ

<%
Dim objfso, txtfile, txtToDisplay
Set objfso = Server.CreateObject("Scripting.FileSystemObject")
Set txtfile = objfso.GetFile(Server.MapPath("klasor/deneme.jpg"))
txtToDisplay = "File Name = " & txtfile.Name & "<br />"
txtToDisplay = txtToDisplay & "File Size = " & txtfile.Size & "<br />"
txtToDisplay = txtToDisplay & "File Path = " & txtfile.Path & "<br />"
txtToDisplay = txtToDisplay & "Date = " & txtFile.DateCreated
Response.Write(txtToDisplay)
Set txtfile = NothingSet objfso = Nothing
%>

5)KLASÖRDEKİ DOSYALARI LİSTELEMEK
<%
Dim objfso, iFolder, iFiles
Set objfso = Server.CreateObject("Scripting.FileSystemObject")
Set iFolder = objfso.GetFolder(Server.MapPath("klasor/"))
Set iFiles = iFolder.Files

For Each Files in iFiles
Response.Write "Dosya İsmi : " & Files.Name & "<br />"
Next
Set objfso = Nothing
%>

6)KLASÖR OLUŞTURMA

<%
dim fs,f
set fs=Server.CreateObject("Scripting.FileSystemObject")
set f=fs.CreateFolder(server.MapPath("klasor/Yeni Klasor"))
set f=nothing
set fs=nothing
%>

7)KLASÖR SİLME

<%
dim fs
set fs=Server.CreateObject("Scripting.FileSystemObject")
if fs.FolderExists(server.MapPath("Klasor/Yeni Klasor")) then 'Klasör kontrol ediliyor
fs.DeleteFolder(server.MapPath("Klasor/Yeni Klasor"))
end if
set fs=nothing
%>

8)KLASÖR ADINI DEĞİŞTİRME
<%
Dim objfso, txtfile, txtToDisplay
Set objfso = Server.CreateObject("Scripting.FileSystemObject")
Set txtfile = objfso.GetFolder(Server.MapPath("Klasor/Yeni Klasor"))
txtfile.Name = "Yep Yeni Klasor"
txtToDisplay = "Değiştirildi"
Response.Write(txtToDisplay)
Set txtfile = Nothing
Set objfso = Nothing
%>

====================================================
UPLOAD İŞLEMİ
====================================================
<%@ Language=VBScript %>
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
%>
<%
''FREE ASP UPLOAD KÜTÜPHANESi**************************************
Class FreeASPUpload
Public UploadedFiles
Public FormElements

Private VarArrayBinRequest
Private StreamRequest
Private uploadedYet

Private Sub Class_Initialize()
Set UploadedFiles = Server.CreateObject("Scripting.Dictionary")
Set FormElements = Server.CreateObject("Scripting.Dictionary")
Set StreamRequest = Server.CreateObject("ADODB.Stream")
StreamRequest.Type = 1 'adTypeBinary
StreamRequest.Open
uploadedYet = false
End Sub

Private Sub Class_Terminate()
If IsObject(UploadedFiles) Then
UploadedFiles.RemoveAll()
Set UploadedFiles = Nothing
End If
If IsObject(FormElements) Then
FormElements.RemoveAll()
Set FormElements = Nothing
End If
StreamRequest.Close
Set StreamRequest = Nothing
End Sub

Public Property Get Form(sIndex)
Form = ""
If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex))
End Property

Public Property Get Files()
Files = UploadedFiles.Items
End Property

'Calls Upload to extract the data from the binary request and then saves the uploaded files
Public Sub Save(path)
Dim streamFile, fileItem

if Right(path, 1) <> "\" then path = path & "\"

if not uploadedYet then Upload

For Each fileItem In UploadedFiles.Items
Set streamFile = Server.CreateObject("ADODB.Stream")
streamFile.Type = 1
streamFile.Open
StreamRequest.Position=fileItem.Start
StreamRequest.CopyTo streamFile, fileItem.Length
streamFile.SaveToFile path & fileItem.FileName, 2
streamFile.close
Set streamFile = Nothing
fileItem.Path = path & fileItem.FileName
Next
End Sub

Public Sub DumpData() 'only works if files are plain text
Dim i, aKeys, f
response.write "Form Items:<br>"
aKeys = FormElements.Keys
For i = 0 To FormElements.Count -1 ' Iterate the array
response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>"
Next
response.write "Uploaded Files:<br>"
For Each f In UploadedFiles.Items
response.write "Name: " & f.FileName & "<br>"
response.write "Type: " & f.ContentType & "<br>"
response.write "Start: " & f.Start & "<br>"
response.write "Size: " & f.Length & "<br>"
Next
End Sub

Private Sub Upload()
Dim nCurPos, nDataBoundPos, nLastSepPos
Dim nPosFile, nPosBound
Dim sFieldName

'RFC1867 Tokens
Dim vDataSep
Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType
tNewLine = Byte2String(Chr(13))
tDoubleQuotes = Byte2String(Chr(34))
tTerm = Byte2String("--")
tFilename = Byte2String("filename=""")
tName = Byte2String("name=""")
tContentDisp = Byte2String("Content-Disposition")
tContentType = Byte2String("Content-Type:")

uploadedYet = true

VarArrayBinRequest = Request.BinaryRead(Request.TotalBytes)

nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc)

If nCurPos <= 1 Then Exit Sub

'vDataSep is a separator like -----------------------------21763138716045
vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1)

'Start of current separator
nDataBoundPos = 1

'Beginning of last line
nLastSepPos = FindToken(vDataSep & tTerm, 1)

Do Until nDataBoundPos = nLastSepPos

nCurPos = SkipToken(tContentDisp, nDataBoundPos)
nCurPos = SkipToken(tName, nCurPos)
sFieldName = ExtractField(tDoubleQuotes, nCurPos)

nPosFile = FindToken(tFilename, nCurPos)
nPosBound = FindToken(vDataSep, nCurPos)

If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile

nCurPos = SkipToken(tFilename, nCurPos)
sFileName = ExtractField(tDoubleQuotes, nCurPos)
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))

if (Len(oUploadFile.FileName) > 0) then 'File field not left empy
nCurPos = SkipToken(tContentType, nCurPos)

oUploadFile.ContentType = ExtractField(tNewLine, nCurPos)
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line

oUploadFile.Start = nCurPos-1
oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos

If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile
End If
Else
Dim nEndOfData
nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line
nEndOfData = FindToken(vDataSep, nCurPos) - 2
If Not FormElements.Exists(LCase(sFieldName)) Then FormElements.Add LCase(sFieldName), String2Byte(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos))
End If

'Advance to next separator
nDataBoundPos = FindToken(vDataSep, nCurPos)
Loop
StreamRequest.Write(VarArrayBinRequest)
End Sub

Private Function SkipToken(sToken, nStart)
SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
If SkipToken = 0 then
Response.write "Error in parsing uploaded binary request."
Response.End
end if
SkipToken = SkipToken + LenB(sToken)
End Function

Private Function FindToken(sToken, nStart)
FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
End Function

Private Function ExtractField(sToken, nStart)
Dim nEnd
nEnd = InstrB(nStart, VarArrayBinRequest, sToken)
If nEnd = 0 then
Response.write "Error in parsing uploaded binary request."
Response.End
end if
ExtractField = String2Byte(MidB(VarArrayBinRequest, nStart, nEnd-nStart))
End Function

' FileData used to be what is now midb(VarArrayBinRequest....)
' Public Sub SaveToDatabase(ByRef oField)
' If LenB(FileData) = 0 Then Exit Sub
'
' If IsObject(oField) Then
' oField.AppendChunk FileData
' End If
' End Sub

Public Function SaveBinRequest(path) ' For debugging purposes
StreamRequest.SaveToFile path & "debugStream.bin", 2
End Function

'String to byte string conversion
Private Function Byte2String(sString)
Dim i
For i = 1 to Len(sString)
Byte2String = Byte2String & ChrB(AscB(Mid(sString,i,1)))
Next
End Function

'Byte string to string conversion
Private Function String2Byte(bsString)
Dim i
String2Byte =""
For i = 1 to LenB(bsString)
String2Byte = String2Byte & Chr(AscB(MidB(bsString,i,1)))
Next
End Function
End Class

Class UploadedFile
Public ContentType
Public FileName
Public Start
Public Length
Public Path

Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
End Class
%>
<%


' ****************************************************
' Change the value of the variable below to the pathname
' of a directory with write permissions
Dim uploadsDirVar
uploadsDirVar =server.MapPath("upload_files/")
' ****************************************************


function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(uploadsDirVar) then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not exist.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
fileName = uploadsDirVar & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileName, true)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
on error goto 0
testFile.Close
fso.DeleteFile(fileName)
Err.Clear
on error resume next
Set streamTest = Server.CreateObject("ADODB.Stream")
If Err.Number<>0 then
TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."
exit function
end if
Set streamTest = Nothing
end function

function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey

Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)

SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
next
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
end function
%>

<HTML>
<HEAD>
<TITLE>Test Free ASP Upload</TITLE>
<style>
BODY {background-color: white;font-family:arial; font-size:12}
</style>
<script>
function onSubmitForm() {
var formDOMObj = document.frmSend;
if (formDOMObj.attach1.value == "" && formDOMObj.attach2.value == "" && formDOMObj.attach3.value == "" && formDOMObj.attach4.value == "" )
alert("Please press the browse button and pick a file.")
else
return true;
return false;
}
</script>

</HEAD>

<BODY>
<form name="frmSend" method="POST" enctype="multipart/form-data" action="uploadTester.asp" onSubmit="return onSubmitForm();">
File 1: <input name=attach1 type=file size=35><br>
File 2: <input name=attach2 type=file size=35><br>
File 3: <input name=attach3 type=file size=35><br>
File 4: <input name=attach4 type=file size=35><br>
<br>
<input style="margin-top:4" type=submit value="Upload">
</form>
<br><br>
<%
Dim diagnostics
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write "<div style=""margin-left:20; margin-top:30; margin-right:30; margin-bottom:30;"">"
response.write diagnostics
response.write "<p>After you correct this problem, reload the page."
response.write "</div>"
else
response.write "<div style=""margin-left:150"">"
response.write "</div>"
end if
else
response.write "<div style=""margin-left:150"">"
response.write SaveFiles()
response.write "<br><br></div>"
end if

%>
</BODY>
</HTML>











Yorumlar, eklemeler ve düşünceler
        Eline Sağlık....
İyide hocam FSO bi çok hosting firması tarafından desteklenmeyen bir bileşen
Sebep= Güvenlik Açığı. Kullanacak Olan arkaşların Dikkatine...

   ower2007, 29.10.2007 18:40
   güvenlik açığını host genel dizine verirse oluşur. User yetkilendirmesi de çok çok önemli. Paneli iyi seçmek lazım. FSO oldukça iyi şeyler için kullanabilirsiniz.

   hasanbilgehan, 07.11.2007 15:34
   Ben FSO güvensizdire katılmıyorum. Sen sunucunu iyi yapılandırırsan yetkileri bilinçli verirsen hiçbirşey yapamaz. Yapacak adamda zaten FSO ile uğraşmaz.

   KeFFeN.nf, 10.12.2009 21:40
© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin