Kompilierungsproblem

massel · 23. April 2005

hiho, ich hab da nen script und wollte versuche das verzweifelt durch meine webmatrix laufen zu lassen. es tritt ständig ein kompilierungsproblem. kann jemand diesen code mal kompen und mir da den fehler findig machen? er sagt er akzeptiert nur eine page-direktive, ich sehe da nur eine und nicht mehr... plz

(das ist nen script eines gästebuches)

<html>
<head>
</head>
<body>
<form runat="server">
<% @ Language="VBScript"
LCID = 1031 %><%
Option Explicit
Response.Buffer = true
Session.LCID = 1031

Public Submit, strName, strOrt, strEmail, strInternetSeite, strText, strConn, PageSize
Public FehlerName, FehlerText, Fehler, MaxLaengeText, FehlerMaxLaengeText, FehlerEmail
Public strTmpText

'Datenbank-Pfad, falls Sie ein anderer DBPfad
'verwenden, müssen Sie den Pfad hier ändern.
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
Server.MapPath("db\Gaestebuch.mdb")

'Anzahl der Datensätze pro Seite
PageSize = 10

'Wieviele Zeichen darf der Benutzer maximal eingeben?
'Eventuell für den Text in der DB ein Memofeld verwenden.
MaxLaengeText = 255

Submit = Request.Form("submit1")
strName = Request.Form("Name")
strOrt = Request.Form("Ort")
strEmail = Request.Form("Email")
strInternetSeite = Request.Form("InternetSeite")
strText = Request.Form("Text")

strTmpText = MyHTMLEncode(strText)

If len(strInternetSeite) > 0 Then
If LCase(Left(strInternetSeite,7)) <> "http://" Then
strInternetSeite = "http://" & strInternetSeite
End if
End if

Call HTMLHeader

Select Case Submit
Case "Zur Vorschau"
Call GBPruefung()
Call Formular()
Case "Eintragen"
Call GBPruefung
If Fehler Then
Call Formular()
Else
Call InDBEintragen()
Call EmailSenden()
Response.Redirect("Gaestebuch.asp")
End if
Case "Neu"
Call NeuerEintrag()
Call Formular()
Call SchreibeGBEintraege()
Case Else
Call Formular()
Call SchreibeGBEintraege()
End Select

Call HTMLFooter

Public Sub Formular() %>
</form>
<form action="Gaestebuch.asp" method="post">
<table cellspacing="3" cellpadding="0" width="550" align="center">
<tbody>
<tr bgcolor="#808080">
<td align="middle" colspan="2">
<font class="GBHeader">Mein Gästebuch <% If Submit = "Zur Vorschau" Then
Response.Write("- Vorschau")
End if %></font></td>
</tr>
<tr>
<td>
<table bgcolor="#e0e0e0">
<% If Fehler Then
%>
<tbody>
<tr>
<td align="middle" colspan="2">
<font class="Fehler1"><< Bitte füllen Sie alle Felder korrekt aus >> </font></td>
</tr>
<%
End if %><% If FehlerMaxLaengeText Then
%>
<tr>
<td align="middle" colspan="2">
<font class="Fehler2"><< Der verwendete Text ist zu lang, maximal erlaubte Länge: <% = MaxLaengeText %>Zeichen
>> </font></td>
</tr>
<%
End if %>
<tr>
<td align="left" width="300">
<% If FehlerName Then %><font class="Fehler2"><% Else %><font size=+0><% End if %>Ihr
Name:</font> </font></td>
<td align="right">
<input id="Name" type="text" maxlength="100" size="40" value="<% = strName %>" name="Name" />
</td>
</tr>
<tr>
<td>
<font size=+0>Woher kommen Sie (Optional)?:</font>
</td>
<td align="right">
<input id="Ort" type="text" maxlength="100" size="40" value="<% = strOrt %>" name="Ort" />
</td>
</tr>
<tr>
<td>
<% If FehlerEmail Then %><font class="Fehler2"><% Else %><font size=+0><% End if %>Ihre
Emailadresse:</font> </font></td>
<td align="right">
<input id="Email" type="text" maxlength="100" size="40" value="<% = strEmail %>" name="Email" />
</td>
</tr>
<tr>
<td>
<font size=+0>Ihre Internetseite (Optional):</font>
</td>
<td align="right">
<input id="InternetSeite" type="text" maxlength="100" size="40" value="<% = strInternetSeite %>" name="InternetSeite" />
</td>
</tr>
<tr>
<td colspan="2">
<hr color="#104070" noshade="noshade" />
</td>
</tr>
<tr>
<td colspan="2">
<% If FehlerText OR FehlerMaxLaengeText Then %><font class="Fehler2"><% Else %><font size=+0><% End if %>Ihr
Text für das Gästebuch:</font> </font></td>
</tr>
<tr>
<td colspan="2">
<textarea id="Text" name="Text" rows="5" cols="65"><% = strText %></textarea>
</td>
</tr>
<tr>
<td align="middle" colspan="2">
<input id="submit1" type="submit" value="Zur Vorschau" name="submit1" />
   <% If Submit = "Zur Vorschau" OR Submit = "Eintragen" Then %>
