Hot Shareware 37/hot37.iso/FICHEROS/LVB/CGIT201.ZIP/DEMOGUES.BA_/DEMOGUES.BA

Text File | 1998-06-08 | 8KB | 143 lines

Attribute VB_Name = "modGuestbook"
'VB5-CGI Objects script example: demoGuestbook.bas
'Copyright 1997, 1998 EazyWare - http://www.eazyware.com/vb5-cgi
'---------------------------------------------------------------
'Guest book script which stores the entries in a text file.
'- Creates the HTML document itself, just provide a link to the .exe file.
'- Shows all information on one page.
'- Validates the entries and highlights the missing input fields without JavaScript.
'- Removes HTML tags from entries.
'- Shows the last entry on top of the list.
'- Shows additional information like host and used browser.
'- Doesen't allow to save the same entry multiple times (reload button).
'
'To use the script on WIN95/NT with a Web server you need to:
'- Register VB5CGI.DLL and VB5HTML.DLL using RegSvr32.exe.
'- Copy MSVBVM50.DLL (SP2) to the %System32% or script directory.
'- Compile this script to an .exe (use 'Unattended Execution' in Project Properties).
'
'Remarks:
'- I use '+' instead of '&' to concat strings, because of better performance (type String).
'- The .exe file can be renamed after compilation, because the script name is retrieved dynamically.
'---------------------------------------------------------------------------------------------------

Option Explicit
Private Const METHOD = "GET"            'Method to be used, either 'GET' or 'POST'
Private GuestBookFile As String         'Guest book text filename
Private CGI  As New VB5CGI.clsCGI       'Instance the VB5CGI Object (needs VB5CGI.DLL)
Private HTML As New VB5HTML.clsHTML     'Instance the VB5HTML Object (needs VB5HTML.DLL)

Sub Main()
Dim pos As Integer
Dim msg As String

    With HTML
        GuestBookFile = CGI.GetPath + "demoGuestbook.txt"   'Set the guest book file accordingly
        .ErrorSubText = "<BR><HR SIZE=""1"">Please send your comments to " + _
                        "<A HREF=""mailto:[e-mail]"">EazyWare</A>"
        If .InitQueryString(False, 1024) Then               'Retrieve the query string (from 'GET' or 'POST' method), limit to 1024 chars
            'A query string exists, validate all entries
            If Not .HasKeyValidStringContent("name", htmlLetterUS + htmlSpace, 3, 40) Then
                msg = "Please enter your name (US letters, spaces, 3 to 40 characters):"
                pos = 1
            End If
            If (pos = 0) And Not .HasKeyValidEmail("email") Then
                msg = "Please enter your valid e-mail address:"                                               'And end the script
                pos = 2
            End If
            If (pos = 0) And Not .HasKeyValidStringLen("comment", 1, 300) Then
                msg = "Please enter your comment (1 to 300 characters):"                                               'And end the script
                pos = 3
            End If
            .PageBegin "VB5-CGI Objects demo: Guest Book", "#FFFFFF"
            If pos > 0 Then
                'Validation error occured, show the form with highlighted input fields, but don't show the guest book entries
                .BodyHTML GetGuestbookForm(.GetKeyString("name", True), .GetKeyString("email", True), _
                                           .GetKeyString("comment", True), pos, msg)
            Else
                'No validation error, add the new entry to the top and show all of them
                msg = AddGuestBookEntry(.GetKeyString("name", True), .GetKeyString("email", True), _
                                  .GetKeyString("comment", True))
                .BodyHTML GetGuestbookForm(, , , , "Thanks " + .GetKeyString("name", True) + _
                                          ", your entry has been added to the top!") + msg
            End If
            .PageEnd                'Submit the page
        Else
            'No query string received, show the guest book form and existing entries
            msg = HTML.GetFileText(GuestBookFile, False)
            If msg = "" Then msg = "<HR SIZE=""1""><B>No guest book entry yet ...</B>"
            .PageBegin "VB5-CGI Objects demo: Guest Book", "#FFFFFF"
            .BodyHTML GetGuestbookForm() + msg
            .PageEnd                'Submit the page
        End If
    End With
End Sub

'Returns the the guestbook form as HTML and highlights an invalid input field
Private Function GetGuestbookForm(Optional Name As String, Optional Email As String, Optional Comment As String, _
                                  Optional ErrorPos As Integer, Optional FormTitle As String) As String
