modebiz.bas

用VB做的CGI程序 用VB做的CGI程序

Attribute VB_Name = "Module1"
'***********************************************************
'               E-BIZ. V 1.0
'           KRISHNA RATH. email: [e-mail]
'               March 2000
'***********************************************************
'
'E-biz is an interactive "bussiness WinCGI software". It uses the standard POST
'and GET Methods to get the user information and handles it accordingly.
'It has also a user database. Registered users can shop online!
'Unregistered users can create a new account.
'If the user name has been registered then you will be asked to enter again!
' And in case you forget your password, you can retrive it by giving the email you entered while signing up!
'
'This Program uses CGI32.BAS module to handle all CGI calls. I like this module very much!
'
'
'Please read the "install.html" which comes with the zip file to understand
' the installation process
'
'This program shows:
'1. How to register a new user
'2. How to accept an already registered user
'3. Retriving a lost password of a registered user
'4. Online shopping...shop till you run out of money!
'
'You can add many web pages, add a VISA card membership have the address of
' the users . Corresponding changes have to be made in this program.
'
'Oh yes! E-com programs are not made using CGI calls...cause they can be easily trapped!
'
'Sorry for any typing or spelling mistakes...I made this program in a big hurry! I had
'to design web pages along with the corresponding changes in this program etc and
'then get back to my college work!
'
'Since this is Version 1.0 There are not many error handling codes.
'Please report Bugs and modifications at [e-mail]
'If you make any decent change in this program please mail me the source code
' so that I can too work on it.
'

Public db As Database
Public rs As Recordset
Public qd  As QueryDef
Public LoginSuccess, UserRegistered As Boolean  'flags that help while login
Public UserName, UserPassword, UserEmail As String  'the username, password and email
Public PurchasesMade As String

Type MONEY                  '2 currencies are used: US$ and Indian Ruppes
    USdollar As Long
    IndianRu As Long
End Type

Global B_Amount(8) As MONEY      'Book_amount for each book.
Global CD_Amount(4) As MONEY     'the number represents the
Global MB_Amount(4) As MONEY     'cost of each item covered in a check box

Public USamount, IndAmount As Long  'Books_countryAmount


Sub Inter_Main()
'Interactive start
Dim x As String
x = x & "E-biz is an interactive 'bussiness WinCGI software'. It uses the standard POST "
x = x & "and GET Methods to get the user information and handles it accordingly."
x = x & " It has also a user database. Registered users can shop online!"
x = x & " Unregistered users can create a new account."
x = x & " And in case you forget your password, you can retrive it by giving the email you entered while signing up!" & vbNewLine & vbNewLine
x = x & " This Program uses CGI32.BAS module to handle all CGI calls. I like this module very much!"
x = x & " Please read the 'install.html' which comes with the zip file to understand"
x = x & " the installation process" & vbNewLine & vbNewLine
x = x & " This program shows:" & vbNewLine
x = x & " 1. How to register a new user" & vbNewLine
x = x & " 2. How to accept an already registered user" & vbNewLine
x = x & " 3. Retriving a lost password of a registered user" & vbNewLine
x = x & " 4. Online shopping...shop till you run out of money!" & vbNewLine & vbNewLine
x = x & " E-Biz By Krishna Rath, [e-mail], http://rath.8k.com"
MsgBox x, vbOKOnly, "About E-Biz"


End Sub

Sub CGI_Main()
On Error GoTo errhan

If CGI_RequestMethod = "POST" Then 'If POST then
    'Check for the value of "formname" of the web page
    'formname is a hidden field in the web page to identify
    'which part is been called
    
    Select Case GetSmallField("formname")
    
        'Check if it is the user name and Password
        Case "login"
            'get the user name  and password
            UserName = GetSmallField("T1")
            UserPassword = GetSmallField("T2")
            'Check if the user exits. If not display the register form
            CheckUserName UserName, UserPassword
            'after checking the login succes
                If LoginSuccess = True Then ShowShop  'show the shopping centre
        
        Case "showpass"    'if the user has forgotten his password and asks for it
            'get the username and email address
            UserName = GetSmallField("T1")
            UserEmail = GetSmallField("T2")
            ShowPassword UserName, UserEmail
            
        Case "register"   'If the user wants to register for the first time
            UserName = GetSmallField("T1")
            UserPassword = GetSmallField("T2")
            UserEmail = GetSmallField("T3")
            RegisterUser UserName, UserPassword, UserEmail
    
    
    'Case for books
    'the books and CDs section work on the same principle..so I have not decorated
    'the CD section Web-page the way I did for the books.
        Case "book"
            'No need for username here as it has already been entered and loginsucces is true
            'We have to get the CheckBoxes that were ticked. I have given 2 prices
            'US$ and Indian Rs. This is because most e-shoping sites have options
            'of paying in diffrent currcency. I am in India, and an Indian
            'will give the money in Indian Rs, while for someone else in another country  will have
            ' to pay in US$.
            '
            'We put the book section in a separate sub as it would mess up this loop!
            BookSection 'Goto the book section
                    
    'case for the CDs
        Case "cd"
            CDsection
        
    'case for the Movie Theatres
        Case "mb"
        'Book the tickets
        BookTicket
        
        
        'if there was an error in the formname or it is not available
        'display an error
        Case Else
            MsgBox "There was an error in the server"
                
    End Select 'end the getsmallfield("formname")
    
