New ASP Version

I am using this ver can someone tell me if its a good one because i been using it for quite a while now dont think it gaves me any problems
<%
dim ad_params

Function ad_network()

dim ad_type, ad_url, ad_file, AllLinks, NewTextLinks, objTextStreamR, objTextStreamW, newlink, spParam, LinksDate, i, NewTextLink, attempt, r, j

on error resume next

Randomize()

Const root_path="\" 'the (writable) path to ad_network_ads.txt

ad_type = "link" '"link" for text link | "text" for text banner | "" (empty) for graphical banner
ad_url = "http://ads.digitalpoint.com/network.php?b=" & Request.ServerVariables("SERVER_NAME") & "&type=" & ad_type
ad_file = "C:\ads\ad_network_ads.txt" 'it must be a path with write privileges

Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objTextStreamR = objFSO.OpenTextFile(ad_file,1,true)

If objTextStreamR.AtEndOfStream Then
'First Creation of cache file (5 ads)
NewTextLinks = GetNewLink(ad_url)
if NewTextLinks <> "" then NewTextLinks = "<ad_break>" & NewTextLinks

Application.Lock 'prevents other processes from changing file while writing
set fso = server.createobject("Scripting.FileSystemObject")
set stream = fso.opentextfile(ad_file,2,true)
stream.write ad_params & NewTextLinks
stream.close
set fso=nothing
Application.UnLock