<input id="submit1" type="submit" value="Eintragen" name="submit1" />
   <% End if %>
<input id="reset1" type="reset" value="Löschen" name="reset1" />
</td>
</tr>
</tbody>
</table>
</td>
</tr>
</tbody>
</table>
</form>
<form runat="server">
<%
End Sub

Public Sub SchreibeGBEintraege()
%><font size=+0>
<table width="550" align="center">
<tbody>
<tr>
<td>
<hr color="#202020" noshade="noshade" />
</td>
</tr>
<tr>
<td class="td2">
<font size=+0>Für einen Beitrag im Gästebuch füllen Sie bitte die Felder

massel · 23. April 2005

Name, Email
& Text aus. Beachten Sie bitte die Netikette. HTML-Code wird nicht ausgeführt. </font></td>
</tr>
<tr>
<td>
<hr color="#202020" noshade="noshade" />
<br />
</td>
</tr>
<%
Dim rs, strSQL, intCounter, Page
Dim intPageCounter
set rs = Server.CreateObject("ADODB.Recordset")

intCounter = 1
Page = Request("Page")

'Falls ein GBEintrag nicht erwünscht ist, braucht man einfach nur den Status
'in der DB auf false setzen.
strSQL = "Select * from tblGaesteBuch WHERE Status LIKE 'true' ORDER BY EintragsID DESC"
rs.PageSize = PageSize
rs.Open strSQL, strConn, 3, 3
If not rs.eof Then
If len(Page) = 0 OR NOT isNumeric(Page) Then
Page = 1
Elseif CDbl(Page) > CDbl(rs.PageCount) OR CDbl(Page) < 1 Then
Page = 1
End if
rs.AbsolutePage = Page

Do while not rs.eof And intCounter <= PageSize
if (intCounter Mod 2) > 0 Then
%>
<tr>
<td>
<%
else
%></td>
</tr>
<tr>
<td class="td2">
<%
end if

%><font class="GBText1"><% = rs.fields("GBText").value %></font>
<br />
<font class="GBText2"><%

Response.Write(rs.fields("GBName").value & ", " & rs.fields("Email").value & "<br />")
If len(rs.fields("InternetSeite").value) > 0 Then
%>Internet-Seite: <a href="<% = rs.fields(" %
InternetSeite?).value>"
target="_blank" class="GB"><% = rs.fields("InternetSeite").value %></a>
<br />
<%
end if

If len(rs.fields("Ort").value) > 0 Then
Response.Write(rs.fields("Ort").value & ", ")
End if
Response.Write(rs.fields("Datum").value)

%></font>
<hr color="#202020" noshade="noshade" />
</td>
</tr>
<%

intCounter = intCounter + 1
rs.moveNext
Loop %>
<tr>
<td align="middle">
<%
If not rs.PageCount = "1" then
If not Page = 1 Then
%> <a class="NavLeiste" href="GaesteBuch.asp?Page=<% = Page - 1 %>"><< </a> <%
End if

For intPageCounter = 1 To rs.PageCount
If CDbl(intPageCounter) = CDbl(Page) Then
%> <font class="NavLeiste2"><% = intPageCounter %></font> <%
Else
%> <a class="NavLeiste" href="GaesteBuch.asp?Page=<% = intPageCounter %>"><% = intPageCounter %></a> <%
End if
Next

If CDbl(rs.PageCount) > CDbl(Page) Then
%> <a class="NavLeiste" href="GaesteBuch.asp?Page=<% = Page + 1 %>">  >></a> <%
End if
End if
Else
%>
</td>
</tr>
<tr>
<td align="middle">
 <br />
Leider noch keine Beiträge im Gästebuch.
</td>
</tr>
<%
End If
rs.close
set rs = nothing
%>
</tbody>
</table>
</font><%
End Sub

Public Sub InDBEintragen()
Dim rs, strSQL, HTTP
strName = MyHTMLEncode(strName)
strEmail = strEmail
strInternetSeite = MyHTMLEncode(strInternetSeite)
strOrt = MyHTMLEncode(strOrt)
strText = MyHTMLEncode(strText)

'Daten vom Client in die DB schreiben, inkl. IP-Adresse
'und Browsername & Betriebssystem.
HTTP = Request.ServerVariables("REMOTE_ADDR") & ";" & _
Request.ServerVariables("HTTP_USER_AGENT")
Call MyHTMLEncode(HTTP)
HTTP = left(HTTP, 255)

