I have a ASP based site http://www.yourmoneynet.co.uk. Can anyone help me to implement Co-op Ads on this site.
http://forums.digitalpoint.com/showthread.php?t=6985 See that thread towards the end...there's no official version but it can be done also see this thread http://forums.digitalpoint.com/showthread.php?t=17092 I'm not an asp person but just set it up for a friend of mine on his asp site so it's not too hard.
Thanks elkiwi, I had taken that code but still i have some problems, only 1 ad is visible on the test page http://www.yourmoneynet.co.uk/test.asp. can you figure out wats the problem
Even I looked around in the forum for a code which works for ASP site. I found the code which is working. As I have forgotten from which thread I have taken it, I am posting the same here.. First have an ASP file - "ad_network.asp" with following code in it <% dim ad_params, ad_objFSO 'Set num_ads to the number of ads you want to display. 'Set ad_separator to the separator you want between ads. const num_ads = 5 const ad_separator = " | " const ad_file_name = "ad_network_ads_213.txt" Function ad_network() Const root_path="\" 'the (writable) path to ad_network_ads.txt dim ad_ids() dim ad_type, ad_url, ad_file, AllLinks, NewTextLinks, objTextStreamR, objTextStreamW, newlink, spParam, LinksDate, i, NewTextLink, attempt, r, j dim stream, displayAds(), fileWritable Randomize() 'on error resume next ad_type = "link" '"link" for text link | "text" for text banner | "" (empty) for graphical banner ad_url = "http://ads.digitalpoint.com/network.php?c=" & Request.ServerVariables("SERVER_NAME") & "&type=" & ad_type ad_file = Server.MapPath("/") & root_path & ad_file_name 'it must be a path with write privileges Set ad_objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objTextStreamR = ad_objFSO.OpenTextFile(ad_file,1,true) 'Is the file writable? set fileWritable = ad_objFSO.GetFile(ad_file) if (fileWritable.Attributes and 1) = 1 then Response.Write "You must set the ad network .txt file to be writable." exit function end if 'If the file contains no data then set up for new file if objTextStreamR.AtEndOfStream then redim AllLinks(1) else 'else split existing data AllLinks = split(objTextStreamR.ReadAll,"<ad_break>") end if 'If no timestamp in first record, get new ad_param data 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 AllLinks(Ubound(AllLinks)) = newlink SaveFile join(AllLinks, "<ad_break>"), ad_file 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)) SaveFile join(AllLinks, "<ad_break>"), ad_file End If 'get 5 random non-duplicate ads dim id_string, c_safety, temp_ad redim preserve displayAds(num_ads - 1) redim preserve ad_ids(num_ads - 1) c_safety = 0 id_string = "-" i = 0 do while i < num_ads and i < UBound(AllLinks) and c_safety < 100 r = int(Rnd() * (UBound(AllLinks)) + 1) temp_ad = split(AllLinks(r), "<id>") 'If this ad has NOT been selected before its id will NOT be in id_string. 'When searching for id add a "-"'s to make sure we do not match partial numbers. if not instr(1, id_string, "-" & temp_ad(1) & "-") > 0 then id_string = id_string & temp_ad(1) & "-" if Request.ServerVariables("REMOTE_ADDR") = spParam(1) or Request.ServerVariables("SERVER_ADDR") = Request.ServerVariables("REMOTE_ADDR") then displayAds(i) = Replace(temp_ad(0),""" />",""" class=""" & spParam(2) & """ />") else displayAds(i) = temp_ad(0) end if i = i + 1 end if c_safety = c_safety + 1 loop 'Remove trailing "-" from id_string if len(id_string) > 0 then id_string = left(id_string, len(id_string) - 1) dim printAds printAds = join(displayAds, ad_separator) Response.Write "<img src=""http://ads.digitalpoint.com/t" & id_string & ".gif"" width=""1"" height=""1"">" 'ad_network = displayAds 'Print yourself Response.Write printAds 'Print all at once end function '------------------------------------------------ ' Private functions '------------------------------------------------ Private Function SaveFile(strDataToSave, strFileName) dim stream Application.Lock 'prevents other processes from changing file while writing set stream = ad_objFSO.opentextfile(strFileName,2,true) stream.write strDataToSave stream.close Application.UnLock 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 'on error resume next Dim wHTTP Set wHTTP = server.CreateObject("Microsoft.XMLHTTP") '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 %> Code (markup): Create a text file - ad_network_ads_213.txt and give write permission for the server. Include the following code to display coop code <!-- #include file="ad_network.asp" --> <% dim ads ads=ad_network response.Write(ads) 'response.write ( ads(0) & " | " & ads(1) & " | " & ads(2) & " | " & ads(3) & " | " & ads(4)) %> Code (markup): It works for me (Even though I am not using it because of supplement fear)
awesome, thank you so much for posting that. it got me pretty close, i now have 1 (ONE) ad showing... need to figure out what's wrong with the other 4. Also it's the same ad every page.
Hi, if only one ad is being shown, try changing last two lines in the code which you include in the page.. Basically comment the second last line of code and uncomment the last line.. 'response.Write(ads) response.write ( ads(0) & " | " & ads(1) & " | " & ads(2) & " | " & ads(3) & " | " & ads(4) " | " & ads(5)) Code (markup):
Thanks for the help... for some reason I am getting this when I follow that instruction: "Microsoft VBScript runtime error '800a000d' Type mismatch " In fact, even if I comment out both of the last two lines, I get one ad showing: "RealEstate | | | |"
i ended up just paying a scriptlance guy to fix this code for me, so id like to share i w/you guys. the problem had something to do with caching apparently. it now validates for me. here's the code: <% dim ad_params, ad_objFSO 'Set num_ads to the number of ads you want to display. 'Set ad_separator to the separator you want between ads. const num_ads = 5 const ad_separator = " | " const ad_file_name = "ad_network_ads_NUMBER-HERE.txt" Function ad_network() Const root_path="\" 'the (writable) path to ad_network_ads.txt dim ad_ids() dim ad_type, ad_url, ad_file, AllLinks, NewTextLinks, objTextStreamR, objTextStreamW, newlink, spParam, LinksDate, i, NewTextLink, attempt, r, j dim stream, displayAds(), fileWritable Randomize() 'on error resume next ad_type = "link" '"link" for text link | "text" for text banner | "" (empty) for graphical banner ad_url = "http://ads.digitalpoint.com/network.php?c=" & Request.ServerVariables("SERVER_NAME") & "&type=" & ad_type 'Response.Write(ad_url & "<br><br>") ad_file = Server.MapPath("/") & root_path & ad_file_name 'it must be a path with write privileges Set ad_objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objTextStreamR = ad_objFSO.OpenTextFile(ad_file,1,true) 'Is the file writable? set fileWritable = ad_objFSO.GetFile(ad_file) if (fileWritable.Attributes and 1) = 1 then Response.Write "You must set the ad network .txt file to be writable." exit function end if 'If the file contains no data then set up for new file if objTextStreamR.AtEndOfStream then redim AllLinks(1) else 'else split existing data AllLinks = split(objTextStreamR.ReadAll,"<ad_break>") end if 'If no timestamp in first record, get new ad_param data 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 AllLinks(Ubound(AllLinks)) = newlink SaveFile join(AllLinks, "<ad_break>"), ad_file 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)) SaveFile join(AllLinks, "<ad_break>"), ad_file End If 'get 5 random non-duplicate ads dim id_string, c_safety, temp_ad redim preserve displayAds(num_ads - 1) redim preserve ad_ids(num_ads - 1) c_safety = 0 id_string = "-" i = 0 do while i < num_ads and i < UBound(AllLinks) and c_safety < 100 r = int(Rnd() * (UBound(AllLinks)) + 1) temp_ad = split(AllLinks(r), "<id>") 'If this ad has NOT been selected before its id will NOT be in id_string. 'When searching for id add a "-"'s to make sure we do not match partial numbers. if not instr(1, id_string, "-" & temp_ad(1) & "-") > 0 then id_string = id_string & temp_ad(1) & "-" if Request.ServerVariables("REMOTE_ADDR") = spParam(1) or Request.ServerVariables("SERVER_ADDR") = Request.ServerVariables("REMOTE_ADDR") then displayAds(i) = Replace(temp_ad(0),""" />",""" class=""" & spParam(2) & """ />") else displayAds(i) = temp_ad(0) end if i = i + 1 end if c_safety = c_safety + 1 loop 'Remove trailing "-" from id_string if len(id_string) > 0 then id_string = left(id_string, len(id_string) - 1) dim printAds printAds = join(displayAds, ad_separator) Response.Write "<img src=""http://ads.digitalpoint.com/t" & id_string & ".gif"" width=""1"" height=""1"">" 'ad_network = displayAds 'Print yourself Response.Write printAds 'Print all at once end function '------------------------------------------------ ' Private functions '------------------------------------------------ Private Function SaveFile(strDataToSave, strFileName) dim stream Application.Lock 'prevents other processes from changing file while writing set stream = ad_objFSO.opentextfile(strFileName,2,true) stream.write strDataToSave stream.close Application.UnLock 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 'on error resume next Dim wHTTP Set wHTTP = server.CreateObject("Microsoft.XMLHTTP") 'whttp.settimeouts 2000,30000,30000,30000 File = File & "&rnd=" & CStr(CLng(1000000 * Rnd())) wHTTP.Open "GET", File, false wHTTP.Send 'If wHTTP.WaitForResponse(5) = True Then ''Response.Write(File & "::" & wHTTP.ResponseText & "<br><br>") 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 %> Code (markup): Hope it works for you! I'm not familiar w/ASP and didn't do this coding on my own, so use at your own risk. Seems to be working fine / validating for me though.
no problem, glad it worked i didnt even end up using it on the site i had planned so its good the $50 didnt go to waste