<%@ EnableSessionState=False %>
<%
'option explicit
' Structure of Access database:
' Table: multimedia
' Field Name Datatype
' ID AutoNumber
' titel
' forlag
' forlagURL
' titelURL
' andraURL
' anteckningar
' alder
' amnen
' uppdateringsdatum
' signatur
sub openandrun
dim codepath
thecode=Server.MapPath(Request.ServerVariables("PATH_INFO"))
select case lcase(left(thecode,1))
' The below so I can use it both on 7Host and on local disk without fuzz.
case "c"
mmdb="C:\pf\private\prifre\db\multimedia.mdb"
thecode="multimedia.asp"
case "d"
mmdb="D:\business\prifre.com\private\db\multimedia.mdb"
thecode="multimedia.asp"
case else
call closeandexit
end select
'OPEN THE DATABASE!
set conn=Server.CreateObject("ADODB.Connection")
conn.Provider="Microsoft.Jet.OLEDB.4.0"
conn.Open mmdb
end sub
sub makepage(s,target)
dim mytable,myform,chat
if body="" then
body=""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
body=body&""&chr(13)
end if
select case target
case ""
if instr(1,body,""&target)=0 then
body=replace(body,target,"
"&s&"
"&target)
else
s="
"&s&"
"
body=replace(body,""&target,s&target)
end if
body=replace(body,"
","")
case ""
body=replace(body,"",""&chr(13)&"")
case ""
body=replace(body,"",""&chr(13))
case ""
body=replace(body,target,s&target&chr(13))
body=replace(body,""&target,chr(13)&""&target)
case ""
if instr(1,body,""&target)=0 then
mytable="
"
body=replace(body,target,mytable&target)
end if
s=chr(13)&"
"&Replace(s,"¤","
"&chr(13)&"
")&"
"
body=replace(body,""&target,s&""&target)
case ""
body=replace(body,""," ")
case ""
if instr(1,body,""&target)=0 then
mytable="
"
body=replace(body,""&target,s&""&target)
end if
case ""
body=replace(body,target," "&s&""&target)
case else
end select
end sub
sub closeandexit
conn.Close
call makepage("","")
body=replace(body,"","")
body=replace(body,"","")
body=replace(body,"","")
body=replace(body,"","")
body=replace(body,"","")
body=replace(body,"","")
body=replace(body,"","")
body=replace(body,"","")
body=replace(body,"\''",chr(34))
body=replace(body,"å","å")
body=replace(body,"ä","ä")
body=replace(body,"ö","ö")
body=replace(body,"é","é")
body=replace(body,"Å","Å")
body=replace(body,"Ä","Ä")
body=replace(body,"Ö","Ö")
body=replace(body,"É","É")
Response.Write body
Response.End
end sub
sub showmenu
call makepage("Visa första 100","")
call makepage("Visa alla","")
call makepage("Sökformulär","")
call makepage("Synpunkter","")
end sub
function fixlink(url)
dim u
u=Replace(url,"&","&")
fixlink=Replace(u,"&","&")
end function
sub sendemail(toemail,fromemail,mailsubject,mailmessage)
Dim objCDO
' on error resume next
if lcase(left(Server.MapPath(Request.ServerVariables("PATH_INFO")),1))<>"c" then
Set objCDO = Server.CreateObject("CDONTS.NewMail")
objCDO.To = toemail
if fromemail="" then
fromemail="unknown@"&Request.ServerVariables("REMOTE_ADDR")
end if
objCDO.From = fromemail
objCDO.Subject = mailsubject
objCDO.Body =mailmessage
objCDO.Send
Set objCDO=Nothing
end if
' call makepage("Sent email from "&fromemail&" to "&toemail,"")
end sub
sub showlist(thesearch,thesort)
dim rs,mytable,fl,i,i2,srch
srch="SELECT * FROM multimedia"
if thesearch>"" then srch=srch&" WHERE "&thesearch
if thesort>"" then srch=srch&" ORDER BY "&thesort
call makepage("","")
mytable=""
' mytable=mytable&"¤ID"
mytable=mytable&"¤Titel"
mytable=mytable&"¤Förlag"
mytable=mytable&"¤Andra länkar"
mytable=mytable&"¤Ålder"
mytable=mytable&"¤Ämnen"
mytable=mytable&"¤Uppdaterat"
call makepage(mytable,"")
set rs=Server.CreateObject("ADODB.recordset")
rs.Open srch, conn,1
mytable="Antal hittade poster: "&rs.RecordCount
if rs.RecordCount>maxrecords then
mytable=mytable&" av vilka de första "&maxrecords&" visas."
end if
call makepage(mytable,"")
i2=maxrecords
while not(rs.EOF) and (i2>0)
i2=i2-1
mytable=""
' mytable=mytable&"¤"&Cstr(rs.Fields("ID"))
mytable=mytable&"¤"&rs.fields("titel")&""
mytable=mytable&"¤"&rs.fields("forlag")&""
mytable=mytable&"¤"
fl=split(rs.fields("andraURL")&vbLf,vbLf)
for i=0 to UBound(fl)-1
if instr(1,fl(i),"http://") then
mytable=mytable&""
mytable=mytable&split(split(fl(i),"http://")(0),":")(0)&" "
else
mytable=mytable&fl(i)&" "
end if
next
mytable=mytable&"¤"
fl=split(rs.fields("alder"),",")
for i=0 to UBound(fl)
mytable=mytable&trim(left(fl(i),4))&"/"
next
mytable=mytable&"¤"
fl=split(rs.fields("amnen"),",")
for i=0 to UBound(fl)
mytable=mytable&trim(left(fl(i),4))&"/"
next
mytable=mytable&"¤"&rs.fields("uppdateringsdatum")
mytable=fixlink(mytable)
call makepage(mytable,"")
rs.MoveNext()
wend
rs.Close
end sub
sub showfeedbackform
dim myform
call makepage("","")
myform=myform&"Skicka synpunkter "&chr(13)
call makepage(myform,"")
myform=""&chr(13)
myform=myform&"Din e-postadress:¤"
myform=myform&""
call makepage(myform,"")
myform="Synpunkter på multimediadatabasen:¤"
myform=myform&""
myform=myform&""
call makepage(myform,"")
call makepage("","")
call makepage("","")
end sub
sub showform(action,id)
dim myform,rs,f,t,fl
call makepage("","")
fl=split("¤¤¤¤¤¤¤¤¤¤","¤")
' call makepage("","")
select case action
case "search"
myform=""
myform=myform&"Sök "&chr(13)
call makepage(myform,"")
case "add"
myform=""
myform=myform&"Lägg till "&chr(13)
call makepage(myform,"")
case "edit"
myform=""
myform=myform&"Ändra "&chr(13)
call makepage(myform,"")
set rs=Server.CreateObject("ADODB.recordset")
rs.Open "SELECT * FROM multimedia WHERE id="&id, conn
if not rs.EOF then
fl(0)=rs.Fields("ID")
fl(1)=rs.Fields("titel")
fl(2)=rs.Fields("titelURL")
fl(3)=rs.Fields("forlag")
fl(4)=rs.Fields("forlagURL")
fl(5)=rs.Fields("andraURL")
fl(6)=rs.Fields("alder")
fl(7)=rs.Fields("amnen")
fl(8)=rs.Fields("anteckningar")
fl(9)=rs.Fields("uppdateringsdatum")
fl(10)=rs.Fields("signatur")
end if
rs.Close
case else
end select
myform=""
myform=""&chr(13)
myform=myform&"Titel:¤"
myform=myform&""
call makepage(myform,"")
myform="Internetlänk till titeln:¤"
myform=myform&""
call makepage(myform,"")
myform="Namn på förlag:¤"
myform=myform&""
call makepage(myform,"")
myform="Internetlänk till förlaget:¤"
myform=myform&""
call makepage(myform,"")
myform="Andra internetlänkar:¤"
myform=myform&""
myform=myform&" (Skriv dessa enl: 'Yahoo: http://www.yahoo.com/' och avsluta varje med vagnretur.)"
call makepage(myform,"")
myform="Årskurs:¤"
myform=myform&""
myform=myform&" (Förskola, Grundskola, Högstadiet, Särskola, Gymnasiet, Vuxenutbildning, Högskola)"
call makepage(myform,"")
myform="Ämnen:¤"
myform=myform&""
myform=myform&" (svenska, engelska, tyska, religion, historia, matematik, fysik, kemi, etc)"
call makepage(myform,"")
myform="Anteckningar:¤"
myform=myform&""
call makepage(myform,"")
if action<>"search" then
myform="Uppdateringsdatum¤"&fl(9)&""
else
myform="Uppdateringsdatum¤"
end if
call makepage(myform,"")
myform="Signatur:¤"
myform=myform&""
myform=myform&" (skriv helst din e-postadress)"
call makepage(myform,"")
call makepage("","")
call makepage("","")
end sub
sub changerecord(action)
dim rs
set rs=Server.CreateObject("ADODB.recordset")
select case action
case "add"
rs.Open "SELECT * FROM multimedia", conn,3,3
rs.AddNew
call makepage("Lade till en post","")
case "change"
if Request("id")>"" then
rs.Open "SELECT * FROM multimedia WHERE ID="&Request("id")*1, conn,3,3
if rs.EOF then
rs.Close
exit sub
end if
else
exit sub
end if
case else
exit sub
end select
rs.fields("titel")=Request("titel")
rs.fields("titelURL")=Request("titelURL")
rs.fields("forlag")=Request("forlag")
rs.fields("forlagURL")=Request("forlagURL")
rs.fields("alder")=Request("alder")
rs.fields("amnen")=Request("amnen")
rs.fields("andraURL")=Request("andraURL")
rs.fields("anteckningar")=Request("anteckningar")
rs.fields("uppdateringsdatum")=Request("uppdateringsdatum")
rs.fields("signatur")=Request("signatur")
rs.Update
if Request("titel")="" then
rs.Delete
end if
rs.Close
end sub
dim thecode,mmdb,conn,body,srch,maxrecords
if Request("maxrecords")*1>0 then
maxrecords=Request("maxrecords")*1
else
maxrecords=100
end if
call openandrun
select case Request("ex")
case "showlist"
call showlist(Request("search"),Request("sort"))
case "search"
srch=""
if Request("titel")>"" then srch=srch&" titel LIKE '%"&Request("titel")&"%' "
if Request("titelURL")>"" then srch=srch&" titelURL LIKE '%"&Request("titelURL")&"%' "
if Request("forlag")>"" then srch=srch&" forlag LIKE '%"&Request("forlag")&"%' "
if Request("forlagURL")>"" then srch=srch&" forlagURL LIKE '%"&Request("forlagURL")&"%' "
if Request("andraURL")>"" then srch=srch&" andraURL LIKE '%"&Request("andraURL")&"%' "
if Request("alder")>"" then srch=srch&" alder LIKE '%"&Request("alder")&"%' "
if Request("amnen")>"" then srch=srch&" amnen LIKE '%"&Request("amnen")&"%' "
if Request("anteckningar")>"" then srch=srch&" anteckningar LIKE '%"&Request("anteckningar")&"%' "
if Request("signatur")>"" then srch=srch&" signatur LIKE '%"&Request("signatur")&"%' "
if Request("uppdateringsdatum")>"" then srch=srch&" uppdateringsdatum LIKE '%"&Request("uppdateringsdatum")&"%' "
srch=Replace(srch," "," AND ")
call showlist(srch,Request("sort"))
case "showsearch"
call showform("search","")
case "showadd"
call showform("add","")
case "add"
changerecord("add") 'plockar info från Request i subrutinen
call showlist("","uppdateringsdatum")
case "change"
changerecord("change") 'plockar info från Request i subrutinen
call showlist("","uppdateringsdatum")
case "showedit"
call showform("edit",Request("id"))
case "showfeedbackform"
call showfeedbackform
case "sendfeedback"
if Request("synpunkter")>"" then
call sendemail("peter.freund@telia.com",Request("fromemail"),"Synpunkter Multimediadatabas "&Request("uppdateringsdatum"),Request("synpunkter"))
call makepage("Tack för dina synpunkter "&Request("fromemail"),"")
end if
case else
end select
call showmenu
call closeandexit
%>
"
' mytable=mytable&"¤"&Cstr(rs.Fields("ID"))
mytable=mytable&"¤"&rs.fields("titel")&""
mytable=mytable&"¤"&rs.fields("forlag")&""
mytable=mytable&"¤"
fl=split(rs.fields("andraURL")&vbLf,vbLf)
for i=0 to UBound(fl)-1
if instr(1,fl(i),"http://") then
mytable=mytable&""
mytable=mytable&split(split(fl(i),"http://")(0),":")(0)&" "
else
mytable=mytable&fl(i)&" "
end if
next
mytable=mytable&"¤"
fl=split(rs.fields("alder"),",")
for i=0 to UBound(fl)
mytable=mytable&trim(left(fl(i),4))&"/"
next
mytable=mytable&"¤"
fl=split(rs.fields("amnen"),",")
for i=0 to UBound(fl)
mytable=mytable&trim(left(fl(i),4))&"/"
next
mytable=mytable&"¤"&rs.fields("uppdateringsdatum")
mytable=fixlink(mytable)
call makepage(mytable,"")
rs.MoveNext()
wend
rs.Close
end sub
sub showfeedbackform
dim myform
call makepage("","")
myform=myform&"Skicka synpunkter "&chr(13)
call makepage(myform,"")
myform=""&chr(13)
myform=myform&"Din e-postadress:¤"
myform=myform&""
call makepage(myform,"")
myform="Synpunkter på multimediadatabasen:¤"
myform=myform&""
myform=myform&""
call makepage(myform,"")
call makepage("","")
call makepage("","")
end sub
sub showform(action,id)
dim myform,rs,f,t,fl
call makepage("","")
fl=split("¤¤¤¤¤¤¤¤¤¤","¤")
' call makepage("","")
select case action
case "search"
myform=""
myform=myform&"Sök "&chr(13)
call makepage(myform,"")
case "add"
myform=""
myform=myform&"Lägg till "&chr(13)
call makepage(myform,"")
case "edit"
myform=""
myform=myform&"Ändra "&chr(13)
call makepage(myform,"")
set rs=Server.CreateObject("ADODB.recordset")
rs.Open "SELECT * FROM multimedia WHERE id="&id, conn
if not rs.EOF then
fl(0)=rs.Fields("ID")
fl(1)=rs.Fields("titel")
fl(2)=rs.Fields("titelURL")
fl(3)=rs.Fields("forlag")
fl(4)=rs.Fields("forlagURL")
fl(5)=rs.Fields("andraURL")
fl(6)=rs.Fields("alder")
fl(7)=rs.Fields("amnen")
fl(8)=rs.Fields("anteckningar")
fl(9)=rs.Fields("uppdateringsdatum")
fl(10)=rs.Fields("signatur")
end if
rs.Close
case else
end select
myform=""
myform=""&chr(13)
myform=myform&"Titel:¤"
myform=myform&""
call makepage(myform,"")
myform="Internetlänk till titeln:¤"
myform=myform&""
call makepage(myform,"")
myform="Namn på förlag:¤"
myform=myform&""
call makepage(myform,"")
myform="Internetlänk till förlaget:¤"
myform=myform&""
call makepage(myform,"")
myform="Andra internetlänkar:¤"
myform=myform&""
myform=myform&"