set rs = Server.CreateObject("ADODB.Recordset")
strSQL = "INSERT INTO tblGaesteBuch " & _
"(GBName,Email,InternetSeite,Ort,GBText,Datum,HTTP) " & _
"Values (" & _
"'" & strName & "'," & _
"'" & strEmail & "'," & _
"'" & strInternetSeite & "'," & _
"'" & strOrt & "'," & _
"'" & strText & "'," & _
"'" & ISODatum(date()) & " " & time() & "'," & _
"'" & HTTP & "')"

rs.open strSQL, strConn, 3, 3
set rs = nothing
End Sub

Public Function ISODatum(ByVal strDatum)
Dim Tag, Monat, Jahr, i
'Datumsformat feststellen:
'2003-06-29 oder 06/29/2003 oder 29.06.2003?
If instr(1,strDatum,"-") Then
'ISO-Datum, Bearbeitung nicht erforderlich, Function kann beendet werden
'Datum muss als Rückgabewert angegeben werden.
ISODatum = strDatum
Exit Function
ElseIf instr(1,strDatum,".") Then
'29.06.2003
'Tag und Monat und Jahr ausfiltern
'Monat ausfiltern
If mid(strDatum,2,1) = "." Then
Tag = "0" & left(strDatum,1)
i = 3
Else
Tag = left(strDatum,2)
i = 4
End if

'Monat ausfiltern
If mid(strDatum,i+1,1) = "." Then
Monat = "0" & mid(strDatum,i,1)
i = i + 2
Else
Monat = mid(strDatum,i,2)
i = i + 3
End if
ElseIf instr(1,strDatum,"/") Then
'Monat ausfiltern
If mid(strDatum,2,1) = "/" Then
Monat = "0" & left(strDatum,1)
i = 3
Else
Monat = left(strDatum,2)
i = 4
End if

'Tag ausfiltern
If mid(strDatum,i+1,1) = "/" Then
Tag = "0" & mid(strDatum,i,1)
i = i + 2
Else
Tag = mid(strDatum,i,2)
i = i + 3
End if
Else
'Unbekanntes Datumsformat, hier kann entweder eine Fehlermeldung stehen,
'oder es kann das aktuelle Datum als ISO-Datum ausgegeben werden, dies sähe
'so aus:
Tag = day(date)
Monat = month(date)
Jahr = year(date)
ISODatum = Jahr & "-" & Monat & "-" & Tag
Exit Function

'Fehlerausgabe
Response.Write("Falsche Datumsangabe")
Exit Function
End If

'Jahr ausfiltern, dabei auf ein-, zwei- und vierstellige
'Jahreszahl-Angaben achten
If NOT IsNumeric(mid(strDatum,i+1,1)) Then
Jahr = "200" & mid(strDatum,i,1)
i = i + 2
Elseif NOT IsNumeric(mid(strDatum,i+2,1)) Then
Jahr = "20" & mid(strDatum,i,2)
i = i + 3
Else
Jahr = mid(strDatum,i,4)
i = i + 5
End if

'WertÜbergabe
ISODatum = Jahr & "-" & Monat & "-" & Tag
End Function

Public Sub GBPruefung()
If NOT PruefEmail(strEmail) Then
FehlerEmail = true
End if
If NOT Len(strName) > 2 Then
FehlerName = true
End if
If NOT Len(strTmpText) > 2 Then
FehlerText = true
End if
If len(strTmpText) > MaxLaengeText Then
FehlerMaxLaengeText = true
end if
If FehlerEmail OR FehlerName OR FehlerText OR FehlerMaxLaengeText Then
Fehler = true
Else
Fehler = false
End if
End Sub

Public Sub EmailSenden()
Dim strEmailText

strEmailText = "Anbei ein Gästebucheintrag von:" & strName & _
vbcrlf & vbcrlf & _
"Text:" & vbcrlf & strText

Dim objMail
Set objMail = Server.CreateObject("JMail.SMTPMail")
objMail.ServerAddress = "ServerAdresse_hier_angeben"
objMail.Sender = "Info@IhreDomain.de"
objMail.Subject = "Gästebucheintrag"
objMail.AddRecipient "Webmaster@IhreDomain.de"
objMail.Body = strEmailText
On Error Resume Next
objMail.Execute
If Err.number > 0 Then
EmailSenden = false
Else
EmailSenden = true
End If
On Error GoTo 0
End Sub

