<%option explicit%>
<%
'*******************************************************
' Version 4.50 Supplier Registration
' Sept 2, fix login and password
'*******************************************************
const CountryRequired="No"
Dim strPassword1
Dim strPassword2
dim struserid, strsuppliername
Dim msg, newcust
Dim i
Dim sAction,login
dim rs
Dim newuser
newuser=request("New")
if Newuser<>"" then
Setsess("supplierid"),""
end if
' the database can be used. If you don't display form
Dim dbc
' **********************************************************************
' Set defaults here
'**********************************************************************
SetSess "CurrentURL","shopsupplierregister.asp"
SetSess "FollowonURL","shopdisplaycategories.asp"
'
EditOpenDatabase dbc, database, "suppliers"
sAction=Request.form("Action") ' find out if we are being called via submit
if saction="" then
sAction=Request.form("Action.x") ' find out if we are being called via submit
end if
login=request("Login")
if login="" then
login=request("Login.x")
end if
if login<>"" then
serror=""
struserid=request("struserid")
strpassword1=request("strpassword")
ValidateLoginvalues
If serror="" then
LocateSupplier struserid,strpassword1
if strsupplierid="" then
serror=LangLoginLocateFail & " "
end if
end if
end if
If sAction = "" Then ' no came from customer logic
DisplayEverything
Else
sError=""
ValidateData() ' need to validate anything, nothing is required
if sError = "" Then
UpdateSupplier
else
DisplayEverything
end if
end if
shopclosedatabase dbc
'
Sub DisplayEveryThing
ShopPageHeader ' Normal page header
Displayerrors ' any input errors
DisplayLoginForm() ' display customer
ShopPageTrailer ' Normal page trailer
end Sub
' adds to customer table, order table, oitems table
Sub UpdateOrderInformation
UpdateSupplier ' add customer to database
End Sub
Sub DisplayLoginForm()
AddLogin ' User login form
If getconfig("xRestrictedtoExisting")= "Yes" then exit sub
' Outside table
Response.Write("")
AddNewUser
End Sub
Sub ValidateData()
struserid=request.form("Struserid")
strsupplierid=request.form("strSupplierid")
strsuppliername=request.form("strSuppliername")
strFirstname = Request.Form("strFirstname")
strLastname = Request.Form("strLastname")
strAddress = Request.Form("strAddress")
strCity = Request.Form("strCity")
strState = Request.Form("strState")
strPostCode = Request.Form("strPostCode")
strCountry = Request.Form("strCountry")
strCompany = Request.Form("strCompany")
strWebsite = Request.Form("strWebsite")
strPhone = Request.Form("strPhone")
strWorkphone = Request.Form("strWorkphone")
strMobilephone = Request.Form("strMobilephone")
strFax = Request.Form("strFax")
strEmail = Request.Form("strEmail")
strPassword1 = Request.Form("strPassword1")
strPassword2 = Request.Form("strPassword2")
If strSuppliername = "" Then
sError = sError & LangSuppliername & LangCustRequired & " "
End If
If struserid = "" Then
sError = sError & LangAdminUsername & LangCustRequired & " "
End If
ValidateCustomerFields
ValidatePassword
dim rc
If Serror="" then
Checkforduplicateuid rc
if rc>0 then
sError = sError & LangCustomerExists & " "
end if
end if
end sub
Sub AddLogin
Response.Write(""
end sub
'
Sub ValidatePassword
Dim rc
If strPassword1 = "" Then
sError = sError & LangPassword & "1" & LangCustRequired & " "
exit sub
End If
If strPassword2 = "" Then
sError = sError & LangPassword & "2" & LangCustRequired & " "
exit sub
End If
If StrPassword1<>strPassword2 then
SError= SError & LangPasswordMismatch & " "
exit sub
end if
if len(strPassword1) >= 6 then
CheckForDuplicate rc
if rc > 0 then
SError= SError & LangPasswordDuplicate & " "
end if
else
Serror=Serror & LangPasswordLength & " "
end if
End sub
Sub DisplayErrors
if sError<> "" then
response.write "" & getconfig("Xfont") & SError & ""
Serror=""
end if
end Sub
'
Sub AddSubmitButton
If Getconfig("xbuttoncontinue")="" Then
Response.Write("")
else
Response.Write("")
end if
end sub
'
Sub CheckForDuplicate (rc)
Dim testsql
If GetSess("Supplierid")<>"" then
rc=0
exit sub
end if
SetSess "Login","Force"
sql = "select * from suppliers where supplieruserid='" & struserid & "' and supplierpassword ='" & strpassword1 & "'"
sql = sql & " and email='" & stremail & "'"
setsess "login",""
'debugwrite sql
Set rs = dbc.Execute(SQL)
If Not rs.EOF Then
rc=4
else
rc=0
end if
rs.close
set rs=nothing
end sub
'
Sub CheckForDuplicateuid (rc)
Dim testsql
If GetSess("Supplierid")<>"" then
rc=0
exit sub
end if
SetSess "Login","Force"
sql = "select * from suppliers where supplieruserid='" & struserid & "'"
setsess "login",""
'debugwrite sql
Set rs = dbc.Execute(SQL)
If Not rs.EOF Then
rc=4
else
rc=0
end if
rs.close
set rs=nothing
end sub
'
Sub addInformationTable
response.write "
"
end Sub
Sub AddUserName
Response.Write(TableDef)
CreateCustRow LangAdminUsername, "struserid", strUserid,"Yes"
CreateCustRow LangSuppliername, "strsuppliername", strSuppliername,"Yes"
CreateCustRowP langPassword, "StrPassword1", strPassword1,"Yes"
CreateCustRowP langPassword, "StrPassword2", strPassword2,"Yes"
Response.Write("
")
end sub
'
Sub ShopSupplierForm
'*******************************************************************
' Supplier form used in many places
' CreateCustRow is in shop$colors.asp
' Version 3.0
'********************************************************************
Shopcustomerform
If strsupplierid<>"" then
Response.write ""
End if
end sub
'
Sub LocateSupplier (LastName, passwordvalue)
Dim rs
dim templastname
dim whereok
if lastname<>"" then
templastname=replace(lastname,"'","''")
end if
' See if customer stored separately
SQL = "SELECT * FROM suppliers WHERE "
whereok=""
If lastname<>"" then
sql=sql & whereok & " supplieruserid='" & TempLastName & "'"
whereok = " AND "
end if
If passwordvalue<>"" then
SQL = SQL & " AND " & " supplierpassword='" & passwordvalue & "'"
end if
'debugwrite sql
Set rs = dbc.Execute(SQL)
If Not rs.EOF Then
strsupplierid=rs("supplierid")
strsuppliername=rs("name")
setsess "supplierid",strsupplierid
struserid=rs("supplieruserid")
strfirstname = rs("firstname")
strlastname = rs("lastname")
straddress = rs("address")
strcity = rs("city")
strstate = rs("state")
strpostcode = rs("postcode")
strphone = rs("phone")
stremail = rs("email")
strfax = rs("fax")
if isnull(strfax) then strfax=""
strwebsite=rs("website")
if isnull(strwebsite) then strwebsite=""
strmobilephone=rs("mobilephone")
if isnull(strmobilephone) then strmobilephone=""
strworkphone=rs("workphone")
if isnull(strworkphone) then strworkphone=""
strcountry = rs("country")
if isnull(strcountry) then strcountry=""
strcompany = rs("company")
if isnull(strcompany) then strcompany=""
lnglogincount=rs("logincount")
strpassword1=rs("supplierpassword")
strpassword2=rs("supplierpassword")
else
strsupplierid=""
struserid=""
strpassword1=""
end if
rs.close
set rs=nothing
end sub
Sub UpdateSupplier
if getconfig("xMYSQL")="Yes" then
MYSQLUpdateSupplier
exit sub
end if
Dim DoUpdate
DoUpdate=""
'on error resume next
If getsess("supplierid")<>"" then
strsupplierid=Getsess("Supplierid")
Set objRS = Server.CreateObject("ADODB.Recordset")
SQL="Select * from suppliers Where supplierid=" & strsupplierid
objRS.open SQL, dbc, adOpenKeyset, adLockOptimistic, adcmdText
if not ObjRS.eof then
DoUpdate="True"
objRS.update
else
objRs.close
set objRS=nothing
end if
end if
If Doupdate="" then
Set objRS = Server.CreateObject("ADODB.Recordset")
objrs.open "suppliers", dbc, adopenkeyset, adlockoptimistic, adcmdtable
objRS.AddNew
end if
objrs("supplieruserid")=struserid
objrs("name") = strsuppliername
updatesupplierfield "firstname",strfirstname
updatesupplierfield "lastname",strlastname
updatesupplierfield "address",straddress
updatesupplierfield "city",strcity
updatesupplierfield "state",strstate
updatesupplierfield "postcode",strpostcode
updatesupplierfield "country",strcountry
updatesupplierfield "company",strcompany
updatesupplierfield "phone",strphone
updatesupplierfield "workphone",strworkphone
updatesupplierfield "mobilephone",strmobilephone
updatesupplierfield "fax",strfax
updatesupplierfield "email",stremail
updatesupplierfield "website",strwebsite
updatesupplierfield "supplierpassword",strpassword1
objrs.update
strsupplierid=cstr(objrs("supplierid")) 'version 2.4
setsess "supplierid",strsupplierid
objrs.close ' version 2.4
set objrs=nothing
writeinfomessage
end sub
Sub UpdateSupplierField (fieldname,fieldvalue)
on error resume next
if fieldvalue="" then
exit sub
end if
If getconfig("xdebug")="Yes" then
Debugwrite fieldname & " " & fieldvalue & " "
end if
objRS(fieldname)=fieldvalue
end Sub
'
Sub WriteInfoMessage
ShopPageHeader
Response.write getconfig("xfont") & LangEdit03 & " " & LangsupplierNumber & " " & strsupplierid & ""
shoppagetrailer
end sub
Sub addnewUser
response.write ("
")
end sub
Sub ValidateLoginValues
if struserid="" then
sError = sError & LangLoginEmail & langcustrequired & " "
end if
if strpassword1="" then
sError = sError & LangLoginPassword & langcustrequired & " "
end if
end sub
%>