End If  'Ends the POST session

errhan:
'simply exit the sub if any error occurs.. Mostly it occurs if a POST is done
'without giving a key called formname.

End Sub
Public Sub CheckUserName(ByVal uname As String, ByVal UPassword As String)
'checks whether the username and password exists or not

Dim dbPath, SQL_str As String 'the database path
dbPath = App.Path & "\ebiz.mdb"     'set the database path
'Opening the database and checking for username and password
Set db = OpenDatabase(dbPath, dbOpenDynaset)
SQL_str = "SELECT user FROM UID WHERE user='" & UserName & "' AND pass='" & UserPassword & "';"
Set rs = db.OpenRecordset(SQL_str)

If rs.RecordCount = 0 Then
    ErrorLogin    'there was an error while login in.
Else
    LoginSuccess = True
End If

Set db = Nothing
Set rs = Nothing

End Sub

Public Sub ErrorLogin()
' The error while logining  can be
'1. The password was incorrect
'2. The user name does not exits
'In this program we ask the email of the user. Show the user the 2 options he
' wants. Ie. Login in again with correct password or as a new user
'Showing the Options HTML file...

' the HTML page is a bit complex due to the tables!

LoginSuccess = False 'Login Succes was a failure

Send "<html> <head> <title>ERROR IN LOGIN</title> </head>"
Send "<body> <table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">"
Send "<tr><td width=""100%"" bgcolor=""#800000"" valign=""top""><font color=""#80FFFF"">Rath-India website."
Send "http://rath.8k.com</font></td></tr><tr>"
Send "<td width=""100%"" bgcolor=""#008000"" valign=""top"" align=""center""><h1><font color=""#FFFF00"">E-Biz"
Send "</font></h1> </td></tr>  <tr>"
Send "<td width=""100%"" bgcolor=""#800000"" valign=""top""><font color=""#FFFF00""><p align=""right"">The"
Send "Ultimate shoping centre in the world</font></td></tr><tr>"
Send "<td width=""100%"" valign=""top""><h3 align=""left""><font color=""#FF0000"">Sorry! There was an"
Send "Error while login</font></h3><table border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%"">"
Send "<tr><td width=""100%"">Please try your password again by<a href=http://" & CGI_RemoteAddr & "/ebiz.htm" & "> login in again</a></td>"
Send "</tr><tr><td width=""100%""><br>If you have forgotten you Password type in your username and your email address<table"
Send "border=""0"" cellpadding=""0"" cellspacing=""0"" width=""100%""><tr><td width=""25%""><font color=""#FF0000""><strong>User Name</strong></font></td>"
Send "<td width=""75%""><font color=""#FF0000""><strong>Email Address</strong></font></td>"
Send "</tr></table><form method=""POST"" action=""/cgi-win/cgiebiz/ebiz.exe""><p><input type=""hidden"" name=""formname"" value=""showpass""> <input type=""text"" name=""T1"" size=""20""><input type=""text"" name=""T2"" size=""20""><input"
Send "type=""submit"" value=""Show Me My Password"" name=""B1""></p></form></td></tr><tr><td width=""100%""><strong><font color=""#004080""></font></strong></td>"
Send "</tr><tr><td width=""100%""><strong><font color=""#004080""><a href=http://" & CGI_RemoteAddr & "/ebiz/register.htm" & ">Unregistered users can sign up here</a></font></strong></td></tr></table>"
Send "<p><font color=""#400080""><em>NOTE: The whole excercise is just a 'DEMO&quot; program showing WinCGI using Visual Basic. All the items shown are fictious and any resemblance to anyone living is just a 'coincidence'. </em></font></td>"
Send "</tr></table></body></html>"


End Sub
Public Sub ShowPassword(uname, uemail)

Dim dbPath, SQL_str As String 'the database path
dbPath = App.Path & "\ebiz.mdb"     'set the database path
'Opening the database and checking for username and email
Set db = OpenDatabase(dbPath, dbOpenDynaset)
SQL_str = "SELECT pass FROM UID WHERE user='" & UserName & "' AND email='" & UserEmail & "';"
Set rs = db.OpenRecordset(SQL_str)

If rs.RecordCount = 0 Then
ErrorLogin    'there was an error while login in.
Else
'display the password
Send ("<html>")

Send ("<head>")
Send ("<meta http-equiv=""Content-Type""")
Send ("content=""text/html"">")
Send ("<title>Your Password</title>")
Send ("</head>")
Send ("<body bgcolor=""#FFFFF0"">")
Send ("<h1 align=""center"">Your Password</h1>")
Send ("<p>The password is : <strong>" & rs.Fields(0) & "</strong></p>")
Send ("<p>Login <a href=http://" & CGI_RemoteAddr & "/ebiz.htm" & ">here</a></p>")
Send ("</body></html>")
End If

Set db = Nothing
Set rs = Nothing