#1 2010-01-03 3:06 am

Mur

Member

From: Baton Rouge, LA

Registered: 2009-08-26

Posts: 44

Website

How to Setup Snitz 2000 Forums ASP Classic with StopForumSpam.Com

How to Setup Snitz 2000 Forums ASP Classic with StopForumSpam.Com
(This would be posted in the "How To" forums but it's locked.)

Support Update 1-26-2010: I'll be updating from my forums due to the lack of time I have. Some of the issues have been corrected but not posted here. Follow the MOD Support link for continued Snitz Forum SFS support.

This code function is free standing and can be inserted into any ASP server page but I will be referencing Snitz Forums.

MOD NAME: XCtMCheckSFS (Used with StopForumSpam.Com db)
MOD Date: 1-2-09 version 1.5 of the XCtM API pool
MOD Author: Mur (aka XCTech XtremeComputer.Com)
MOD Support: http://www.xtremecomputer.com/forum/top … PIC_ID=314
MOD Level: 2 (Very Easy)
MOD DB: None
MOD Pages: 2 (inc_func_member.asp , register.asp)

MOD Install:
inc_func_member.asp

Copy and paste the following 2 functions at the end of the inc_func_member.asp page.

<%

Function XCtMCheckSFS(ipAddress, emailAddress, Username)
    Dim strXCtMCheckSFS,strXCtMIP,strXCtMName,strXCtMEmail
    Dim urlA,urlB
    XCtMCheckSFS = 0
    strXCtMIP = ipAddress
    strXCtMName = LCase(Username)
    strXCtMEmail = LCase(emailAddress)
 
    urlA = "http://www.stopforumspam.com/api"
    urlB = "?ip="&strXCtMIP&""

    If Len(strXCtMEmail) <> 0 Then
        urlB = urlB & "&email="&strXCtMEmail&""
    End If
    If Len(strXCtMName) <> 0 Then
        urlB = urlB & "&username="&strXCtMName&""
    End If
    urlA = urlA & urlB

Set xmlObj = Server.CreateObject("MSXML2.FreeThreadedDOMDocument")
    xmlObj.async = False
    xmlObj.setProperty "ServerHTTPRequest", True
    xmlObj.Load(urlA)
    If xmlObj.parseError.errorCode <> 0 Then
         toReturn = toReturn & "RSS FEED to SFS Failed or is Temporarily Unavailable <em>(" _
         & xmlObj.parseError.reason&")</em><br />"&urlA&"<br />"
        '# Some error handling code here. Use your mail.asp if you would like. 
        '# Response.Write(""&toReturn&"")
    End If
Set xmlList = xmlObj.getElementsByTagName("type")
sLoopCounter = 0
    For Each xmlItem In xmlList
        If sLoopCounter >= 3 Then Exit For
            If Len(strXCtMIP) <> 0 Then
                sIpHit = xmlObj.getElementsByTagName("type").item(0).text
                sIpCount = cLng(xmlObj.getElementsByTagName("frequency").item(0).text)
'#                 sIpHitSeen = xmlObj.getElementsByTagName("lastseen").item(0).text
                sIpHitAppears = xmlObj.getElementsByTagName("appears").item(0).text
            End If
            If Len(strXCtMEmail) <> 0 Then
                sEmailHit = xmlObj.getElementsByTagName("type").item(1).text
                sEmailCount = cLng(xmlObj.getElementsByTagName("frequency").item(1).text)
'#                sEmailSeen = xmlObj.getElementsByTagName("lastseen").item(1).text
                sEmailAppears = xmlObj.getElementsByTagName("appears").item(1).text
            End If
            If Len(strXCtMName) <> 0 Then
                sUserNameHit = xmlObj.getElementsByTagName("type").item(2).text
                sUserNameCount = cLng(xmlObj.getElementsByTagName("frequency").item(2).text)
'#                sUserNameSeen = xmlObj.getElementsByTagName("lastseen").item(2).text
                sUserNameAppears = xmlObj.getElementsByTagName("appears").item(2).text
            End If

sLoopCounter = sLoopCounter + 1
   Next
Set xmlList = Nothing
Set xmlObj = Nothing

'#####################
'# Score your Visitor.
'# in this code only Username, IP and Email are used to score.
'# With the Appears return you can use the Proxy check
'# script to check for new spammers. Read the support link
'# You can set up any type of scoring you would like. 
'#####################
If sIpCount > 1 Then
    XCtMCheckSFS = 10
End If

If sEmailCount > 1 And sIpCount = 0 Then
    XCtMCheckSFS = 5
End If

If sUserNameCount > 1 And sEmailCount = 0 And sIpCount = 0 Then
    XCtMCheckSFS = 1
End If
'# used later in register page to set PENDING_MEMBER strRestrictReg = 1
strXCtMCheckSFS = XCtMCheckSFS
'#####################
'# End Scoring
'#####################


If XCtMCheckSFS >= 5 Then
'######################################
'# Notify Admin / Moderators
'# I have this set to email me a notice.
'# You can do what you want here. 
'#######################################
 strSubject = "SFS Score ("&strXCtMCheckSFS&") XCtM v1.5" 
 strEmailBody = ""
 strEmailBody = strEmailBody & "Report Time: "&Now() &vbCrLf
 strEmailBody = strEmailBody & "Member Sign up from: " &strForumTitle&""  &vbCrLf
 strEmailBody = strEmailBody & "Site URL: "&strForumURL&""  &vbCrLf
 strEmailBody = strEmailBody & "Spam Score: SFS ("&strXCtMCheckSFS&") "  &vbCrLf
 strEmailBody = strEmailBody & "User Agent: " & Request.ServerVariables("HTTP_USER_AGENT") &vbCrLf
 strEmailBody = strEmailBody & "Username: " & Username  &vbCrLf
 strEmailBody = strEmailBody & "Email: " & emailAddress  &vbCrLf
 strEmailBody = strEmailBody & "IP: " & ipAddress  &vbCrLf
 '# with Proxy Mod Only: strEmailBody = strEmailBody & "Proxy: "&strXCtMProxyCheck&""
 strEmailBody = strEmailBody & vbcrlf & ""
 strEmailBody = strEmailBody & vbcrlf & "API Error if any: "&toReturn&""
 strEmailBody = strEmailBody & vbcrlf & "StopForumSpam.Com Test Link: http://www.stopforumspam.com/api?username="&Username&"&ip=" & strXCtMIP & "&email="&emailAddress&""
 strEmailBody = strEmailBody & vbcrlf & ""

'#     strRecipientsName = "Your Name"
'#     strRecipients = "Your Mod or Admins Name"
'#     strFrom = strSender
'#     strFromName = strForumTitle
     strsubject = strSubject & strForumTitle & " SFS Spam Report "
     strMessage = "Hello " & strRecipients & vbNewline & vbNewline
     strMessage = strMessage & strEmailBody
'# 
'# Setup your mail.asp to handle notification
 End If

End Function

%>
<%
Function SFSIP()
'# Required for Proxy Lookup and other XCtM Mods.

    strSFSIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    if strSFSIP = "" or Left(strSFSIP, 7) = "unknown" then
        strSFSIP = Request.ServerVariables("REMOTE_ADDR")
    elseif InStr(strSFSIP, ",") > 0 then
        strSFSIP = Left(strSFSIP, InStr(strSFSIP, ",")-1)
    elseif InStr(strSFSIP, ";") > 0 then
        strSFSIP = Left(strSFSIP, InStr(strSFSIP, ";")-1)
    end if
    if InStr(strSFSIP, ":") > 0 then
        strSFSIP = Left(strSFSIP, InStr(strSFSIP, ":")-1)
    end if
SFSIP = strSFSIP
End Function
%>

Other free standing IP look up scripts can be found at the forum support link.

MOD PAGE register.asp

Paste at the end of the Error Checking about line 430 where you find

            if Request.Form("Password") <> Request.Form("Password2") then

Paste this ..

        If XCtMCheckSFS(SFSIP(), Request.Form("Email"), Request.Form("Name")) >= 10 Then
                strRestrictReg = 1
                        Err_Msg = Err_Msg & "<li>Seems you have a spam score of 5 or more.<br />"
                        Err_Msg = Err_Msg & "We have restricted your access and notified the forums manager. <br />"
                        Err_Msg = Err_Msg & "If this was in error we will email you and correct the issue. <br />"
                        Err_Msg = Err_Msg & "Otherwise you may contact us requesting access.<br />"
                        Err_Msg = Err_Msg & "Visit (enter link) for more information.<br />"
'# Setup your notification here. Call SendForumEmail(SFSIP(), Request.Form("Email"), Request.Form("Name"),5,Err_Msg)    
        End If

You can change the scoring to match your site better.
In this case a score of 10 stops the registration completely.

You can stop the registration process here without additional action.
I suggest you use a send email call to notify admins and moderators.

Developers Notes:
Update: 1-3-2010 Issue:

<lastseen>2010-01-03 13:25:38</lastseen>

I have commented out the return date because of formating.
I'll setup a fuction to handle the date formating in epoch.
The ASP script will not return the results because of this line.
End Update:
==================

That's the very simple method to stop forum spam using Snitz 2000 Forums (any version) with StopForumSpam.Com.

Have Fun running Snitz Forums Spam Free with the Help from StopForumSpam.Com.

Check out the Proxy Detect API for Snitz as well.
It might help you add points to your scoring system.

Last edited by Mur (2010-01-26 10:11 pm)

---

Do something creative today, code something.

pedigree

uıɐbɐ ʎɐqǝ ɯoɹɟ pɹɐoqʎǝʞ ɐ buıʎnq ɹǝʌǝu ɯ,ı

From: New Zealand

Registered: 2008-04-16

Posts: 7,100

Re: How to Setup Snitz 2000 Forums ASP Classic with StopForumSpam.Com

Great Mur

i should add, that people using the API, should not make an api call when establishing a connection etc, they should only make a test when new users, new posts etc are made.

Ill move this thread over to the howto shortly Mur.  Thanks!!!!!!

Mur

Member

From: Baton Rouge, LA

Registered: 2009-08-26

Posts: 44

Website

Re: How to Setup Snitz 2000 Forums ASP Classic with StopForumSpam.Com

Great Mur

i should add, that people using the API, should not make an api call when establishing a connection etc, they should only make a test when new users, new posts etc are made.

Absolutely!

The line of code...

       If XCtMCheckSFS(SFSIP(), Request.Form("Email"), Request.Form("Name")) >= 10 Then
....

... is what triggers the function and should only be in the Register page.
It is not necessary to check the member at any other time in Snitz or any forum application.

The statistical numbers speak louder on this subject.

With 48,000 plus sign up attempts only about 10 were actually human.
Out of the 10 a few were discovered by the proxy and the others from just me checking the IPs network at sign up as compared to the last seen IPs network.
This feature is standard with Snitz and other forums.

---

Do something creative today, code something.

Mur

Member

From: Baton Rouge, LA

Registered: 2009-08-26

Posts: 44

Website

Re: How to Setup Snitz 2000 Forums ASP Classic with StopForumSpam.Com

I was testing out some new reporting scripts for Snitz and started noticing errors in the ASP code when the <lastseen>2009-11-13 17:55:25</lastseen> field was omitted due to 0 data length.

I'm not sure why I didn't notice that before.

Anyway, I have a work around in the second ASP and Snitz forum code.

If you use the code above don't enable the "Lastseen" I'll update that code after I test out the functions again.

On Error Resume Next

I hate that line.

---

Do something creative today, code something.

Mur

Member

From: Baton Rouge, LA

Registered: 2009-08-26

Posts: 44

Website

Re: How to Setup Snitz 2000 Forums ASP Classic with StopForumSpam.Com

Because the code above does work I'm not going to edit it.
The LastSeen Line you can handle with On Error Resume Next.
Updated: 1-16-2010 (evening)
1. Corrected email score
2. Set most common proxy

Updated: 1-16-2010
Updates:
1. Cleaned out demo code.
2. Changed date lastseen to display only days
3. Set scoring options a little more flexible.
4. If Last Seen past xx days then lower scores but score anyway.
5. Mod Support Link

Summary:
This single function call can be placed into any common include file or directly in your Register page. For Snitz users this is your inc_func_members.asp page. 
Scores can can be set to suite your needs.
This is ideal for those that have several types of logins which need to be more flexible with scoring.
The proxy test ports are what I have seen over the past 60 days.
Use the output to set Pending Approval in your register.asp page, notify Admin and Moderators or ban directly.
I should have the .Net and PHP versions completed this week if I can schedule things around what I have.

#####

This code offers Checks based on Submission Date / Time as well as comparing to Email, IP, Username.

In addition you can check for proxy connections on all requests or specific requests by placing the proxy test call within the section you wish to call it.

Here's the Demo Link which is live so please be nice to my shared IP.
sfsip=127.0.0.1
sfsem=email
sfsnm=username
proxy=1 (1 = Check, 0 = Skip)
demo=1 (1 = load demo Email,IP,Username)

Limited Time Demo

I'll be removing this page in a couple of days.

As always support is within my forums under the XCtM Project group.
Questions, suggestions, comments are always welcome.

It's long but it's cool with the results.

'# Call the application.
'# This is what you place into your Register.asp page. 
'# It should look like

'# Page: Register.asp
If XCtMCheckSFS(strTestIP,strTestEmail,strTestName) >= 100 Then
'# do something here like Err_Msg: then Response.End (stop)
End If

'# Page: inc_func_member.asp
'# Paste this at the bottom

Function XCtMCheckSFS(sipAddress2, semailAddress2, sUsername2)
Dim sResolveSFS, sConnectSFS, sSendSFS, sReceiveSFS
    Dim strXCtMIP,strXCtMName,strXCtMEmail
    Dim urlAForum,urlBForum
    Dim strIPScore
    Dim strEmailScore
    Dim strUserNameScore
    Dim sLoopCounter
    Dim strXCtMFinalScore

'# 1 = IP
'# 2 = Email
'# 3 = Username
Dim strSFSType1(1),strSFSAppears1(1),strSFSLastSeen1(1),strSFSFrequency1(1)
Dim strSFSType2(2),strSFSAppears2(2),strSFSLastSeen2(2),strSFSFrequency2(2)
Dim strSFSType3(3),strSFSAppears3(3),strSFSLastSeen3(3),strSFSFrequency3(3)

    strXCtMFinalScore = 0
    strXCtMIP = Trim(sipAddress2)
    strXCtMName = Trim(LCase(sUsername2))
    strXCtMEmail = Trim(LCase(semailAddress2))

    urlAForum = "http://www.stopforumspam.com/api"
    urlBForum = "?ip="&strXCtMIP&""

    If Len(strXCtMEmail) <> 0 Then
        urlBForum = urlBForum & "&email="&strXCtMEmail&""
    End If
    If Len(strXCtMName) <> 0 Then
        urlBForum = urlBForum & "&username="&strXCtMName&""
    End If
    urlAForum = urlAForum & urlBForum

     Set objHTTPSFS = Server.CreateObject("WinHTTP.WinHTTPRequest.5.1")
'    objHTTPSFS.SetProxy 2, RSSURL2SFS
    sResolveSFS = 5 * 1000
    sConnectSFS = 5 * 1000
    sSendSFS = 15 * 1000
    sReceiveSFS = 15 * 1000
     objHTTPSFS.SetTimeouts sResolveSFS, sConnectSFS, sSendSFS, sReceiveSFS
    objHTTPSFS.open "GET",urlAForum,false
'   objHTTPSFS.setRequestHeader "X-Proxy-Content", cache_key
'   objHTTPSFS.setRequestHeader "X-Proxy-Status", objHTTP.proxy.status
    objHTTPSFS.setRequestHeader "Content-Type", "text/html; charset=utf-8"
    objHTTPSFS.setRequestHeader "User-Agent", "xctm/1.6 (compatible; Win32; info http://www.xtremecomputer.com/developers.asp v1.6)"
    objHTTPSFS.send
    objHTTPSFS.WaitForResponse(4)
    strFeedStatus = objHTTPSFS.status
    if Err.Number <> 0 Or strFeedStatus <> 200 then
           sDebug = sDebug & "Error Detected API XCtM v5 Client!" & vbcrlf
           If Len(Err.Number) <> 0 Then
           sDebug = sDebug & "Err: " & Err.Number & vbcrlf
            sDebug = sDebug & "Desc: " & Err.Description & vbcrlf
            End If
            sDebug = sDebug & "Feed Status: " & strFeedStatus & vbcrlf
            sDebug = sDebug & "Timeouts: Resolve "&sResolveSFS&", Connect "&sConnectSFS&", Send "&sSendSFS&", Receive "&sReceiveSFS&"" & vbcrlf
            sDebug = sDebug & "URL: " & urlAForum & vbcrlf
'# Error handling option
'#           Call FeedDownReport(sDebug)
'#    Response.Write("Debug RSS Feed A:115 "&sDebug&"")
    end if

    RSSFeedSFS = objHTTPSFS.responseText
    Set xmlRSSFeedSFS = Server.CreateObject("MSXML2.DomDocument.5.0")
    xmlRSSFeedSFS.async = false
    xmlRSSFeedSFS.LoadXml(RSSFeedSFS)
    Set objHTTPSFS = Nothing
    
    Set objItemsSFS = xmlRSSFeedSFS.getElementsByTagName("response")
    Set xmlRSSFeedSFS = Nothing

    For x = 0 to objItemsSFS.length - 1
    sLoopCounterSFS = 0
        Set objItemSFS = objItemsSFS.item(x)
        For Each objChildSFS in objItemSFS.childNodes
        sCounterSFS = sCounterSFS + 1
            If LCase(objChildSFS.nodeName) = "type" Then
                sLoopCounterSFS = sLoopCounterSFS + 1
            End If

            Select Case LCase(objChildSFS.nodeName) & sLoopCounterSFS
                Case "type1"
                strSFSType1(1) = objChildSFS.text
                Case "appears1"
                strSFSAppears1(1) = objChildSFS.text
                Case "lastseen1"
                strSFSLastSeen1(1) = objChildSFS.text
                Case "frequency1"
                strSFSFrequency1(1) = objChildSFS.text
                Case "type2"
                strSFSType2(2) = objChildSFS.text
                Case "appears2"
                strSFSAppears2(2) = objChildSFS.text
                Case "lastseen2"
                strSFSLastSeen2(2) = objChildSFS.text
                Case "frequency2"
                strSFSFrequency2(2) = objChildSFS.text
                Case "type3"
                strSFSType3(3) = objChildSFS.text
                Case "appears3"
                strSFSAppears3(3) = objChildSFS.text
                Case "lastseen3"
                strSFSLastSeen3(3) = objChildSFS.text
                Case "frequency3"
                strSFSFrequency3(3) = objChildSFS.text

            End Select
        Next
    Next
Set objItemSFS = Nothing    
Set objItemsSFS = Nothing

'# Because our score card needs all data returned lets pad some stuff if missing
'# IP info
If Len(strSFSType1(1)) = 0 Then
strSFSType1(1) = "ip"
End If
If Len(strSFSAppears1(1)) = 0 Then
strSFSAppears1(1) = "no"
End If
If Len(strSFSLastSeen1(1)) < 10 Then
strSFSLastSeen1(1) = URLEncode("1899-01-01+00:00:00")
End If
If Len(strSFSFrequency1(1)) = 0 Then
strSFSFrequency1(1) = 0 
End If
'# Email info
If Len(strSFSType2(2)) = 0 Then
strSFSType2(2) = "email"
End If
If Len(strSFSAppears2(2)) = 0 Then
strSFSAppears2(2) = "no"
End If
If Len(strSFSLastSeen2(2)) < 10 Then
strSFSLastSeen2(2) = URLEncode("1899-01-01+00:00:00")
End If
If Len(strSFSFrequency2(2)) = 0 Then
strSFSFrequency2(2) = 0 
End If
'# Username info
If Len(strSFSType3(3)) = 0 Then
strSFSType3(3) = "username"
End If
If Len(strSFSAppears3(3)) = 0 Then
strSFSAppears3(3) = "no"
End If
If Len(strSFSLastSeen3(3)) < 10 Then
strSFSLastSeen3(3) = URLEncode("1899-01-01+00:00:00")
End If
If Len(strSFSFrequency3(3)) = 0 Then
strSFSFrequency3(3) = 0 
End If

'# Setup to Score the visitor by offer all zero points
strIPScore = 0
strEmailScore = 0
strUserNameScore = 0

'# Lets get our Last Seen dates even if its 111 years ago
strIPLastSeenDaysAgo = LastSeenDaysAgo(URLDecode2(strSFSLastSeen1(1)))
strEmailLastSeenDaysAgo = LastSeenDaysAgo(URLDecode2(strSFSLastSeen2(2)))
strUserNameLastSeenDaysAgo = LastSeenDaysAgo(URLDecode2(strSFSLastSeen3(3)))

'# If over 100 years ago lets default to 0 for never seen we will use 1 for seen that day
If strIPLastSeenDaysAgo > 42000 Then
strIPLastSeenDaysAgo = 0
ElseIf strIPLastSeenDaysAgo = 0 Then
strIPLastSeenDaysAgo = 1
End If 
If strEmailLastSeenDaysAgo > 42000 Then
strEmailLastSeenDaysAgo = 0
ElseIf strEmailLastSeenDaysAgo = 0 Then
strEmailLastSeenDaysAgo = 1
End If 
If strUserNameLastSeenDaysAgo > 42000 Then
strUserNameLastSeenDaysAgo = 0
ElseIf strUserNameLastSeenDaysAgo = 0 Then
strUserNameLastSeenDaysAgo = 1
End If 

'#### Score stuff now #####
'# You have to setup your scoring to match your site. 
'# I have 5 sites with 2 different logins which score differently. 
'# You will have to to test things and make adjustments to suite your needs.

'# IP is listed at StopForumSpam.Com and days are less than 60 lets give this a score we can use.
If strSFSFrequency1(1) > 0 And strIPLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 50
    strIPScore = strIPScore + 50
End If

'# Email is Listed and IP not listed and seen within 60 days lets score this.
If strSFSFrequency2(2) > 0 And strSFSFrequency1(1) = 0 And strEmailLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 50
    strEmailScore = strEmailScore + 50
End If

'# Email and IP are listed and its under 60 days for both lets score this
If strSFSFrequency2(2) > 0 And strSFSFrequency1(1) > 0 And strEmailLastSeenDaysAgo < 60 And strIPLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 50
    strEmailScore = strEmailScore + 50
    strIPScore = strIPScore + 50
End If
    
'# Username is a hit without email and IP lets score this
If strSFSFrequency3(3) > 0 And strSFSFrequency2(2) = 0 And strSFSFrequency1(1) = 0 And strUserNameLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 1
    strUserNameScore = strUserNameScore + 1
End If

'# Username and IP are both hits and under 60 days then lets add a score
If strSFSFrequency3(3) > 0 And strSFSFrequency1(1) > 0 And strUserNameLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 50
    strIPScore = strIPScore + 50
    strUserNameScore = strUserNameScore + 50
End If
'# IP, Email and Username both are hits and under 60 days lets score this to the max, If Only email seen under 60 days lower score.
If strSFSFrequency1(1) >= 1 And strSFSFrequency2(2) >= 1 And strSFSFrequency3(3) >= 1 Then
    If strIPLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 50
    strIPScore = strIPScore + 50
    ElseIf strUserNameLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 50
    strUserNameScore = strUserNameScore + 50
    ElseIf strEmailLastSeenDaysAgo < 60 Then
    strXCtMFinalScore = strXCtMFinalScore + 50
    strEmailScore = strEmailScore + 50
    End If
End If

'## ADD the PROXY CHECK!
'# Proxy check
'# Comment this out if you can careless about proxy connections.
If strTestProxy = 1 Then
strXCtMProxyCheckPort = XCtMProxyCheck(strXCtMIP,"www.google.com")

'# Score with Proxy
    If strXCtMProxyCheckPort = 0 Then
'# Output message for your notification system
        strXCtMProxyCheck = "Proxy Results (" & strXCtMProxyCheckPort & ") no proxy detected."
    ElseIf strXCtMProxyCheckPort >= 1 Then
'# Output message for your notification system
        strXCtMProxyCheck = "Proxy Results (Port: " & strXCtMProxyCheckPort & ") proxy detected! Recalculating Scores"
'# Proxy type of connection found recalculate the scores by adding to what you scored so far
            If strXCtMProxyCheckPort > 0 Then
            '# I use this in my forums but in 2 of my sites that do not allow proxy connections 
            '# I up the scores to 100 and trigger the stop.
                strXCtMFinalScore = strXCtMFinalScore + 25
                strEmailScore = strEmailScore + 25
                strUserNameScore = strUserNameScore + 25
                strIPScore = strIPScore + 25
            End If
    Else
'# Output message for your notification system
        strXCtMProxyCheck = "Proxy Test Option Disabled"        
    End If
End If
'#####################
'# End Scoring
'#####################

'## SETUP your Client Side Output and your Admin Moderator notification email

If Len(strForumTitle) = 0 Then
strForumTitle = "Your Forum Title"
End If
If Len(strForumURL) = 0 Then
strForumURL = "www.yourforumdomain.com"
End If
If Len(strXCtMProxyCheck) = 0 Then
strXCtMProxyCheck = "Proxy Check Mod Not Enabled"
End If
If Len(sAIPError) = 0 Then
sAIPError = "No API Errors Detected"
End If

'If XCtMCheckSFS >= 50 Then
'######################################
'# Notify Admin / Moderators
'# I have this set to email me a notice.
'# You can do what you want here. 
'#######################################
strSubject = "Snitz Forums SFS Score ("&strXCtMFinalScore&") XCtM v1.6b" 
 strEmailBody = ""&vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Report Time: "&Now() &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "StopForumSpam.Com Scores: IP: ("&cLng(strSFSFrequency1(1))&") Email: ("&cLng(strSFSFrequency2(2))&") UserName: ("&cLng(strSFSFrequency3(3))&") "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "XCtM 1.6b Scores: IP: ("&cLng(strIPScore)&") Email: ("&cLng(strEmailScore)&") UserName: ("&cLng(strUserNameScore)&") "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Member Sign up from: " &strForumTitle&""  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & ""
 strEmailBody = strEmailBody &vbCrLf & "XCtM IP Score: "&strIPScore&""  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Reported to SFS "&strSFSFrequency1(1)&" times. "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Reported "&strIPLastSeenDaysAgo&" days ago. "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Last seen date "&URLDecode2(strSFSLastSeen1(1))&" GMT"  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & ""
 strEmailBody = strEmailBody &vbCrLf & "XCtM Email Score: "&strEmailScore&""  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Reported to SFS "&strSFSFrequency2(2)&" times. "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Reported "&strEmailLastSeenDaysAgo&" days ago. "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Last seen date "&URLDecode2(strSFSLastSeen2(2))&" GMT"  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & ""
 strEmailBody = strEmailBody &vbCrLf & "XCtM Username Score: "&strUserNameScore&""  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Reported to SFS "&strSFSFrequency3(3)&" times. "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Reported "&strUserNameLastSeenDaysAgo&" days ago. "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Last seen date "&URLDecode2(strSFSLastSeen3(3))&" GMT"  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & ""
 strEmailBody = strEmailBody &vbCrLf & "Site URL: "&strForumURL&""  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Spam Score Final: ("&strXCtMFinalScore&") "  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "User Agent: " & Request.ServerVariables("HTTP_USER_AGENT") &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Username: " & strXCtMName  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Email: " & strXCtMEmail  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "IP: " & strXCtMIP  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "Proxy: "&strXCtMProxyCheck&""
 strEmailBody = strEmailBody &vbCrLf & "Data Returned from www.StopForumSpam.Com : "
 strEmailBody = strEmailBody &vbCrLf & ""&RSSFeedSFS&""
 strEmailBody = strEmailBody & ""  &vbCrLf
 strEmailBody = strEmailBody &vbCrLf & "API Error if any: "&sAIPError&""
 strEmailBody = strEmailBody &vbCrLf & "StopForumSpam.Com Test Link: http://www.stopforumspam.com/api?username="&strXCtMName&"&ip=" & strXCtMIP & "&email="&strXCtMEmail&""
 strEmailBody = strEmailBody &vbCrLf & "This is the output from the  API using StopForumSpam.Com."
 strEmailBody = strEmailBody &vbCrLf & "This API is designed for Snitz Forums but can be placed into any flavor of ASP."
 strEmailBody = strEmailBody &vbCrLf & "Support Link: <a href=""http://www.xtremecomputer.com/forum/topic.asp?TOPIC_ID=314"">http://www.xtremecomputer.com/forum/topic.asp?TOPIC_ID=314</a>"

'#     strRecipientsName = "Your Name"
     strRecipients = "Admin and Moderator!"
'#     strFrom = strSender
'#     strFromName = strForumTitle
     strsubject = strSubject & strForumTitle & " SFS Spam Report "
     strMessage = "Hello " & strRecipients & vbNewline & vbNewline
     strMessage = strMessage & strEmailBody
'# End If

'# Test and Debug output 
 Response.Write("XCTech XCtM Check SFS API Email Notice Demo Page.")
 Response.Write("<form>" & vbcrlf)
 Response.Write("<textarea rows=""5"" cols=""70"">"&strSubject&"</textarea>")
 Response.Write("<textarea rows=""25"" cols=""70"">"&strMessage&"</textarea>")
 Response.Write("</form>" & vbcrlf)
'XCtMCheckSFS = strXCtMFinalScore

End Function

'# Call XCtMProxyCheck("130.105.36.54","www.google.com")
Function XCtMProxyCheck(sIPx,sDSx)
Dim sProxyResolve, sProxyConnect, sProxySend, sProxyReceive
Dim strProxyPorts 'Proxy Ports
Dim strProxyURL 'Members IP address
Dim strDestURL 'The website use to test. Do not use your own site unless you are on a static IP.
Dim strXCtMTestURL
Dim strXCtMProxyCheck
XCtMProxyCheck = 0
'# Enable as many ports as you wish to test
strProxyPorts = "80,1080,3124,3128,8000,8008,8080,8085,9090,9483,17941,46769,47859,48703"
'strProxyPorts = "80,88,110,443,444,808,1080"
'strProxyPorts = strProxyPorts & ",2003,2680,3124,3127,3128,2232,3862,5555"
'strProxyPorts = strProxyPorts & ",5566,6588,8000,8001,8008,8080,8081,8085"
'strProxyPorts = strProxyPorts & ",8086,8087,8088,8090,8118,8135,8888,9000"
'strProxyPorts = strProxyPorts & ",9090,9483,17941,46769,47859,48703"
strDestURL = sDSx
KnownProxyPorts = Split(strProxyPorts,",")
    for i = 0 to ubound( KnownProxyPorts )
strProxyURL = sIPx&":"& KnownProxyPorts(i)
strXCtMTestURL = "http://"&strDestURL
'# short timeouts are best. Most proxy servers have fast response times and this will spend up tests
     Set objHTTP = Server.CreateObject("WinHTTP.WinHTTPRequest.5.1")
    objHTTP.SetProxy 2, strProxyURL
    '# SetTimeouts is Resolve, Connect, Receive, Send  
    sProxyResolve = 2 * 1000
    sProxyConnect = 2 * 1000
    sProxySend = 5 * 1000
    sProxyReceive = 5 * 1000
     objHttp.SetTimeouts sProxyResolve, sProxyConnect, sProxySend, sProxyReceive
    objHTTP.open "GET",strXCtMTestURL,false
    objHTTP.setRequestHeader "Content-Type", "text/html; charset=utf-8"
    objHTTP.setRequestHeader "User-Agent", "MurZilla/1.0(compatible; Win32; XCtM Project Forum Proxy Test http://www.xtremecomputer.com/forum/forum.asp?FORUM_ID=118)"
    On Error Resume Next 'it happens
    objHTTP.send
    objHTTP.WaitForResponse(2)
    status = objHTTP.status
    If status <> 0 Then
'#    Call XCtM_AddToMemberDetails(strProxyURL) 'You can create a function to add this to the URL column.
'#    Response.Write("Proxy Status: "&status&" URL: "&strProxyURL&"")
'#     Response.Flush
    XCtMProxyCheck = KnownProxyPorts(i)
    Exit For
    End If
    Set objHTTP = Nothing
Next
End Function

'# Mod from Snitz to a call function other methods of pulling IPs are listed in the forums
Function SFSIP()
    strSFSIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    if strSFSIP = "" or Left(strSFSIP, 7) = "unknown" then
        strSFSIP = Request.ServerVariables("REMOTE_ADDR")
    elseif InStr(strSFSIP, ",") > 0 then
        strSFSIP = Left(strSFSIP, InStr(strSFSIP, ",")-1)
    elseif InStr(strSFSIP, ";") > 0 then
        strSFSIP = Left(strSFSIP, InStr(strSFSIP, ";")-1)
    end if
    if InStr(strSFSIP, ":") > 0 then
        strSFSIP = Left(strSFSIP, InStr(strSFSIP, ":")-1)
    end if
SFSIP = strSFSIP
End Function

Function LastSeenDaysAgo(sDate3)
If Len(sDate3) < 10 Then
sDate3 = URLEncode("1899-01-01+00:00:00")
End If

If InStr(sDate3,"+") > 0 Then
sDate3 = Replace(sDate3,"+"," ")
End If
Dim Year3, Month3, Day3, Quarter3, DayOfYear3, WeekDay3, WeekOfYear3, Hour3, Minute3, Second3,strCountDays3
Year3 =    DatePart("yyyy", sDate3)
sYear3 =    DatePart("yyyy", Date())
Month3 = DatePart("m", sDate3)
Day3 = DatePart("d", sDate3)
Quarter3 = DatePart("q", sDate3)
DayOfYear3 = DatePart("y", Month3&"/"&Day3&"/"&Year3)
sDayOfYearNow3 = DatePart("y",Date())
WeekDay3 = DatePart("w", sDate3)
WeekOfYear3 = DatePart("ww", sDate3)
Hour3 = DatePart("h", sDate3)
Minute3 = DatePart("n", sDate3)
Second3 = DatePart("s", sDate3)
        If Len(Month3) = 1 Then
            Month3 = "0" & Month3
        End If
        If Len(Day3) = 1 Then 
            Day3 = "0" & Day3
        End If
        If Len(Hour3) = 1 Then
            Hour3 = "0" & Hour3
        End If
        If Len(Minute3) = 1 Then
            Minute3 = "0" & Minute3
        End If
        If Len(Second3) = 1 Then
            Second3 = "0" & Second3
        End If
If Year3 = sYear3 Then
strSameYear3 = 0
End If
If Year3 = (sYear3-1) Then
strSameYear3 = 1
End If
If Year3 < (sYear3-1) Then
strSameYear3 = (sYear3-Year3)
End If

If Year3 = sYear3 Then
strCountDays3 = (sDayOfYearNow3) - (DayOfYear3)
ElseIf Year3 = (sYear3-1) Then
strCountDays3 = ((365+sDayOfYearNow3) - DayOfYear3)
ElseIf Year3 < (sYear3-1) Then
strCountDays3 = (((365+sDayOfYearNow3)*(sYear3-Year3)) - DayOfYear3)
End If

'# Output the days so you can setup the If LastSeen x days ago test
LastSeenDaysAgo = strCountDays3
End Function

'# URLEncode and URLDecode is needed when working with different feeds. 
'# Cleans up those rogue I see often characters
Function URLEncode(str) 
    URLEncode = Server.URLEncode(str) 
End Function 

Function URLDecode(str) 
        For ii = 1 To Len(str) 
            sT = Mid(str, ii, 1) 
            If sT = "%" Then 
                If ii+2 < Len(str) Then 
                    sR = sR & _ 
                        Chr(CLng("&H" & Mid(str, ii+1, 2))) 
                    ii = ii+2 
                End If 
            Else 
                sR = sR & sT 
            End If 
        Next 
        URLDecode = sR 
    End Function 

Function URLDecode2(str1)
'# Used for Encoder that allows for TAB 
    If InStr(str1,"%0F") Then
        str1 = Replace(str1,"%0F","")
    End If
    If InStr(str1,"%20") Then
        str1 = Replace(str1,"%20"," ")
    End If
    If InStr(str1,"%7C") Then
        str1 = Replace(str1,"%7C","|")
    End If
URLDecode2 = URLDecode(str1)
End Function

Last edited by Mur (2010-01-17 12:24 am)

---

Do something creative today, code something.