Public Function PruefEmail(ByRef PruefAdresse)
Dim strDomains, arrDomains, i, Adresse
If len(PruefAdresse) > 0 Then
If instr(2,PruefAdresse,"@") > 0 Then
If instr(instr(1,PruefAdresse,"@") + 4,PruefAdresse, ".") > 0 then
Adresse=Right(PruefAdresse,len(PruefAdresse)-InstrRev(PruefAdresse,".",-1))
strDomains = "aero,ac,ad,ae,af,ag,ai,al,am,an,ao,aq,ar,arpa,as,at,au," & _
"aw,az,ba,bb,bd,be,bf,bg,bh,bi,biz,bj,bm,bn,bo,br,bs,bt,bv,bw,by,bz," & _
"ca,cc,cd,cf,cg,ch,ci,ck,cl,cm,cn,co,com,coop,cr,cu,cv,cx,cy,cz,de," & _
"dj,dk,dm,do,dz,ec,edu,ee,eg,eh,er,es,et,eu,fi,fj,fk,fm,fo,fr,ga,gd," & _
"ge,gf,gg,gh,gi,gl,gm,gn,gov,gp,gq,gr,gs,gt,gu,gw,gy,hk,hm,hn,hr,ht," & _
"hu,id,ie,il,im,in,info,io,iq,ir,is,it,je,jm,jo,jp,ke,kg,kh,ki,km,kn," & _
"kp,kr,kw,ky,kz,la,lb,lc,li,lk,lr,ls,lt,lu,lv,ly,ma,mc,md,mg,mh,mk," & _
"ml,mm,mn,mo,mp,mq,mr,ms,mt,mu,museum,mv,mw,mx,my,mz,na,name,nc,ne," & _
"net,nf,ng,ni,nl,no,np,nr,nu,nz,om,org,pa,pe,pf,pg,ph,pk,pl,pm,pn,pr," & _
"pro,ps,pt,pw,py,qa,re,ro,ru,rw,sa,sb,sc,sd,se,sg,sh,si,sj,sk,sl,sm," & _
"sn,so,sr,st,su,sv,sy,sz,tc,td,tf,tg,th,tj,tk,tm,tn,to,tp,tr,tt,tv,tw,tz," & _
"ua,ug,uk,um,us,uy,uz,va,vc,ve,vg,vi,vn,vu,wf,ws,ye,yt,yu,za,zm,zr,zw"
arrDomains = Split(strDomains,",")
For i = 0 to Ubound(arrDomains)
If arrDomains(i) = LCase(Adresse) Then
PruefEmail = true
Exit Function
End if
Next
End if
End if
End if
PruefEmail = false
End Function

Public Function MyHTMLEncode(ByVal mystrText)
'Aufgabe: Text so Kodieren, daß HTML, CSS
'und Javascript nicht ausgeführt wird.
If len(mystrText) > 0 Then
mystrText = Trim(mystrText)
mystrText = Replace(mystrText, "<", "<")
mystrText = Replace(mystrText, ">", ">")
mystrText = Replace(mystrText, "'", "''")
mystrText = Replace(mystrText, "€", "€")
mystrText = Replace(mystrText, "€", "€")
mystrText = Replace(mystrText, "&euro", "€")
mystrText = Replace(mystrText, vbcrlf, "<br>")
End If
MyHTMLEncode = mystrText
End Function

Public Sub NeuerEintrag()
%>Vielen
Dank für Ihren Gästebucheintrag, <a href="Gaestebuch.asp">hier</a> gehts wieder zum
Gästebuch. <%
End Sub

Public Sub HTMLHeader()
%> <style>
body{font-family:arial;font-size:12;}
font{font-size:12;}
.GBHeader{font-size:25;font-weight:bold;color:#ffd700;}
.Fehler1{color:#ff0000;font-size:17;font-weight:bold;}
.Fehler2{color:#ff0000;font-size:13;font-weight:bold;}
td.td2{background-color:#f0f0f0;}
.GBText1{font-weight:bold;}
a:link{color:#0000ff}
a:hover{color:#ff0000;}
.NavLeiste{color:#0020b0;font-weight:bold;font-size:16}
.NavLeiste:hover{color:#ff2000;font-weight:bold;font-size:16}
.NavLeiste2{color:#202020;font-size:15}
</style>
<%
End Sub

Public Sub HTMLFooter()
%><%
End Sub
%>

</form>
</body>
</html>

Luzie · 23. April 2005

Hi

für die Programmierer hier ist es immer wichtig zu wissen, wie genau der Fehler heißt (Fehlertext posten) und vor allem, welche Zeile es betrifft (Zeile kenntlich machen). Sonst sucht man sich wirklich dumm und dämlich.

Atoc würde ich jetzt erstmal sagen, bezieht sich die Meldung auf option explicit.
Diese gehört über den header, also noch vor <html> und direkt unter die Angabe der Scriptsprache.

Code:

<% @ Language="VBScript" %>
<% Option Explicit
Response.Buffer = true
Session.LCID = 1031
%>
<html>
<head>
</head>
<body>
[...]

Kompilierungsproblem

massel

Mitglied

massel

Mitglied

Luzie

Erfahrenes Mitglied

Neue Beiträge