omskrivning af et stykke kode
Hej eksperter....jeg har en kode, resultet:
http://www.questis.dk/billeder/links.asp
koden:
<% response.buffer = true %>
<html>
<head>
<title>Links</title>
<style type="text/css">
<!--
body {margin: 5;font-family:verdana}
a.menu {text-decoration:none;color:#000000}
a.menu:hover {text-decoration:none;color:#000000}
a {text-decoration:none;color:#000000}
a:hover {text-decoration:underline;color:#000000}
INPUT
{
BACKGROUND-COLOR: #FFFFFF;
COLOR: #000000;
FONT-FAMILY: verdana, helvetica, sans-serif;
FONT-SIZE: 12px;
FONT-STYLE: normal;
border: 1 solid #000000;
}
Textarea
{
BACKGROUND-COLOR: #FFFFFF;
COLOR: #000000;
FONT-FAMILY: verdana, helvetica, sans-serif;
FONT-SIZE: 12px;
FONT-STYLE: normal;
border: 1 solid #000000;
}
-->
</style>
</head>
<body>
<%
strMode = Request.Querystring("mode")
select case strMode
case "id"
Response.Buffer = True
' Her opdateres hits når brugeren bliver sendt til et link
Set myConn = Server.CreateObject("ADODB.Connection")
myConn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("links.mdb")
If Request.QueryString("id") <> "" Then
Set rs = Server.CreateObject("ADODB.RecordSet")
strSQL = "SELECT * FROM links WHERE (ID = " & Request.QueryString("id") & ")"
rs.Open strSQL, myConn, 1, 3
If Not (rs.BOF Or rs.EOF) Then
rs("Hits") = rs("Hits") + 1
strURL = rs("URL")
rs.Update
rs.Close
myConn.Close
Set rs = Nothing
Set myConn = Nothing
Response.Clear
Response.Redirect(strURL)
End If
End If
%>
<% case "search"
' Siden med søgeresultater
' Database connection
Set myConn = Server.CreateObject("ADODB.Connection")
myConn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("links.mdb")
' Henter søgeorden fra formularen
strKeyword = Trim(Request.Form("søgeord"))
If Len(strKeyword) = 0 Then
' Hvis der ikke er skrevet i formularen sendes brugeren tilbage
Response.Clear
Response.Redirect ("links.asp?mode=søg")
Else
strKeyword = Replace(strKeyword,"'","''")
End If
' Opbygger en dynamisk SQL streng
strSQL = "SELECT * FROM links WHERE"
strSQL = strSQL & " (godkendt = 'ja') AND ("
strSQL = strSQL & " (id LIKE '%" & strKeyword & "%')"
strSQL = strSQL & " OR (navn LIKE '%" & strKeyword & "%')"
strSQL = strSQL & " OR (url LIKE '%" & strKeyword & "%')"
strSQL = strSQL & " OR (beskrivelse LIKE '%" & strKeyword & "%')"
strSQL = strSQL & " OR (hits LIKE '%" & strKeyword & "%')"
strSQL = strSQL & " OR (søgeord LIKE '%" & strKeyword & "%'))"
Response.Write "<table width=""500"" cellspacing=""1"" cellpadding=""3"">"
Response.Write "<tr><td width=""100%"" colspan=""2"" bgcolor=""#C0FFFF""><font size=""1""><b>Links</b> » <b>Søgeresultater for " & strKeyword & "</b></font></td></tr>"
Response.Write "<tr><td bgcolor=""#00A458""><font size=""1""><b>Navn/beskrivelse</b></font></td><td bgcolor=""#CCCCCC""><font size=""1""><b>Hits</b></font></td></tr>"
' Skaber et recordset udfra SQL strengen
Set rs = myConn.Execute(strSQL)
If Not (rs.BOF Or rs.EOF) Then
' Hvis søgningen gav resultat
Do While Not rs.EOF
If farve=1 Then
bg="#FCFCFC"
Farve= Farve + 1
Else
bg="#C0FFFF"
farve=1
End If
Response.Write "<tr><td valign=top bgcolor=" & bg & "><font size=2><b><a href=""links.asp?mode=id&id=" & rs("ID") & """ target=""_blank"">" & rs("Navn") & "</a></b><br>" & rs("Beskrivelse") & "</font></td>"
Response.Write "<td valign=top align=center width='30' bgcolor=" & bg & "><font size=2>" & rs("Hits") & "</font></td></tr>"
rs.MoveNext
Loop
Else
' Hvis ingen poster passede på søgordene
Response.Write "<tr><td align=center width=""100%"" colspan=""2"" bgcolor=#e5e5e5><font size=""2""><b>Ingen sider passede på søgeordet</b></font></a></td></tr>"
End If
response.write "<tr><td align=""right"" colspan=""2"" bgcolor=""#00A458""><font size=""1""><b><a href=""links.asp"" class=""menu"">» Oversigt</a> <a href=""links.asp?mode=søg"" class=""menu"">» Søg igen</a> <a href=""links.asp?mode=add"" class=""menu"">» Tilføj links</a></b> </font></td></tr></table></td></tr>"
Response.Write "</table><br><br>"
%>
<% case "søg"
' Søgeformularen
Response.write "<form method=POST action=links.asp?mode=search><table width=""500"" cellspacing=""1"" cellpadding=""3"" border=""0"">"
Response.write "<tr><td bgcolor=""#C0FFFF""><font size=""1""><b>Links</b> » <b>Søg</b></font></td></tr>"
Response.write "<tr><td bgcolor=""#FCFCFC""><input type=""text"" name=""søgeord"" size=""60""></td></tr>"
Response.write "<tr><td bgcolor=""#C0FFFF""><input type=""submit"" value="" søg "" name=""send""></td></tr>"
response.write "<tr><td align=""right"" bgcolor=""#00A458""><font size=""1""><b><a href=""links.asp"" class=""menu"">» Oversigt</a> <a href=""links.asp?mode=add"" class=""menu"">» Tilføj links</a></b> </font></td></tr></table></form>"
%>
<% case "update"
' Sender resultaterne fra tilføj links til databasen
' Database connection
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & server.MapPath("links.mdb")
' Opbygger SQL streng
SQLstmt = "INSERT INTO links (navn,url,beskrivelse,hits,søgeord,kategori,godkendt)"
SQLstmt = SQLstmt & " VALUES ('" & request.form("navn") & "','" & request.form("url") & "','" & replace(request.form("beskrivelse"),"'","''") & "','" & request.form("hits") & "','" & request.form("søgeord") & "','" & request.form("kategori") & "','nej')"
response.write sqlstmt
Conn.Execute (SQLstmt)
conn.Close
Set conn = nothing
Set SQLstmt = nothing
' Sender brugeren tilbage til links når databasen er opdateret
response.redirect ("links.asp")
%>
<% case "add"
' tilføj links
%>
<form method="POST" action="links.asp?mode=update">
<table border="0" width="500" cellpadding="3" cellspacing="1">
<tr><td colspan="2" bgcolor="#C0FFFF"><font face="verdana" size="1"><b>Links</b></font></td></tr>
<tr><td colspan="2" bgcolor="#00A458"><font face="verdana" size="1"><b>Tilføj link</b></font></td></tr>
<tr>
<td width="35%" bgcolor="#C0FFFF"><font face="Verdana" size="2"><b>Navn</font></td>
<td width="65%" bgcolor="#C0FFFF">
<p><input type="text" name="navn" size="32"></p>
</td>
</tr>
<tr>
<td width="35%" bgcolor="#FCFCFC"><font face="Verdana" size="2"><b>url</b></font></td>
<td width="65%" bgcolor="#FCFCFC"><input type="text" name="url" value="http://" size="32"></td>
</tr>
<tr>
<td width="35%" bgcolor="#C0FFFF" valign="top"><font face="Verdana" size="2"><b>beskrivelse</b></font></td>
<td width="65%" bgcolor="#C0FFFF"><textarea name="beskrivelse" cols="32"></textarea></td>
</tr>
<tr>
<td width="35%" bgcolor="#FCFCFC" valign="top"><font face="Verdana" size="2"><b>Kategori</b></font></td>
<td width="65%" bgcolor="#FCFCFC"><select name="kategori">
<%
Set rs = Server.CreateObject("ADODB.RecordSet")
strSQL = "SELECT * FROM kategorier ORDER BY kategori"
strDSN = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&Server.MapPath("links.mdb")
rs.Open strSQL, strDSN, 1
If Not (rs.BOF Or rs.EOF) Then
Do until rs.EOF = True
Response.Write "<option value='" & rs("id") & "'>" & rs("kategori") & vbCrLf
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
%></select></td>
</tr>
<tr>
<td width="35%" bgcolor="#C0FFFF" valign="top"><font face="Verdana" size="2"><b>Søgeord</b><br>Adskilles med komma!</font></td>
<td width="65%" bgcolor="#C0FFFF"><input type="text" name="søgeord" size="32"></td>
</tr>
<tr>
<td width="100%" bgcolor="#FCFCFC" colspan="2"><input type="hidden" value="0" name="hits"><input type="submit" value="Send" name="send" style="background-color:#C0FFFF">
<input type="reset" value="Annuller" name="anuller" style="background-color:#C0FFFF"></td>
</tr>
<tr><td colspan="2" align="right" bgcolor="#00A458"><font size="1"><b><a href="links.asp" class="menu">» Links</a> <a href="links.asp?mode=søg" class="menu">» Søg i links</a></b> </font></td></tr></table>
</form>
<% case "vis"
' Hvis der ikke er valgt noget mode vises alle links
' Paging
intPage = Request("page")
rpage = "&page=" & request("page")
If isNumeric(intPage) = False Or intPage < 1 Then
intPage = 1
rpage = "&page=1"
End If
orderby = request("orderby")
if request("orderby") <> "" then
orderby = request("orderby")
else
orderby = "navn"
end if
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("links.mdb")
Set kat = Conn.Execute("SELECT kategori FROM kategorier WHERE id=" & request("kat") & "")
katg = kat("kategori")
Set kat = nothing
Conn.Close
Set Conn = Nothing
' Database connection
Response.Write "<table width='500' cellspacing='1' cellpadding='3'>"
Set rs = Server.CreateObject("ADODB.RecordSet")
strSQL = "SELECT * FROM links WHERE kategori='" & request("kat") & "' AND godkendt='ja' ORDER BY " & orderby & ""
strDSN = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&Server.MapPath("links.mdb")
rs.Open strSQL, strDSN, 1
Response.Write "<tr><td width='100%' colspan=""2"" bgcolor=""#C0FFFF""><font size=""1""><b>Links</b> » <b>" & katg & "</b></font></td></tr>"
If Not (rs.BOF Or rs.EOF) Then
Response.Write "<tr><td bgcolor=""#00A458""><font size=""1""><b><a href=""links.asp?mode=vis&kat=" & request("kat") & rpage & "&orderby=navn"" class=""menu"">Navn/beskrivelse</a></b></font></td><td bgcolor=""#00A458"" align=""center""><font size=""1""><b><a href=""links.asp?mode=vis&kat=" & request("kat") & rpage & "&orderby=hits"" class=""menu"">Hits</a></b></font></td></tr>"
rs.PageSize = 7
rs.AbsolutePage = intPage
intRecCount = rs.PageSize
intPageCount = rs.PageCount
Do While Not rs.EOF And intRecCount > 0
If farve=1 Then
bg="#FCFCFC"
Farve= Farve + 1
Else
bg="#C0FFFF"
farve=1
End If
Response.Write "<tr><td valign=top bgcolor=" & bg & "><font size=2><b><a href=""links.asp?mode=id&id=" & rs("ID") & """ target=""_blank"">" & rs("Navn") & "</a></b><br>" & rs("Beskrivelse") & "</font></td>"
Response.Write "<td valign=top align=center width='30' bgcolor=" & bg & "><font size=2>" & rs("Hits") & "</font></td></tr>"
intRecCount = intRecCount - 1
rs.MoveNext
Loop
else
response.write "<tr><td colspan=""2"" align=""center""><font size=""1""><b>Der er ingen links i denne kategori!</b></font></td><tr>"
End If
rs.Close
Set rs = Nothing
' Navigering mellem siderne med paging
Response.Write "<tr><td colspan=""2"" bgcolor=""#00A458"">"
Response.Write "<table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""100%""><tr><td bgcolor=""#00A458""><font size='1'>"
If Clng(intPage) > 1 Then
Response.Write "<a href=links.asp?mode=vis&kat=" & request("kat") & "&page=" & intPage - 1 & "&orderby=" & request("orderby") & " class=""menu"">[<<]</a> "
Else
Response.Write ""
End If
Response.Write ""
For intNum = 1 To intPageCount
Response.Write " <a href=links.asp?mode=vis&kat=" & request("kat") & "&page=" & intNum & "&orderby=" & request("orderby") & " class=""menu""><b>" & intNum & "</b></a> "
Next
If Clng(intPage) < Clng(intPageCount) Then
Response.Write " <a href=links.asp?mode=vis&kat=" & request("kat") & "&page=" & intPage + 1 & "&orderby=" & request("orderby") & " class=""menu"">[>>]</a>"
Else
Response.Write ""
End If
Response.write "</b> Side <b>" & intPage & "</b> af " & intPageCount & "</font></td><td align=""right""><font size=""1""><b><a href='links.asp' class=""menu"">» Oversigt</a> </font></td></tr></table></td></tr></table>"
case else
' Database connection
Set rs = Server.CreateObject("ADODB.RecordSet")
strSQL = "SELECT * FROM kategorier ORDER BY kategori"
strDSN = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&Server.MapPath("links.mdb")
rs.Open strSQL, strDSN, 1
If Not (rs.BOF Or rs.EOF) Then
Response.Write "<table width='500' cellspacing='1' cellpadding='3'>"
Response.Write "<tr><td width='100%' bgcolor=""#C0FFFF""><font size=""1""><b>Links</b></font></td></tr>"
Response.Write "<tr><td width='100%' bgcolor=""#00A458""><font size=""1""><b>Kategorier</b></font></td></tr>"
Do until rs.EOF = True
If farve=1 Then
bg="#FCFCFC"
Farve= Farve + 1
Else
bg="#C0FFFF"
farve=1
End If
Response.Write "<tr><td width='100%' bgcolor=""" & bg & """><font size=""2""><a href='links.asp?mode=vis&kat=" & rs("id") & "&orderby=navn'><b>" & rs("kategori") & "</b></a></font></td></tr>"
rs.MoveNext
Loop
End If
Response.Write "<tr></tr>"
Response.Write "</table>"
rs.Close
Set rs = Nothing
end select %>
</body>
</html>
det eneste jeg beder om, er en der kan fjerne den funktion der hedder link, så den egentligt fungerer som en gæstebog i kattegorier
mvh.
questis.dk
p.s. spørg hvis i ikke forstår.
