<%@ Language=VBScript %>
Emmasvej 2-10 - Brabrand
<%
Dim vPath, pPath, ConString, sqltext1, rsBlogliste, status
vPath = "../db/emmasvej.mdb" 'use this one if database is in root of cart folder
pPath = Server.MapPath( vPath )
ConString = "PROVIDER=MICROSOFT.JET.OLEDB.4.0;DATA SOURCE=" & pPath & ";"
Function unQuote(strTekst)
unQuote = Replace(strTekst,"'","''")
End Function
Sub tilmeld (nNavn, nMailadr,nOpgang,nEtage,nSide)
if(nMailadr = "joachim@joachim.dk")then
status = ""
else
afmeld nMailadr
sqltext = "INSERT INTO Brugere (Navn, Autorisation, Brugerid, Kodeord, Email, Ipadr, OprettetDato,Opgang,Etage,Side,AbonnerUpdates) "
sqltext = sqltext & "values ('"&nNavn&"','C','-','-','"&nMailadr&"','"& Request.ServerVariables("REMOTE_ADDR") &"','"& UniTid &"','"& nOpgang &"','"& nEtage &"','"& nSide &"','JA')"
'response.write sqltext
Conn.Execute(sqltext)
status = " E-mail-adressen er tilføjet mail-listen
"
end if
End Sub
Sub afmeld (nMailadr)
'if(nMailadr = "joachim@joachim.dk")then
' status = " E-mail-adresse kunne ikke afmeldes
"
'else
sqltext = "DELETE FROM Brugere WHERE Autorisation <> 'A' AND Email='" & nMailadr & "'"
Conn.Execute(sqltext)
status = " E-mail-adresse er fjernet fra mail-listen
"
'end if
End Sub
Sub afsendmail (nTo, nBcc, nSubject, nTekst)
Dim sMsg
Dim sTo
Dim sBcc
Dim sFrom
Dim sSubject
Dim sTextBody
sTo = nTo
if (sTo = "") then
sTo = "joachim@joachim.dk"
end if
sBcc = nBcc
sFrom = "joachim@joachim.dk"
sSubject = nSubject
sTextBody = nTekst
Dim objMail
'Create the mail object
Set objMail = Server.CreateObject("CDO.Message")
'Set key properties
objMail.From = sFrom
objMail.To = sTo
objMail.Bcc = sBcc
objMail.Subject= sSubject
objMail.TextBody = sTextBody
'Send the email
objMail.Send
'Clean-up mail object
Set objMail = Nothing
response.write "E-mail succesfully sent!"
End Sub
Function UniTid
SysTime = Now()
UniYear = DatePart("yyyy",SysTime)
UniDay = DatePart("d",SysTime)
if (UniDay < 10 ) then
UniDay = "0"&UniDay
end if
UniMonth = DatePart("m",SysTime)
if (UniMonth < 10 ) then
UniMonth = "0"&UniMonth
end if
UniHour = DatePart("h",SysTime)
if (UniHour = 0 ) then
UniHour = 9
else
UniHour = UniHour - 1
end if
if (UniHour < 10 ) then
UniHour = "0"&UniHour
end if
UniMin = DatePart("n",SysTime)
if (UniMin < 10 ) then
UniMin = "0"&UniMin
end if
UniSec = DatePart("s",SysTime)
if (UniSec < 10 ) then
UniSec = "0"&UniSec
end if
'GMT tid
UniTid = UniYear&"-"&UniMonth&"-"&UniDAy&"T"&UniHour&":"&UniMin&":"&UniSec&"Z"
End Function
'Main program
chaAktion = unQuote(Request.form("Aktion"))
chaCurItem1 = Request.form("CurItem1")
chaNavn = unQuote(Request.form("Navn"))
chaMailadr = unQuote(Request.form("Mailadr"))
chaOpgang = Request.form("Opgang")
chaEtage = Request.form("Etage")
chaSide = Request.form("Side")
status = ""
set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open ConString
if (chaAktion = "tilmeld") then
tilmeld chaNavn, chaMailadr,chaOpgang,chaEtage,chaSide
'afsendmail chaMailadr, "", "Tilmeldt mailliste", "Du er nu tilmeldt mailinglisten på www.joachim.dk./n Afmelding kan ske på http://www.joachim.dk/blog/mailabo.asp./n De bedste hilsner/n Joachim"
'Response.redirect "bloglisteadm.asp"
end if
if (chaAktion = "afmeld") then
afmeld chaMailadr
'afsendmail chaMailadr, "", "Afmeldt mailliste", "Du er nu afmeldt mailinglisten på www.joachim.dk./n Tilmelding kan ske på http://www.joachim.dk/blog/mailabo.asp./n De bedste hilsner/n Joachim"
'Response.redirect "bloglisteadm.asp"
end if
%>
<%
if (Len(Session("Brugerid")) > 0) then
response.write "