Const ERROR_COLOR = "BGCOLOR=""#FF0000"" "
Dim msg As String
Dim namecol As String
Dim emailcol As String
Dim commentcol As String

    Select Case ErrorPos
    Case 1
        namecol = ERROR_COLOR       'Invalid name
    Case 2
        emailcol = ERROR_COLOR      'Invalid e-mail
    Case 3
        commentcol = ERROR_COLOR    'Invalid comment
    End Select
    If FormTitle = "" Then FormTitle = "Would you like to sign the guest book?"
    msg = "<H2>VB5-CGI Objects demo: Guest Book</H2>" + vbCrLf
    msg = msg + "<B>CGI script: " + CGI.GetScriptName + "</B><HR>" + vbCrLf
    msg = msg + "<B>" + FormTitle + "</B>" + vbCrLf
    msg = msg + "<FORM ACTION=""" + CGI.GetScriptName + """ METHOD=""" + METHOD + """>" + vbCrLf
    msg = msg + "<TABLE CELLSPACING=""2"" CELLPADDING=""2"">" + vbCrLf
    msg = msg + "<TR>" + vbCrLf
    msg = msg + "<TD WIDTH=""150"" ALIGN=""RIGHT"" VALIGN=""TOP"" NOWRAP>Your name:</TD>" + vbCrLf
    msg = msg + "<TD " + namecol + "NOWRAP><INPUT TYPE=""Text"" NAME=""name"" Value=""" + Name + """ SIZE=""40"" MAXLENGTH=""40""></TD>" + vbCrLf
    msg = msg + "</TR><TR>" + vbCrLf
    msg = msg + "<TD WIDTH=""150"" ALIGN=""RIGHT"" VALIGN=""TOP"" NOWRAP>Your e-mail address:</TD>" + vbCrLf
    msg = msg + "<TD " + emailcol + "NOWRAP><INPUT TYPE=""Text"" NAME=""email"" Value=""" + Email + """ SIZE=""40"" MAXLENGTH=""40""></TD>" + vbCrLf
    msg = msg + "</TR><TR>" + vbCrLf
    msg = msg + "<TD WIDTH=""150"" ALIGN=""RIGHT"" VALIGN=""TOP"" NOWRAP>Your comments:</TD>" + vbCrLf
    msg = msg + "<TD " + commentcol + "NOWRAP><TEXTAREA NAME=""comment"" COLS=""40"" ROWS=""3"" WRAP=""VIRTUAL"">" + Comment + "</TEXTAREA></TD>" + vbCrLf
    msg = msg + "</TR><TR>" + vbCrLf
    msg = msg + "<TD></TD>" + vbCrLf
    msg = msg + "<TD><INPUT TYPE=""Submit"" VALUE=""Add to guest book""</TD>" + vbCrLf
    msg = msg + "</TR></TABLE></FORM>" + vbCrLf
    GetGuestbookForm = msg
End Function

'Adds a new entry to the guest book file and returns all guest book entries
Private Function AddGuestBookEntry(Name As String, Email As String, Comment As String) As String
Dim ffree  As Integer
Dim addmsg As String
Dim oldmsg As String

    On Error GoTo ErrorRoutine
    oldmsg = HTML.GetFileText(GuestBookFile, False) 'Get the guest book entries
    addmsg = "<HR SIZE=""1""><B>" + Comment + "</B><BR>" + vbCrLf
    addmsg = addmsg + "<FONT SIZE=""-1"">Added by: <A HREF=""mailto:" + Email + """>" + Name + "</A> on: "
    If InStr(oldmsg, addmsg) Then           'Check, if new entry already exists in guest book
        HTML.ErrorPage Name + ", you already entered the same content!<P>This new entry will not be added to the guest book."
        Exit Function
    End If
    addmsg = addmsg + Format$(Now(), "Long Date") + " at: " + Format$(Now(), "Long Time")
    addmsg = addmsg + " host: " + CGI.EnvRemoteHost + " browser: " + CGI.EnvHTTPUserAgent + "</FONT>" + vbCrLf
    addmsg = addmsg + oldmsg
    ffree = FreeFile()
    Open GuestBookFile For Output Lock Write As #ffree
       Print #ffree, addmsg                 'Save it to the guest book
    Close #ffree
    AddGuestBookEntry = addmsg
    Exit Function

ErrorRoutine:
    HTML.ErrorPage "File error occured, please try again!<P>Description: " + Err.Description
    Exit Function
End Function