spParam = split(ad_params,"|",-1,vbTextCompare)
if Request.ServerVariables("REMOTE_ADDR") = spParam(1) or Request.ServerVariables("SERVER_ADDR") = Request.ServerVariables("REMOTE_ADDR") then
NewTextLinks = Replace(NewTextLinks,""" />",""" class=""" & spParam(2) & """ />")
end if
displayAds = split(NewTextLinks,"<ad_break>")
redim preserve displayAds(4)
Else
AllLinks = split(objTextStreamR.ReadAll,"<ad_break>")
if instr(1,AllLinks(0),"|",vbTextCompare) = 0 then
newlink = GetNewLink(ad_url)
spParam = split(ad_params,"|",-1,vbTextCompare)
spParam(0) = AllLinks(0)
AllLinks(0) = ad_params
else
spParam = split(AllLinks(0),"|",-1,vbTextCompare)
end if
if IsDate(spParam(0)) then
LinksDate = cdate(spParam(0))
else
LinksDate = Now()
end if

If (UBound(AllLinks) <= spParam(3) + 1 and clng(datediff("s",LinksDate,now())) > clng(spParam(5))) or clng(datediff("s",LinksDate,now())) > clng(spParam(4)) Then
NewTextLink = GetNewLink(ad_url)
if NewTextLink <> "" then
redim preserve AllLinks(UBound(AllLinks) + 1)
AllLinks(0) = ad_params
AllLinks(ubound(AllLinks)) = NewTextLink
end if

If ubound(AllLinks) > spParam(3) then
for i = 1 to spParam(3)
AllLinks(i) = AllLinks(i + 1)
next
redim preserve AllLinks(spParam(3))
End If

AllLinks(0) = Now() & mid(AllLinks(0),instr(1,AllLinks(0),"|",vbTextCompare))

data = ""
For i = 0 to UBound(AllLinks)
data = data & AllLinks(i)
if i < UBound(AllLinks) then data = data & "<ad_break>"
Next

Application.Lock 'prevents other processes from changing file while writing
set fso = server.createobject("Scripting.FileSystemObject")
set stream = fso.opentextfile(ad_file,2,true)
stream.write data
stream.close
set fso=nothing
Application.UnLock

End If

'get 5 random non-duplicate ads
i = 0
do while i < 5 and i < UBound(AllLinks)
redim preserve displayAds(i)
attempt = 0

r = int(Rnd() * (UBound(AllLinks)) + 1)
for j = 0 to i - 1
if displayAds(j) = AllLinks(r) then
AllLinks(r) = ""
exit for
end if
next
do while attempt < 100 and AllLinks(r) = ""
r = int(Rnd() * (UBound(AllLinks)) + 1)
for j = 0 to i - 1
if displayAds(j) = AllLinks(r) then
AllLinks(r) = ""
exit for
end if
next
attempt = attempt + 1
loop
if Request.ServerVariables("REMOTE_ADDR") = spParam(1) or Request.ServerVariables("SERVER_ADDR") = Request.ServerVariables("REMOTE_ADDR") then
displayAds(i) = Replace(AllLinks(r),""" />",""" class=""" & spParam(2) & """ />")
else
displayAds(i) = AllLinks(r)
end if

i = i + 1
loop
End If

redim preserve displayAds(4)

ad_network = displayAds

end function

'-----------------------------------------------------------------------------------

Private Function GetHTTPText(File)

if Application("LastCommsAttempt") = "" then
Application("LastCommsAttempt") = now
else
if datediff("s",Application("LastCommsAttempt"),now()) > 4 then
Application("LastCommsAttempt") = now
else
exit function
end if
end if
Dim wHTTP
Set wHTTP = server.CreateObject("WinHttp.WinHttpRequest.5.1")
whttp.settimeouts 2000,30000,30000,30000
wHTTP.Open "GET", File, false
wHTTP.Send
If wHTTP.WaitForResponse(5) = True Then
GetHTTPText = wHTTP.ResponseText
End If
Set wHTTP=nothing

end function

'-----------------------------------------------------------------------------------

Private Function GetNewLink(File)

dim ht, spLink
ht = GetHTTPText(File)
if ht <> "" then
if instr(1,ht,"<ad_param>",vbTextCompare) > 0 then
spLink = split(ht,"<ad_param>",-1,vbTextCompare)
ad_params = now() & "|216.9.35.51|" & spLink(0)
GetNewLink = spLink(1)
else
Application("LastCommsAttempt") = dateadd("s",100,now)
ad_params = now() & "|216.9.35.51|abcdefgh|400|900|4"
end if
else
if datediff("s",Application("LastCommsAttempt"),now()) > 5 then
Application("LastCommsAttempt") = dateadd("s",100,now)
end if
ad_params = now() & "|216.9.35.51|abcdefgh|400|900|4"
end if

end function

ads=ad_network
response.write ads(0) & " "
response.write ads(1) & " "
response.write ads(2) & " "
response.write ads(3) & " "
response.write ads(4) & " "
%>

 

Ok, looks like the script is hanging the server now. My hosting company said that there seems to be a call to the adserver but nothing is coming back. I'm getting the following error using perrow's script.

VBscript runtime error '800a0009'
Subscript out of Range: '[number: 1]'
/includes/ad_network/ad_network.asp, line 105

Does anyone have any ideas? Shawn can you verify that www.leatherpages.com is not blocked.

thanks
Frank

 

I get the following error using your script


===========
msxml3.dll error '800c0005'

The system cannot locate the resource specified.

/test5.asp, line 154
===========

Any idea why?

 

I have 2 ideas.
When I use it with a firewall or with ISA (Internet Security and Acceleration server - basically a firewall), I get the same thing.

I have 3 servers setup. Identical except for ISA (internal and external). Both of them have the same problem. When I removed ISA, it worked. Read a lot about it to find many people with firewalls were also having that problem.

Strange, my unix box with unix firewall doesn't have the problem.

 

Problem solved. Pretty dumb actually.. I did not see this toggle in the ad_network.asp file:

ad_network = displayAds 'Print yourself
'Response.Write printAds 'Print all at once

I was using 'Print all at once', however I was calling the ads with:

%ad = ad_network%>
<%=ads(0)%> - <%=ads(1)%><br>
<%=ads(2)%> - <%=ads(3)%> - <%=ads(4)%>

You gotta use 'Print Yourself' if you are spitting out individual ads.

Here's hoping this hopes someone else avoid this stupido mistake.

 

It don't work! Please update code!

 

It works perfect. No need to update.

 

Hi, all again

As I got a private message asking what asp-version to use I will post the version I currently have working on my site. I think this is the same as the one in post #21 but I'm not completely sure. If you have the #21 version working there'll be no need to update though.

This version should be equivalent to the php 2.13 version. Make sure that you have no .txt file with the file name that this version uses in the directory it installs to.

 

It's writing the same ad to the text file every time. So I end up with 5 of the same ad being displayed. Any thoughts?

 

That's the same thing I'm getting. The same add over and over with the code posted in #48

 

I have reverted to an older version and everything is working great now.

 

This is the old version I reverted to. All others were crippling my sites.

http://forums.digitalpoint.com/showthread.php?p=225072#post225072

 

I am still using the same version from this thread. By perrow on post number #21. Three months on 6 sites without problem.

 

Going back to an older version worked for me for a few weeks but just today it slowed all of my websites down to a 20 second load again. For some reason it seems to do that for a few hours or a day and then start working again. I hope this is the case because I have to take down the ad network off of all my sites when it slows down because I am losing too much traffic because of the slow load time. I finally got smart and have everything on includes, so I can take it down and put it up really quick when it happens, but I wish I knew why it does it and wish someone would find a way to prevent it from happening.

 

Hi Friends,

I have all ASP based sites.

If someone can help me understand the functionality of the script (I think PHP guys can better help us) then I can easily do the coding.

The problem is that I do not know much about PHP else I could have deciphered and converted it to ASP.

Regards,

 

Ummm, it's already been converted to ASP for you. There download is in the thread.
I have many ASP and PHP sites. All work without problem. Your post is number #55. Go to number #21 of this thread and download the ASP version. Works great.
Michail Wilson