<% ''''''''''' (C) Stefan Holmberg 1999 ''''''''''' Free to use if these sourcecode lines is not deleted ''''''''''' Contact me at webmaster@sqlexperts.com ''''''''''' http://www.sqlexperts.com ''''''''''' AdMentor homepage at http://www.create-a-webshop.com ' Script modified by Michael Cleland ' michael@activeenzymes.com.au ' http://www.activeenzymes.com.au/postcard ' Configuration ' You can create a staging server on your own machine to test the postcards with ' the live server being the one that is publically available ' Just fill in all the details below staging_server = "www.dakarcafe.com" live_server = "www.dakarcafe.com" mail_server = "mail.dakarcafe.com" webmaster_email = "admin@dakarcafe.com" postcard_name = "Dakar Cafe - Greeting Cards" staging_serverURL = "http://" & staging_server & "/greetings/" live_serverURL = "http://" & live_server & "/greetings/" staging_serverDB = "DAKGREET" live_serverDB = "DAKGREET" ' End of configuration nameto = Request("nameto") nameto = Replace(nameto, " ", "%20") namefrom = Request("namefrom") namefrom = Replace(namefrom, " ", "%20") emailfrom = Request("emailfrom") emailfrom = Replace(emailfrom, " ", "%20") emailto = Request("emailto") emailto = Replace(emailto, " ", "%20") sPostcardToFriend = server.HTMLencode("nameto=" & nameto & "&emailto=" & emailto & "&namefrom=" & namefrom & "&emailfrom=" & emailfrom) sPostcardToFriend = Replace(sPostcardToFriend, " ", "%20") Function GetPathToPickupScript() If ((request.serverVariables("http_host") = staging_server))then GetPathToPickupScript = staging_serverURL & "viewcard.asp" Else GetPathToPickupScript = live_serverURL & "viewcard.asp" End If End Function Function Postcard_GetDatabaseConn() Dim oRet Set oRet = Server.CreateObject ("ADODB.Connection") If ((request.serverVariables("http_host") = staging_server))then oRet.Open "DSN=" & staging_serverDB Else oRet.Open "DSN=" & live_serverDB End If Set Postcard_GetDatabaseConn = oRet End Function Function Inccard_GetAd(nNumber) Select Case nNumber Case 1 Case 2 Case 3 End Select End Function Function PostCard_WritePickItUpForm() %> <% End Function Function PostCard_WriteListCatsForm( nPreSelectedId ) %> <% End Function Function PostCard_GetCardCount() Dim oRS Set oRS = Postcard_GetDatabaseConn().Execute("select count(*) as no from card" ) PostCard_GetCardCount = oRS("no").Value oRS.Close End Function Function PostCard_GetCatCount() Dim oRS Set oRS = Postcard_GetDatabaseConn().Execute("select count(*) as no from cat" ) PostCard_GetCatCount = oRS("no").Value oRS.Close End Function Function ListAllCategoriesInList( nPreSelected ) Dim oRS Set oRS = Postcard_GetDatabaseConn().Execute("select fldAuto, name from cat" ) While Not oRS.EOF Response.Write "" & oRS("name") & "" oRS.MoveNext Wend oRS.Close End Function Function ListSingleCategoryInList( nPreSelected ) Dim oRS Set oRS = Postcard_GetDatabaseConn().Execute("select fldAuto from cat" ) While Not oRS.EOF Response.Write oRS("fldAuto").Value oRS.MoveNext Wend oRS.Close End Function ''Some constants for file handling Const P_File_OpenForReading = 1, P_File_OpenForWriting = 2, P_File_OpenForAppending = 8 Sub AddCard( sName, sHTML ) ' Dim sFileName, oFile, sID End Sub Function GetExistingDates() ' 'Walk through all files Dim nCount Dim fs, f, f1, fc, s nCount = 0 Set oRet = Server.CreateObject("Scripting.Dictionary") Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(GetStatDir()) Set fc = f.Files For Each f1 in fc If Left( f1.name,7) = "PVPAGE_" Then nCount = nCount + 1 oRet.Add Mid( f1.name, 8, 8 ), "" End If Next Set GetExistingDates = oRet End Function Function DeleteFilesFromDate( sDate ) ' ' Now we should delete all files from that date Dim fs Set fs = CreateObject("Scripting.FileSystemObject") On Error Resume Next fs.DeleteFile GetStatDir() & "PVPAGE_" & sDate & ".log" fs.DeleteFile GetStatDir() & "PVSUM_" & sDate & ".log" fs.DeleteFile GetStatDir() & "REF_" & sDate & ".log" fs.DeleteFile GetStatDir() & "VI_" & sDate & ".log" End Function Function GetFormattedDate( dDate ) Dim sMonth, sDay sMonth = DatePart( "m", dDate) If Len(sMonth) = 1 Then sMonth = "0" & sMonth End If sDay = DatePart( "d", dDate) If Len(sDay) = 1 Then sDay = "0" & sDay End If GetFormattedDate = DatePart( "yyyy", dDate ) & sMonth & sDay End Function Sub LogVisit() ' '1. What should the file be called Dim sFileName, oFile, nCount sFileName = GetStatDir() & "VI_" & GetFormattedDate( Now() ) & ".log" Set oFile = File_OpenExistingOrCreate( sFileName, P_File_OpenForReading ) If oFile.AtEndOfStream = True Then nCount = 0 Else nCount = oFile.ReadLine() End If oFile.Close nCount = nCount + 1 Set oFile = File_OpenExistingOrCreate( sFileName, P_File_OpenForWriting ) oFile.WriteLine nCount oFile.Close ' Response.Write sFileName End Sub Sub LogPageView() '1. What should the file be called Dim sFileName, oFile, nCount sFileName = GetStatDir() & "PVSUM_" & GetFormattedDate( Now() ) & ".log" Set oFile = File_OpenExistingOrCreate( sFileName, P_File_OpenForReading ) If oFile.AtEndOfStream = True Then nCount = 0 Else nCount = oFile.ReadLine() End If oFile.Close nCount = nCount + 1 Set oFile = File_OpenExistingOrCreate( sFileName, P_File_OpenForWriting ) oFile.WriteLine nCount oFile.Close ' Now one for each pageview... sFileName = GetStatDir() & "PVPAGE_" & GetFormattedDate( Now() ) & ".log" Set oFile = File_OpenExistingOrCreate( sFileName, P_File_OpenForAppending ) oFile.WriteLine Request.ServerVariables("SCRIPT_NAME") oFile.Close End Sub Function File_OpenExistingOrCreate( strPath, nAccess ) ' strPath = the path to file ' nAccess should be one of the constants above On Error Resume Next Dim objFileObj Dim objFile Set objFileObj = Server.CreateObject("Scripting.FileSystemObject") Set objFile = objFileObj.OpenTextFile( strPath, nAccess, True, False ) If Err = 0 Then Set File_OpenExistingOrCreate = objFile Else Set File_OpenExistingOrCreate = Nothing End If End Function ' Display newest cards function Function DisplayNewCards() Dim oRS Set oRS = Postcard_GetDatabaseConn().Execute("select fldAuto, gifurl, gifurlsmall, sendcount, datum from card order by datum desc" ) for i=1 to 3 ' note if you want more than three newest cards, change this number If oRS.EOF = False Then Response.Write "

" Response.Write "

" Response.Write "

Preview
Postcard sent " & oRS("sendcount") & " times

" oRS.MoveNext End If Next oRS.Close End Function ' Display popular cars function Function DisplayTopCards() Dim oRS Set oRS = Postcard_GetDatabaseConn().Execute("select fldAuto, gifurl, gifurlsmall, sendcount from card order by sendcount desc" ) for i=1 to 3 ' note if you want more than three top cards, change this number If oRS.EOF = False Then Response.Write "

" Response.Write "

Preview
Postcard sent " & oRS("sendcount") & " times

" oRS.MoveNext End If Next oRS.Close End Function %>