GLOBAL ReturnURL AS STRING
TYPE SYSTEMTIME
wYear AS INTEGER
wMonth AS INTEGER
wDayOfWeek AS INTEGER
wDay AS INTEGER
wHour AS INTEGER
wMinute AS INTEGER
wSecond AS INTEGER
wMilliseconds AS INTEGER
END TYPEDECLARE SUB HTMLHeader()
DECLARE SUB HTMLFooter()
DECLARE SUB GetLocalTime LIB "KERNEL32.DLL" ALIAS "GetLocalTime" (lpSystemTime AS SYSTEMTIME)
DECLARE FUNCTION GetDateFormat LIB "KERNEL32.DLL" ALIAS "GetDateFormatA" (BYVAL Locale AS LONG, BYVAL dwFlags AS LONG, lpDate AS SYSTEMTIME, lpFormat AS ASCIIZ, lpDateStr AS ASCIIZ, BYVAL cchDate AS LONG) AS LONG
DECLARE FUNCTION GetTimeFormat LIB "KERNEL32.DLL" ALIAS "GetTimeFormatA" (BYVAL Locale AS LONG, BYVAL dwFlags AS LONG, lpTime AS SYSTEMTIME, lpFormat AS ASCIIZ, lpTimeStr AS ASCIIZ, BYVAL cchTime AS LONG) AS LONG
$INCLUDE "PBCGI.INC"
FUNCTION PBMAIN
'+------------------------------------------------------------------------
' program to add entries to a Guestbook file
'
' What this program does:
' Accept Guest book input from a submitted webform.
' Add it to the existing guest book entries
' And, that's about it.
'
' SIGNBK's sister script (GUESTBK) actually reads and formats the data
'
' You have to devise an HTML page with a form to gather the guestbook
' data. There are three required fields for the form, and one optional
' field. The names of the fileds should explain what goes in them:
'
' Required field THENAME == Guest's name
' Required field COMMENTS == Guest's comments for the guest book
' Optional field EMAIL == Guest's e-mail address
' Optional field RETURNURL == Page to take user to after data is saved
'
' Normally, you won't specify a RETURNURL field. This program will
' default the field to "/scripts/guestbk.exe", so that guests will be
' able to see their entry immediately. However, if you do want to
' specifiy this field in the form, you should use a hidden field
'
' If the user enters their e-mail address, their name will be displayed
' as a clickable e-mail link in the guestbook
'
' When the data is saved, the entire guestbook file is re-written so
' that the newest comments are at the beginning. With very lengthy
' guest books, this could become a problem; by then I'll come up
' with a different way of doing it 
'
' This progam doesn't do any file locking, or do much checking for
' simultaneous file access. I wrote it for a relatively low-traffic site
' and don't expect any trouble. ymmv.
'+-------------------------------------------------------------------------
%NULL = 0
%LOCALE_SLONGDATE = &H20 ' long date format string
%LOCALE_STIMEFORMAT = &H1003 ' time format string
%LOCALE_USER_DEFAULT = &H0000
%DATE_SHORTDATE = &H1 ' use short date picture
%DATE_LONGDATE = &H2 ' use long date picture
%TIME_NOSECONDS = &H2& ' do not use seconds
%False = 0
%True = NOT(%False)
DIM TheName AS STRING
DIM TheEMail AS STRING
DIM TheComment AS STRING
DIM TheIP AS STRING
DIM TheDate AS STRING
DIM Keyword AS STRING
DIM Value AS STRING
DIM GBFile AS STRING
DIM TempFile AS STRING
DIM TempStr AS STRING
DIM TempLong AS LONG
DIM oFile AS LONG
DIM iFile AS LONG
DIM st AS LOCAL SYSTEMTIME
DIM d AS LOCAL ASCIIZ * 64
DIM t AS LOCAL ASCIIZ * 64
DIM s AS LOCAL ASCIIZ * 64
DIM i AS LONG
DIM p AS LONG
DIM j AS LONG
DIM Param(1) AS STRING
' change these as appropriate for your site(s)
' Also, look for the NAME command down below..
GBFile = "gbtext.dat"
TempFile = "gbtext.tmp"
ReturnURL = "/scripts/guestbk.exe"
' Read form contents
TempStr = ReadCGI
' Count and parse the parameters into an array
p = ParseParams(TempStr, Param()) ' p= number of parameters.
IF p < 1 THEN
STDOUT "Nothing to process!"
EXIT FUNCTION
END IF
' Get the values into our variables.
FOR i = 1 TO p
j = INSTR(Param(i), "=")
Keyword = UCASE$(LEFT$(Param(i), j-1))
Value = DecodeCGI(MID$(Param(i),j+1))
REPLACE "&" WITH "&" IN Value
REPLACE CHR$(34) WITH """ IN Value
REPLACE "<" WITH "<" IN Value
REPLACE ">" WITH ">" IN Value
IF KeyWord = "THENAME" THEN
TheName = Value
ELSEIF keyWord = "EMAIL" THEN
TheEMail = Value
ELSEIF keyword = "COMMENTS" THEN
TheComment = Value
ELSEIF KeyWord = "RETURNURL" THEN
ReturnURL = Value
END IF
NEXT i
' Now, add them to the top of the file.
' Yeah, it would be easier to put them at the bottom of the pile, but I
' want the newest ones to show up first.
i = 0
TempStr = ""
TempStr = DIR$(TempFile)
WHILE LEN(TempStr) > 0
INCR i
IF i > 10 THEN
STDOUT "Could not update guest book at this time"
EXIT FUNCTION
END IF
TempLong = TIMER + 1
WHILE TIMER < TempLong:
j = i
WEND
TempStr = DIR$(TempFile)
WEND
oFile = FREEFILE
OPEN TempFile FOR OUTPUT AS #oFile
WRITE #oFile, TheName, TheEMail, TheComment, Remote_Addr, DATE$
IF LEN(DIR$(GBFile)) > 0 THEN
iFile = FREEFILE
OPEN GBFile FOR INPUT AS #iFile
WHILE NOT EOF(iFile)
INPUT #iFile, TheName, TheEMail,TheCOmment, TheIP, TheDate
WRITE #oFile, TheName, TheEMail, TheComment, TheIP, TheDate
WEND
CLOSE #iFile
END IF
CLOSE #oFile
' OK, now kill the 'old' file and put the new one in it's place
KILL GBFile
NAME tempFile AS GBFile
' Write an ouput page for the user...
' Get date and time
GetLocalTime st
GetDateFormat %LOCALE_USER_DEFAULT, %DATE_LONGDATE, st, BYVAL %NULL, d, 64
GetDateFormat %LOCALE_USER_DEFAULT, %DATE_SHORTDATE, st, BYVAL %NULL, s, 64
GetTimeFormat %LOCALE_USER_DEFAULT, %TIME_NOSECONDS, st, BYVAL %NULL, t, 64
WriteCGI "<html>"
WriteCGI "<Head>"
WriteCGI "<TITLE>Thanks for signing the guest book</TITLE>
WriteCGI "<META HTTP-EQUIV=''Refresh'' CONTENT=''4; URL=" & ReturnURL & "''>"
WriteCGI "</HEAD>"
WriteCGI "<body TEXT=''#000000'' BGCOLOR=''#CCCCCC''>"
WriteCGI "<P><font face=''verdana,chicago,arial'' size=''4''>" & _
"GuestBook Entry received and processed " & t & ", " & d & " (" & s & ")</font></p>"
WriteCGI "<hr>"
WriteCGI "<P>You should be returned to the guest book in few seconds.</p>"
WriteCGI "<font face=''chicago,courier new,arial'' size=''2''>
WriteCGI "</BODY>"
WriteCGI "</HTML>"
END FUNCTION
PowerBASIC Forums
UBBFriend: Email This Page to Someone! 
posted July 04, 2000 11:13 AM
