koden till sendit.asp
<!--#include file="inccard.asp"-->
<%
' First of all lets just get all variables
Dim nCardId, sNameTo, sNameFrom, sEmailFrom, sText, sBGColor, sTextColor, sEmailTo
nCardId = Request.Form("fldAuto")
if nCardId = "" Then
Response.Redirect "."
End If
'Ok...
sNameTo = Request.Form("nameto")
sNameFrom = Request.Form("namefrom")
sEmailFrom = Request.Form("emailfrom")
sEmailTo = Request.Form("emailto")
sGreeting = Request.Form("greeting")
sText = Request.Form("S1")
sBGColor = Request.Form("BgColor")
sTextColor = Request.Form("TColor")
'Save it to database
Dim oRS
Set oConn = PostCard_GetDatabaseConn()
oConn.Execute "update card set sendcount=sendcount+1 where fldAuto=" & nCardId
Set oRS = Server.CreateObject("ADODB.Recordset")
oRS.Open "select * from createdpostcards where fldAuto=-1 " ,oConn ,adOpenKeyset,adLockOptimistic
oRS.AddNew
oRS("cardid") = nCardId
oRS("nameto") = sNameTo
oRS("namefrom") = sNameFrom
oRS("emailto") = sEmailTo
oRS("emailfrom") = sEmailFrom
oRS("greeting") = sGreeting
oRS("stext") = sText
oRS("bgcolor") = sBGColor
oRS("textcolor") = sTextcolor
oRS.Update
Dim IDToSend
IDToSend = oRS("fldAuto").Value & "---"& oRS("emailto").Value
oRS.Close
Set mailer = server.createobject("CDONTS.NewMail")
mailer.From = sEmailFrom
mailer.Subject = sNameFrom & " har skickat dig ett vykort"
mailer.To = sNameTo & "(" & sEmailTo & ")"
MyBody = sNameFrom & "(" & sEmailFrom & ")" & " har skickat dig ett vykort!" & vbCrLf
MyBody = Mybody & "För att plocka upp det, gå till följande adress: " & GetPathToPickupScript() & "?cardid=" & IDToSend
MyBody = MyBody & vbCrLf & vbCrLf & "Detta vykort var skickat, och gjort med micke & annas vykorts service på adressen: <A HREF="http://www.micke-anna.nu"" TARGET=_blank>http://www.micke-anna.nu"</A>
mailer.Body= MyBody
mailer.Send
%>
koden till incard.asp
<!--#include file="adovbs.inc"-->
<%
'''TODO for you! Configuration:
''''1. Change to full path to your viewcard.asp file
Function GetPathToPickupScript()
GetPathToPickupScript = "http://www.micke-anna.nu/data/start_sida/vykort/viewcard.asp"
End Function
'''TODO for you! Configuration:
''''2. Database connection
Function Postcard_GetDatabaseConn()
Dim oRet
Set oRet = Server.CreateObject ("ADODB.Connection")
oRet.Open "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="& Server.MapPath("/databas/postcardmentor.mdb")
Set Postcard_GetDatabaseConn = oRet
End Function
'''TODO for you! Configuration:
''''3. Some ads if you'd like
Function Inccard_GetAd(nNumber)
Select Case nNumber
Case 1
Inccard_GetAd = "Insert a top banner???"
Case 2
Inccard_GetAd = "Insert a button???"
Case 3
Inccard_GetAd = "Insert a bottom banner???"
End Select
End Function
Function PostCard_WritePickItUpForm()
%>
<form method="POST" action="../viewcard.asp">
<p>Vykorts nummer:<input type="text" name="cardid" size="20"><input type="submit" value="Hämta" name="Submit"></p>
</form>
<%
End Function
Function PostCard_WriteListCatsForm( nPreSelectedId )
%>
<form method="POST" action="../cardlist.asp?newcat=true">
<p>Kategori:<select size="1" name="cat_fldAuto">
<%ListAllCategoriesInList nPreSelectedId%>
</select><input type="submit" value="Ok" name="B1"></p>
</form>
<%
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 "<option"
If CInt(nPreSelected) = Cint(oRS("fldAuto").Value) Then
Response.Write " selected "
End If
Response.Write " value=""" & oRS("fldAuto").Value & """>" & oRS("name") & "</option>"
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
%>
någon som hittar felet? eller har någon en färdig vykorts tjänst som fungerar med Cdonts?
------------------
Micke & Annas Sajt
micke@micke-anna.nu
