<%@LANGUAGE="VBSCRIPT" CODEPAGE="1252"%> <%Option Explicit%> <% ' ----------------------------------GSG_ASP_Surf ---------------------------------- ' All these code written by Soroush Dalili from GSG group (IRSDL@YAHOO.COM) ' Copyright for Soroush Dalili 2005/23/02 But everybody can improve these codes for him/herself, just remember my name!:D ' GrayHatz.net ' GSG_ASP_Surf.asp?html$=[1,0]||filter$=[1,0]||down$=[1,0]||urlpath$=[Url] 0=False,1=True ' What's this? you can pass the web filters by this ASP file. just upload it in windows base host and execute it! ' PowerTools for : Send data by GET+POST, Added url encryption, Added password check ' Version Limitation : No logout button, Limitation about redirections, SSL ' Bugs: I know this file has some errors to get some scripts and also just send simple forms ' Report bugs to : IRSDL@YAHOO.COM ' All these code written by Soroush Dalili from GSG group, please respect to copyright ' Please send me your opinions and bugs ' Ver. history: 1.4-> get object name + fix to encode complete urls ' Ver. history: 1.3-> send POST data too ' Ver. history: 1.2-> set 2 mode for more protection: Limited and UnLimited ' Ver. history: 1.1-> passwrod protection was added + download simple files ' Ver. history: 1.0-> just browse simple URLs ' ----------------------------------GSG_ASP_Surf ---------------------------------- 'Drop below line if using free servers like Brinkster.com, by remove below line error handler will be disabled On Error Resume next Dim UsedFor,AllowFiles UsedFor = 0 ' 0 = unlimited (using html=[1,0]&filter=[1,0]&down=[1,0] options) || 1 = limited (only download allow files) AllowFiles = "zip,rar,ace,tar,pdf,doc,exe,txt,rtf,dll,com,bin,gz,z,arj,lzh,sit,hqx,tgz,ocx,vbx" ' This used when UsedFor = 1 LoginPassword = "1" ' Login password to load this page, if be empty it will be passed Dim TotalInput,TotalInputPOST,StrPassword,LoginPassword,PostStr,StrUrl,StrEncryptValue,xml,strHtml,IfFiltered,IfDownload,IfEnrypt,BrowserUrl,strHtmlContent,FileContent,FileName,FileType,SiteFullUrl,SiteUrl ' Encryption data separator StrEncryptValue = "+ENCRYPT+" ' Check for password If Session("GSG_ASP_Surf_Login") = "" And LoginPassword <> "" Then StrPassword = Request.Form("StrPass") If StrPassword = "" Then CheckPassword(0) If LoginPassword <> StrPassword Then CheckPassword(1) If LoginPassword = StrPassword Then Session("GSG_ASP_Surf_Login") = "yes" End if ' Get total input variable ' Get all query strings TotalInput = Trim(Request.ServerVariables("QUERY_STRING")) ' Get all posted data strings For each PostStr in Request.Form TotalInput = TotalInput & "||" & PostStr & "$=" & Request.Form(PostStr) & " " Next ' Get all posted data strings For each PostStr in Request.Form TotalInputPOST = TotalInputPOST & PostStr & "=" & Request.Form(PostStr) & "&" Next ' Check to select operation If Instr(lcase(TotalInput),"urlpath") = 0 then GetInputFunction() ' Actived when no data recieved Else InitOpenFile() ' Actived when recieve data End if ' ' Bring password form to get password Private Function CheckPassword(CheckPara) %> GSG_ASP_Surf ver 1.4 written by Soroush Dalili from GSG [GrayHatz.net]

<%if CheckPara = 1 then Response.Write("Invalid password!")%>

">
Password:
<% Response.End() End Function ' ' Input function :: Actived when no data recieved Private Function GetInputFunction() %> GSG_ASP_Surf ver 1.4 written by Soroush Dalili from GSG [GrayHatz.net] <%If UsedFor = 0 then%>

Don't forget using " / " at the end of a complete url. for ex: " www.yoursite.com/ "

" target="_blank">
Object:
URL:
Convert To Html Format:
If site was filtered:
Download source file:
<%ElseIf UsedFor = 1 Then%>

You can just download the file with these extensions: <%=AllowFiles%>

" target="_blank">
Object:
URL:
<%End if%> <% End Function ' 'Initial function Private Function InitOpenFile() Dim ObjName,InputDetails,FileNameCheck,FileTypeCheck Dim i IfFiltered = 0 IfDownload = 0 IfEnrypt = 0 ' Check data entry TotalInput = Split(TotalInput,"||") For i=0 to Ubound(TotalInput) If Instr(TotalInput(i),"$=") > 0 Then InputDetails = Split(TotalInput(i),"$=") Select case lcase(InputDetails(0)) case "objname" ObjName = InputDetails(1) case "urlpath" ' Get url path StrUrl = Trim(InputDetails(1)) case "html" ' Check if web page "1" means it's a web page strHtml = InputDetails(1) case "filter" ' Check if site was filtered If InputDetails(1) <> 1 Then IfFiltered = 0 Else IfFiltered = 1 case "down" ' Check download status If InputDetails(1) <> 1 Then IfDownload = 0 Else IfDownload = 1 case "encrypt" ' Check for encryption If InputDetails(1) <> 1 Then IfEnrypt = 0 Else IfEnrypt = 1 End Select End if Next ' Check StrUrl not empty If StrUrl = "" Then Response.Write("
can't find your url request
") Response.End() End if ' Decrypt input url If IfEnrypt Then StrUrl = DeCryptionUrl(StrUrl) End if ' Set encryption value empty if filter is not active If IfFiltered = 0 Then StrEncryptValue = "" ' Browser file address If IfFiltered then BrowserUrl = Request.ServerVariables("HTTP_REFERER") & "?html$=1||filter$=1||encrypt$=1||urlpath$=" Else BrowserUrl = "" End if ' Set url to true type -> Http://[url] or HTTPS://[URL] or FTP://[URL] if Not InStr(left(StrUrl,10),"://") > 0 Then StrUrl = "Http://" & StrUrl ' Find out file name and file type from url FileNameCheck = Split(StrUrl,"/") FileName = FileNameCheck(Ubound(FileNameCheck)) If FileName <> "" then If InStr(FileName,".") > 0 Then FileTypeCheck = Split(FileName,".") FileType = FileTypeCheck(Ubound(FileTypeCheck)) Else FileType = "" End if End if ' Check for allowed files If UsedFor Then Dim CheckedAllowFile AllowFiles = Split(AllowFiles,",") CheckedAllowFile = 0 For i=0 to UBound(AllowFiles) If AllowFiles(i) = FileType Then CheckedAllowFile = 1 Next If CheckedAllowFile <> 1 Then Response.Write("
Bad file extension! Click here to back
") Response.End() End if End if ' Find site full url like http://[url]/[folder]/[folder]/.../ If FileType <> "" Then For i=0 to Ubound(FileNameCheck) - 1 SiteFullUrl= SiteFullUrl & FileNameCheck(i) & "/" Next Else For i=0 to Ubound(FileNameCheck) SiteFullUrl= SiteFullUrl & FileNameCheck(i) & "/" Next End if ' Find site url like http://[url]/ For i=0 to 2 SiteUrl = SiteUrl & FileNameCheck(i) & "/" Next ' Create an xmlhttp object: If ObjName = 2 then Set xml = Server.CreateObject("Microsoft.XMLHTTP") Else Set xml = Server.CreateObject("MSXML2.XMLHTTP") End if ' Opens the connection to the remote server. xml.Open "Get", StrUrl, False xml.setRequestHeader "lastCached", now() xml.setRequestHeader "Content-Type","application/x-www-form-urlencoded" ' Actually Sends the request and returns the data: xml.Send TotalInputPOST ' Find out file content from header FileContent = xml.getResponseHeader("Content-Type") ' Check if file is not text file then download them Dim BinaryExt BinaryExt = "application,audio,video,x-world,message,drawing" BinaryExt = Split(BinaryExt,",") For i=0 to Ubound(BinaryExt) If instr(FileContent,BinaryExt(i)) > 0 Then IfDownload = 1 Exit For End if Next ' Used when this page open with limitation If UsedFor Then IfDownload = 1 BringThePage() Set xml = Nothing End Function ' 'This function change the web page to true html file for surfing Private Function ConvertToHtmlFunction() ' Replace src = "[something]" strHtmlContent = HtmlReplcaeString("src",0) ' Replace href = "[something]" strHtmlContent = HtmlReplcaeString("href",1) ' Replace background = "[something]" strHtmlContent = HtmlReplcaeString("background",0) ' Replace codebase = "[something]" strHtmlContent = HtmlReplcaeString("codebase",1) ' Replace url = "[something]" strHtmlContent = HtmlReplcaeString("url",1) ' Replace archive = "[something]" strHtmlContent = HtmlReplcaeString("archive",1) ' Replace action = "[something]" strHtmlContent = HtmlReplcaeString("action",1) strSize = len(strHtmlContent) ' ' Some pages still are not ready to surf yet because have "url('')" or some url with "Http://" so below lines replace them Dim StrChar,strHtmlContentTemp,end_of_url Dim i,strSize i = 1 ' Replace url('[url]') Do While i < strSize - 3 StrChar = Lcase(Mid(strHtmlContent,i,4)) i = i + 1 If StrChar = "url(" Then i = i + 3 Do While (Mid(strHtmlContent,i,1) = " " And i < strSize) i = i + 1 Loop If Mid(strHtmlContent,i,1) = """" or Mid(strHtmlContent,i,1) = "'" Then i = i + 1 ' By pass anchors If Mid(strHtmlContent,i,1) <> "#" And Not (Instr(lcase(Mid(strHtmlContent,i,12)),"javascript:") > 0 Or Instr(lcase(Mid(strHtmlContent,i,12)),"vbscript:") > 0) then 'Replace src url address If Mid(strHtmlContent,i,2) = "//" Then strHtmlContent = Mid(strHtmlContent,1,i-1) + "http://" + Mid(strHtmlContent,i+2,strSize-i+1) strSize = len(strHtmlContent) End if If Mid(strHtmlContent,i,1) = "/" Or Mid(strHtmlContent,i,1) = "\" Then strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(SiteUrl) & StrEncryptValue & Mid(strHtmlContent,i,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) Elseif Instr(Lcase(Mid(strHtmlContent,i,7)),"http://") = 0 And IfFiltered then strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(SiteFullUrl) & StrEncryptValue & Mid(strHtmlContent,i,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) Elseif Instr(Lcase(Mid(strHtmlContent,i,7)),"http://") <> 0 And IfFiltered then 'I wana find the url so I must find its last by below line Select case Mid(strHtmlContent,i-1,1) case "'","""" StrChar = Mid(strHtmlContent,i-1,1) case else StrChar = ")" end select end_of_url = Instr(Mid(strHtmlContent,i,strSize-i+1),StrChar) strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(Mid(strHtmlContent,i,end_of_url-1)) & StrEncryptValue & Mid(strHtmlContent,i+end_of_url-1,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) End if End if End if Loop ' ' Replace if find "Http://" and IfFiltered = true i=1 SiteUrl = "" Do While i < strSize - len(Request.ServerVariables("HTTP_REFERER")) And IfFiltered StrChar = Lcase(Mid(strHtmlContent,i,7)) If StrChar = "http://" And Lcase(Mid(strHtmlContent,i,len(Request.ServerVariables("HTTP_REFERER")))) <> Lcase(Request.ServerVariables("HTTP_REFERER")) Then i = i + 7 if i-8 < 1 then i = 9 select case Mid(strHtmlContent,i-8,1) case "'" , """" StrChar = Mid(strHtmlContent,i-8,1) end_of_url = Instr(Mid(strHtmlContent,i,strSize-i+1),StrChar) strHtmlContentTemp = Mid(strHtmlContent,1,i-8) & BrowserUrl & EnCryptionUrl(Mid(strHtmlContent,i,end_of_url-1)) & StrEncryptValue & Mid(strHtmlContent,i+end_of_url-1,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) case else 'Define in next version end select End if i = i + 1 Loop ConvertToHtmlFunction = strHtmlContent End Function ' ' Check for charachter replacement Private Function HtmlReplcaeString(ReplaceStr,ReplaceType) Dim strHtmlContentTemp,StrChar Dim i,strSize,ReplaceStrSize,end_of_url strSize = Len(strHtmlContent) ReplaceStrSize = Len(ReplaceStr) ' Replace type used for determine if convert to html needed or not If ReplaceType = 0 Then BrowserUrl = Replace(BrowserUrl,"html$=1","html$=0",1) Else BrowserUrl = Replace(BrowserUrl,"html$=0","html$=1",1) End if i = 1 Do While i < strSize - 3 StrChar = Lcase(Mid(strHtmlContent,i,ReplaceStrSize)) i = i + 1 If StrChar = ReplaceStr Then i = i + ReplaceStrSize - 1 Do While (Mid(strHtmlContent,i,1) = " " And i < strSize) i = i + 1 Loop If Mid(strHtmlContent,i,1) = "=" Then i = i + 1 Do While (Mid(strHtmlContent,i,1) = " " And i < strSize) i = i + 1 Loop If Mid(strHtmlContent,i,1) <> "#" And Not (Instr(lcase(Mid(strHtmlContent,i,12)),"javascript:") > 0 Or Instr(lcase(Mid(strHtmlContent,i,12)),"vbscript:") > 0) Then 'Jump if find javascript or vbscript If (Mid(strHtmlContent,i,1) = """" or Mid(strHtmlContent,i,1) = "'") Then i = i + 1 ' Replace src url address If Mid(strHtmlContent,i,2) = "//" Then strHtmlContent = Mid(strHtmlContent,1,i-1) + "http://" + Mid(strHtmlContent,i+2,strSize-i+1) strSize = len(strHtmlContent) End if If Mid(strHtmlContent,i,1) = "/" Or Mid(strHtmlContent,i,1) = "\" Then strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(SiteUrl) & StrEncryptValue & Mid(strHtmlContent,i,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) Elseif Instr(Lcase(Mid(strHtmlContent,i,7)),"http://") = 0 then strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(SiteFullUrl) & StrEncryptValue & Mid(strHtmlContent,i,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) Elseif Instr(Lcase(Mid(strHtmlContent,i,7)),"http://") <> 0 and IfFiltered then 'I wana find the url so I must find its last by below line if Mid(strHtmlContent,i-1,1) = "'" then end_of_url = Instr(Mid(strHtmlContent,i,strSize-i+1),"'") else end_of_url = Instr(Mid(strHtmlContent,i,strSize-i+1),"""") end if strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(Mid(strHtmlContent,i,end_of_url-1)) & StrEncryptValue & Mid(strHtmlContent,i+end_of_url-1,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) End if Elseif Mid(strHtmlContent,i,1) <> "" Then If Mid(strHtmlContent,i,2) = "//" Then strHtmlContent = Mid(strHtmlContent,1,i-1) + "http://" + Mid(strHtmlContent,i+2,strSize-i+1) strSize = len(strHtmlContent) End if If Mid(strHtmlContent,i,1) = "/" Or Mid(strHtmlContent,i,1) = "\" Then strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(SiteUrl) & StrEncryptValue & Mid(strHtmlContent,i,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) Elseif Instr(Lcase(Mid(strHtmlContent,i,7)),"http://") = 0 then strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(SiteFullUrl) & StrEncryptValue & Mid(strHtmlContent,i,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(SiteUrl) + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) Elseif Instr(Lcase(Mid(strHtmlContent,i,7)),"http://") <> 0 and IfFiltered then 'I wana find the url so I must find its last by below line if Instr(Mid(strHtmlContent,i,strSize-i+1)," ") > Instr(Mid(strHtmlContent,i,strSize-i+1),">") then end_of_url = Instr(Mid(strHtmlContent,i,strSize-i+1),">") else end_of_url = Instr(Mid(strHtmlContent,i,strSize-i+1)," ") end if strHtmlContentTemp = Mid(strHtmlContent,1,i-1) & BrowserUrl & EnCryptionUrl(Mid(strHtmlContent,i,end_of_url-1)) & StrEncryptValue & Mid(strHtmlContent,i+end_of_url-1,strSize-i+1) strHtmlContent = strHtmlContentTemp i = i + len(BrowserUrl) strSize = len(strHtmlContent) + len(BrowserUrl) End if End if End if End if End if Loop HtmlReplcaeString = strHtmlContent End Function ' ' Bring the page to the brwoser Private Function BringThePage() ' Last operation will be done below if IfDownload then strHtmlContent = xml.responseBody If FileType = "" Then FileName = "Unknown.txt" FileType = "application/octet-stream" End If Response.AddHeader "Content-Disposition","attachment;filename=" & FileName Response.ContentType = FileType Response.BinaryWrite(strHtmlContent) else If instr(FileContent,"image") Then strHtmlContent = xml.responseBody Response.BinaryWrite(strHtmlContent) Else strHtmlContent = xml.responseText If strHtml then strHtmlContent = ConvertToHtmlFunction() Response.Write(strHtmlContent) End if end if End Function ' ' This function used for encrypt url Private Function EnCryptionUrl(StrUrl) Dim StrUrlEn,StrUrlSize,i StrUrl = Replace(StrUrl,"\","/",1) StrUrl = Replace(StrUrl,"//","/",1) StrUrl = Replace(StrUrl,":/","://",1) If IfFiltered Then StrUrlSize = Len(StrUrl) For i=1 to StrUrlSize Randomize Timer StrUrlEn = StrUrlEn & Mid(StrUrl,i,1) & Chr(int(RND*27)+96) Next Else StrUrlEn = StrUrl End If EnCryptionUrl = StrUrlEn End Function ' ' This function used for decrypt url Private Function DeCryptionUrl(StrUrl) Dim StrUrlDe,StrUrlTemp,StrUrlSize,i StrUrlTemp = Split(StrUrl,StrEncryptValue) If Ubound(StrUrlTemp) = 1 Then StrUrlSize = Len(StrUrlTemp(0)) For i=1 to StrUrlSize Step 2 StrUrlDe = StrUrlDe & Mid(StrUrlTemp(0),i,1) Next StrUrlDe = StrUrlDe & StrUrlTemp(1) Else StrUrlDe = StrUrl End if StrUrlDe = Replace(StrUrlDe,"\","/",1) StrUrlDe = Replace(StrUrlDe,"//","/",1) StrUrlDe = Replace(StrUrlDe,":/","://",1) DeCryptionUrl = StrUrlDe End Function ' 'Error handler If err.number <> 0 Then Response.Write("
Error had occured! Maybe your address isn't valid or file isn't availabe, or XMLHTTP object was denied!
Main description: ") Response.Write(""&err.Description&"") Response.Write("
Soroush Dalili from GSG (GrayHatz security group)[GrayHatz.net] ©") End if %>