<%@ LANGUAGE="VBSCRIPT" %> <% Option Explicit Server.ScriptTimeout = 3600 Response.Buffer = True %> <% ' Initialize my stuff Dim myLoop1 Dim strTemp Dim strTemp2 Dim CrLf Dim strParameters Dim strDatabaseDSN Dim strScriptURL Dim strScriptBaseURL Dim strScriptBasePath Dim strScriptLogPath Dim strHeadersBasePath Dim strFootersBasePath Dim strUploadPath Dim strImagePath Dim strImageRelativePath Dim strLoginUsername Dim strLoginPassword Dim lngCookieKey Dim lngAccessLevel Dim Upload Dim flagUpload Dim strCommand Dim strCriteria Dim fltRetailPercentage Dim fltWholesalePercentage Dim lngCategoryColumnWidth Dim lngManufacturerColumnWidth Dim lngProductColumnWidth Dim cellcount Dim rstImport Dim rstProductsForImport Dim strAdminUsername Dim strAdminPassword Dim intLoginFailureThreshold Dim intLoginMinutes Dim flagTemp ' * Initialize variables intLoginFailureThreshold = 5 intLoginMinutes = 60 lngCategoryColumnWidth = 250 lngManufacturerColumnWidth = 250 lngProductColumnWidth = 0 cellcount = 3 CrLf = chr(13) & chr(10) fltRetailPercentage = 1.00 fltWholesalePercentage = 0.20 strDatabaseDSN = "DRIVER={SQL Server};SERVER=BITSBROTHER.PLAYBOARD.COM;UID=pageplusonline;PWD=diesel;DATABASE=PagePlusOnline;" strScriptURL = "ProductPage.asp" strScriptBaseURL = "/scripts/" strScriptBasePath = "C:\HostedWebSites\instant-mobile\scripts\" strScriptLogPath = "C:\HostedWebSites\instant-mobile\LogFiles\" strHeadersBasePath = "C:\HostedWebSites\instant-mobile\SiteHeader.html" strFootersBasePath = "C:\HostedWebSites\instant-mobile\SiteFooter.html" strUploadPath = "C:\temp" strImagePath = "C:\HostedWebSites\instant-mobile\ProductImages\" strImageRelativePath = "../ProductImages/" strAdminUsername = "pageplus11" strAdminPassword = "diesel2244" 'Temporary ASP fix strLoginUsername = "" strLoginPassword = "" lngAccessLevel = 0 lngCookieKey = 0 ' Deal with pricing if Session("wholesaleprice") <> "Y" then if Session("retailprice") <> "N" then Session("retailprice") = "Y" end if end if if Request.ServerVariables("REQUEST_METHOD") = "POST" then ' * Get anything posted with form Set Upload = Server.CreateObject("Persits.Upload.1") Upload.OverwriteFiles = False ' Generate unique names Upload.SetMaxSize 1048576,true ' Truncate files above 1MB Upload.Save strUploadPath flagUpload = 1 strCommand = Upload.Form("command") if len(Upload.Form("criteria")) > 0 then strCriteria = Upload.Form("criteria") Session("criteria") = strCriteria else if len(Upload.Form("ProductProtocol")) > 0 then MakeSearchCriteria else strCriteria = Session("criteria") end if end if if len(Upload.Form("CookieKey")) > 0 then strLoginUsername = Upload.Form("LoginUsername") CheckSecurity strLoginUsername, Upload.Form("CookieKey"),1,2 end if else flagUpload = 0 strCommand = request("command") if len(request("criteria")) > 0 then strCriteria = request("criteria") Session("criteria") = strCriteria else if len(request("ProductProtocol")) > 0 then MakeSearchCriteria else strCriteria = Session("criteria") end if end if if len(request("CookieKey")) > 0 then strLoginUsername = request("LoginUsername") CheckSecurity strLoginUsername, request("CookieKey"),1,2 end if end if sub AddSpellCheckFunction() ' Spell checker function '************************************** ' Name: Spell Checker ' Description:Use Microsoft word spell checker utility ' By: Anil Paranganat ' ' ' Inputs:None ' ' Returns:None ' 'Assumes:Client machine has word 2000 'Browser is I.E. 'Activex scripting is enabled ' 'Side Effects:none 'This code is copyrighted and has limited warranties. 'Please see http://www.Planet-Source-Code.com/xq/ASP/txtCodeId.6561/lngWId.4/qx/vb/scripts/ShowCode.htm 'for details. '************************************** Response.Write "" & CrLf end sub ' intAction 1 Add a login attempt ' 2 Delete all login attempts Function LoginAttempt(ByVal intAction) Dim rst Dim strQuery Dim OBJdbConn Dim intAttempt ' Create and open connection object set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open(strDatabaseDSN) If intAction = 1 Then ' Check our login attempts strQuery = "SELECT Failures,LastAttemptDateTime FROM tblLoginAttempt WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'" set rst = OBJdbConn.Execute(strQuery) If rst.EOF Then ' First attempt intAttempt = 1 Else If DateDiff("n", rst("LastAttemptDateTime").value, Now()) > intLoginMinutes Then intAttempt = 0 Else intAttempt = rst("Failures").value + 1 End If End If ' Close rst.close() set rst = Nothing ' If our time expired, then reset login attempts If intAttempt = 0 Then ' Delete all login attempts strQuery = "DELETE FROM tblLoginAttempt WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'" set rst = OBJdbConn.Execute(strQuery) intAttempt = 1 End If If intAttempt = 1 Then ' Add a login attempt strQuery = "INSERT INTO tblLoginAttempt (IPAddress,Failures,LastAttemptDateTime) VALUES ('" & Request.ServerVariables("REMOTE_ADDR") & "',1,'" & Now() & "')" set rst = OBJdbConn.Execute(strQuery) Else ' Update login attempt strQuery = "UPDATE tblLoginAttempt SET Failures = " & intAttempt & ", LastAttemptDateTime = '" & Now() & "' WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'" set rst = OBJdbConn.Execute(strQuery) End If Else ' Delete all login attempts strQuery = "DELETE FROM tblLoginAttempt WHERE IPAddress = '" & Request.ServerVariables("REMOTE_ADDR") & "'" set rst = OBJdbConn.Execute(strQuery) intAttempt = 0 End If ' Return LoginAttempt = intAttempt End Function Function VerifyWholesalerUsernamePassword(ByVal username, ByVal password, ByVal showflag) Dim strQuery Dim rst Dim returnflag Dim OBJdbConn ' Create and open connection object set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open(strDatabaseDSN) ' Add a login attempt If LoginAttempt(1) > intLoginFailureThreshold Then Response.Write("

Your login has been blocked for a security violation!

" & CrLf) Response.End() End If ' Open recordset strQuery = "SELECT WholesalerID, CompanyName, ContactName, Address1, Address2, City, State, Zip, Telephone, Fax, EmailAddress, Username, Password, PercentageAdjust, AffiliateEnabled, AffiliateID, AffiliatePercentage FROM Wholesalers WHERE ((ApprovedDate > '5/22/1971') AND (Username = '" & username & "') AND (Password = '" & password & "'));" set rst = OBJdbConn.Execute(strQuery) If rst.EOF Then returnflag = -1 If showflag = 1 Then Response.Write("

That username/password does not match any approved wholesaler in the database.

") End If Else rst.MoveFirst() If showflag = 1 Then Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("
Wholesaler ID" & rst.Fields("WholesalerID").value & "
Company Name" & rst.Fields("CompanyName").value & "
Contact Name" & rst.Fields("ContactName").value & "
Address 1" & rst.Fields("Address1").value & "
Address 2" & rst.Fields("Address2").value & "
City" & rst.Fields("City").value & "
State" & rst.Fields("State").value & "
Zip" & rst.Fields("Zip").value & "
Telephone" & rst.Fields("Telephone").value & "
Fax" & rst.Fields("Fax").value & "
Email Address" & rst.Fields("EmailAddress").value & "
Percentage Adjust" & rst.Fields("PercentageAdjust").value & "
AffiliateEnabled" & rst.Fields("AffiliateEnabled").value & "
AffiliateID" & rst.Fields("AffiliateID").value & "
Affiliate Percentage" & rst.Fields("AffiliatePercentage").value & "
" & CrLf) End If Session("wholesaleprice") = "Y" Session("WholesalerID") = rst.Fields("WholesalerID").value Session("WholesalerUsername") = rst.Fields("Username").value Session("WholesalerPassword") = rst.Fields("Password").value Session("WholesalerCompanyName") = rst.Fields("CompanyName").value Session("WholesalerPercentageAdjust") = rst.Fields("PercentageAdjust").value Session("WholesalerAffiliateEnabled") = rst.Fields("AffiliateEnabled").value Session("WholesalerAffiliatePercentage") = rst.Fields("AffiliatePercentage").value returnflag = 0 ' Successful login, reset login attempts LoginAttempt(2) End If ' Close recordset and cleanup rst.close() Session("returnflag") = returnflag VerifyWholesalerUsernamePassword = returnflag end function '* ReportError function ReportError(strError,lngFlag,strReferrer) Dim Mail Set Mail = Server.CreateObject("Persits.MailSender") Mail.From = "WebserverEmail@playboard.com" Mail.FromName = "WebserverEmail" Mail.AddAddress "wpryder@playboard.com" Mail.Subject = "Script Error (ProductManagementSystem.asp)" Mail.Body = strError Mail.Queue = True On Error Resume Next Mail.Send If Err.Number <> 0 then Response.Write "Unable to send error report email...Please contact website administrator (Err.Number = " & Err.Number & ")" end if on error goto 0 Set Mail = nothing end function '* PrintPageHeader Function PrintPageHeader Dim strFilename Dim fso Dim f Dim tf dim boolFlag ' Get our page header filename strFilename = strHeadersBasePath ' Open the header page file set fso = CreateObject("Scripting.FileSystemObject") ' If the header file isn't there, report error on error resume next if not fso.FileExists(strFilename) then ReportError "Header File Not Found (" & strFilename & ").",1,Request.ServerVariables("HTTP_REFERRER") on error goto 0 else on error goto 0 ' Display the header set f = fso.GetFile(strFilename) set tf = f.OpenAsTextStream(1) do while not tf.AtEndOfStream Response.Write tf.ReadLine & chr(13) & chr(10) loop ' Clean up and close files tf.Close set tf = nothing set f = nothing set fso = nothing end if end function '* PrintPageFooter Function PrintPageFooter Dim strFilename Dim fso Dim f Dim tf ' Get our page footer filename strFilename = strFootersBasePath ' Open the header page file set fso = CreateObject("Scripting.FileSystemObject") ' If the header file isn't there, report error on error resume next if not fso.FileExists(strFilename) then on error goto 0 ReportError "Footer File Not Found (" & strFilename & ").",1,Request.ServerVariables("HTTP_REFERRER") else on error goto 0 ' Display the header set f = fso.GetFile(strFilename) set tf = f.OpenAsTextStream(1) do while not tf.AtEndOfStream Response.Write tf.ReadLine & chr(13) & chr(10) loop ' Clean up and close files tf.Close set tf = nothing set f = nothing set fso = nothing end if end function function RemoveQuotes(strFixString) Dim strTemp Dim loop1 loop1 = 1 strTemp = "" while (loop1 <= len(strFixString)) if mid(strFixString,loop1,1) = chr(34) then strTemp = strTemp & """ else if mid(strFixString,loop1,1) = "'" then strTemp = strTemp & "&lsquo" else strTemp = strTemp & mid(strFixString,loop1,1) end if end if loop1 = loop1 + 1 wend RemoveQuotes = strTemp end function function FixQuotes(strFixString) Dim strTemp Dim loop1 loop1 = 1 strTemp = "" while (loop1 <= len(strFixString)) if mid(strFixString,loop1,1) = "'" then strTemp = strTemp & "''" else strTemp = strTemp & mid(strFixString,loop1,1) end if loop1 = loop1 + 1 wend FixQuotes = strTemp end function function FormatPrice(fltPrice) Dim strTemp Dim intTemp strTemp = cstr(round(fltPrice,2)) intTemp = instr(strTemp,".") if intTemp = 0 then strTemp = "$" & strTemp & ".00" else if (len(strTemp) - intTemp) = 2 then strTemp = "$" & strTemp else if (len(strTemp) - intTemp) = 1 then strTemp = "$" & strTemp & "0" else strTemp = "$" & strTemp & ".00" end if end if end if FormatPrice = strTemp end function function MakeLogEntry(strLogEntry) Dim fso Dim f Dim fname Dim strTemp ' Get log filename fname = strScriptLogPath & year(now()) if month(now()) < 10 then fname = fname & "0" fname = fname & month(now()) if day(now()) < 10 then fname = fname & "0" fname = fname & day(now()) & ".txt" ' Append the log file for today set fso = CreateObject("Scripting.FileSystemObject") set f = fso.OpenTextFile(fname,8,true) 'ForAppending = 8 strTemp = formatDateTime(now(),0) & "(" & strLoginUsername & "):" & strLogEntry f.Write strTemp & CrLf Session("LogString") = strTemp & CrLf & Session("LogString") Session("LogStringLast") = strTemp f.Close ' Close and clean up set f = nothing set fso = nothing end function Function CheckSecurity(strUsername, strPassword, intAccessLevel,flagDisplay) Dim returnflag Dim sConnectionString, SQLQuery, OutputString Dim OBJdbConn Dim RsUsers ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Setup our query and open recordset of tblEmailListMembers SQLQuery = "SELECT * FROM tblUsers WHERE UserName = '" & strUsername & "'" Set RsUsers = OBJdbConn.Execute(SQLQuery) ' if no records found, let them know if RsUsers.eof then OutputString = "Your username (" & strUsername & ") does not exist. Access denied." strLoginUsername = "" strLoginPassword = "" lngAccessLevel = 0 returnflag = -1 else if flagDisplay = 2 then if RsUsers("CookieKey") <> CLng(strPassword) then OutputString = "Your cookie is invalid (" & CLng(strPassword) & "). Access denied." strLoginUsername = "" strLoginPassword = "" lngAccessLevel = 0 returnflag = -1 else if RsUsers("CookieIP") <> Request.ServerVariables("REMOTE_ADDR") then OutputString = "Your cookie is invalid (" & Request.ServerVariables("REMOTE_ADDR") & ". Access denied." strLoginUsername = "" strLoginPassword = "" lngAccessLevel = 0 returnflag = -1 else ' IP and cookie key matched, log them in ' Get the stuff we need OutputString = "User (" & strUsername & ") logged in with access level " & RsUsers("UserAccessLevel") & "." strLoginUsername = RsUsers("UserName") strLoginPassword = RsUsers("UserPassword") lngAccessLevel = RsUsers("UserAccessLevel") returnflag = 0 end if end if else if strPassword <> RsUsers("UserPassword") then OutputString = "Your password is not correct for username (" & strUsername & "). Access denied." strLoginUsername = "" strLoginPassword = "" lngAccessLevel = 0 returnflag = -1 else if intAccessLevel > RsUsers("UserAccessLevel") then OutputString = "Your access level (" & RsUsers("AccessLevel") & ") is not high enough to access this function." strLoginUsername = "" strLoginPassword = "" lngAccessLevel = 0 returnflag = -1 else ' Get the stuff we need OutputString = "User (" & strUsername & ") logged in with access level " & RsUsers("UserAccessLevel") & "." strLoginUsername = RsUsers("UserName") strLoginPassword = RsUsers("UserPassword") lngAccessLevel = RsUsers("UserAccessLevel") returnflag = 0 end if end if end if end if ' Update cookie with info if returnflag = 0 then Randomize Now lngCookieKey = int((rnd * 999999)) RsUsers.close SQLQuery = "UPDATE tblUsers SET CookieKey = " & lngCookieKey & " , CookieIP = '" & Request.ServerVariables("REMOTE_ADDR") & "' WHERE UserName = '" & strUsername & "'" Set RsUsers = OBJdbConn.Execute(SQLQuery) else RsUsers.close end if ' Close the recordset and connection to the database OBJdbConn.close set RsUsers = nothing set OBJdbConn = nothing if returnflag <> 0 then if ((flagDisplay = 0) or (flagDisplay = 2)) then Session("errormessage") = OutputString else Response.Write "

" & OutputString & "

" end if end if if flagDisplay <> 0 then MakeLogEntry(OutputString) end if Session("returnflag") = returnflag end function ' flagDisplay 0 strInput match returned ' 1 strInput match for viewing ' 2 strInput match in select for form ' 11 Return productID ' 12 Return ProductQuantity ' 51 Return WholesalePrice1to50 ' 52 Return WholesalePrice51to100 ' 53 Return WholesalePrice100plus ' 54 Return RetailPrice function GetProductID(strInput,flagDisplay) Dim rstProducts Dim strQuery Dim lngProductID Dim lngTemp Dim OBJdbConn Dim flagLoop Dim strReturnValue ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize values flagLoop = 0 lngProductID = 0 ' Instantiate a Recordset object and open a recordset using the Open method if flagDisplay = 0 then strQuery = "SELECT ProductID FROM Products ORDER BY ProductID DESC;" else if len(strInput) > 0 then if flagDisplay > 10 then strQuery = "SELECT * FROM Products WHERE ProductID = " & strInput else strQuery = "SELECT * FROM Products WHERE ProductName = '" & strInput & "'" end if else strQuery = "SELECT * FROM Products" end if end if Set rstProducts = OBJdbConn.Execute(strQuery) if rstProducts.eof then if flagDisplay = 1 then Response.Write "No products in database." end if else if flagDisplay = 2 then Response.Write "" & CrLf else if flagDisplay = 1 then Response.Write "

" & CrLf end if end if end if ' Close and clean up rstProducts.close set rstProducts = nothing OBJdbConn.close set OBJdbConn = nothing ' Return what we found GetProductID = strReturnValue end function ' flagDisplay 0 strInput match returned ' 1 strInput match for viewing ' 2 strInput match in select for form ' 3 strInput match for viewing on side column function GetManufacturerID(strInput,flagDisplay) Dim rstManufacturers Dim strQuery Dim strTemp Dim intLoop Dim lngManufacturerID Dim lngTemp Dim OBJdbConn Dim lngPreselectedManufacturerID ' Determine preselected if Instr(strCriteria,"ProductManufacturerID=") = 0 then lngPreselectedManufacturerID = 0 else intLoop = instr(strCriteria,"ProductManufacturerID=")+22 strTemp = "" while ((intLoop <= len(strCriteria)) and ((mid(strCriteria,intLoop,1) >= "0") and (mid(strCriteria,intLoop,1) <= "9"))) strTemp = strTemp & mid(strCriteria,intLoop,1) intLoop = intLoop + 1 wend if len(strTemp) < 1 then lngPreselectedManufacturerID = 0 else lngPreselectedManufacturerID = CLng(strTemp) end if end if ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize values lngManufacturerID = 0 ' Instantiate a Recordset object and open a recordset using the Open method if len(strInput) > 0 then strQuery = "SELECT * FROM [Product Manufacturers] WHERE ProductManufacturerName = '" & strInput & "'" else strQuery = "SELECT * FROM [Product Manufacturers]" end if Set rstManufacturers = OBJdbConn.Execute(strQuery) if rstManufacturers.eof then if flagDisplay = 1 then Response.Write "No product manufacturers in database." end if else if flagDisplay = 2 then Response.Write "" & CrLf else if flagDisplay = 1 then Response.Write "

" & CrLf else if flagDisplay = 3 then Response.Write "" & CrLf end if end if end if end if ' Close and clean up rstManufacturers.close set rstManufacturers = nothing OBJdbConn.close set OBJdbConn = nothing ' Return what we found GetManufacturerID = lngManufacturerID end function ' flagDisplay 0 strInput match returned ' 1 strInput match for viewing ' 2 strInput match in select for form ' 3 strInput match for viewing on side column function GetCarrierID(strInput,flagDisplay) Dim rstCarriers Dim strQuery Dim strTemp Dim intLoop Dim lngCarrierID Dim lngTemp Dim OBJdbConn Dim lngPreselectedCarrierID ' Determine preselected if Instr(strCriteria,"CarrierID=") = 0 then lngPreselectedCarrierID = 6 else intLoop = instr(strCriteria,"CarrierID=")+10 strTemp = "" while ((intLoop <= len(strCriteria)) and ((mid(strCriteria,intLoop,1) >= "0") and (mid(strCriteria,intLoop,1) <= "9"))) strTemp = strTemp & mid(strCriteria,intLoop,1) intLoop = intLoop + 1 wend if len(strTemp) < 1 then lngPreselectedCarrierID = 1 else lngPreselectedCarrierID = CLng(strTemp) end if end if ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize values lngCarrierID = 0 ' Instantiate a Recordset object and open a recordset using the Open method if len(strInput) > 0 then strQuery = "SELECT * FROM [tblProductCarriers] WHERE ProductCarrierName = '" & strInput & "'" else strQuery = "SELECT * FROM [tblProductCarriers]" end if Set rstCarriers = OBJdbConn.Execute(strQuery) if rstCarriers.eof then if flagDisplay = 1 then Response.Write "No product Carriers in database." end if else if flagDisplay = 2 then Response.Write "" & CrLf else if flagDisplay = 1 then Response.Write "

" & CrLf else if flagDisplay = 3 then Response.Write "" & CrLf end if end if end if end if ' Close and clean up rstCarriers.close set rstCarriers = nothing OBJdbConn.close set OBJdbConn = nothing ' Return what we found GetCarrierID = lngCarrierID end function ' flagDisplay 0 Show in for script access ' 3 Show in table format for left side column view ' 4 Same as option 0 but for search cellular box function ListProductCategories(flagDisplay) Dim rstProductCategories Dim strQuery Dim strTemp Dim lngPreselected Dim lngCount Dim lngTemp Dim intLoop Dim OBJdbConn ' Determine preselected if Instr(strCriteria,"ProductCategoryID=") = 0 then lngPreselected = 2 else intLoop = instr(strCriteria,"ProductCategoryID=")+18 strTemp = "" while ((intLoop <= len(strCriteria)) and ((mid(strCriteria,intLoop,1) >= "0") and (mid(strCriteria,intLoop,1) <= "9"))) strTemp = strTemp & mid(strCriteria,intLoop,1) intLoop = intLoop + 1 wend lngPreselected = CLng(strTemp) end if ' If doing search box, always select cellular phones if flagDisplay = 4 then lngPreselected = 2 end if ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Instantiate a Recordset object and open a recordset using the Open method strQuery = "SELECT * FROM [Product Categories]" Set rstProductCategories = OBJdbConn.Execute(strQuery) if rstProductCategories.eof then if flagDisplay = 1 then Response.Write "No product categories in database." end if else if ((flagDisplay = 0) or (flagDisplay = 4)) then Response.Write "" else if flagDisplay = 3 then Response.Write "" & CrLf end if end if end if end if lngTemp = 0 while not rstProductCategories.EOF lngTemp = lngTemp + 1 if ((flagDisplay = 0) or (flagDisplay = 4)) then if lngTemp = lngPreselected then Response.Write "" & CrLf else if flagDisplay = 1 then Response.Write rstProductCategories("ProductCategoryName") & "
" & CrLf else if flagDisplay = 2 then if lngTemp = lngPreselected then Response.Write "" & CrLf else if flagDisplay = 3 then if lngTemp = lngPreselected then Response.Write "" & CrLf else Response.Write "" & CrLf end if end if end if end if end if rstProductCategories.MoveNext wend if ((flagDisplay = 0) or (flagDisplay = 4)) then Response.Write "" & CrLf else if flagDisplay = 1 then Response.Write "

" & CrLf else if flagDisplay = 2 then Response.Write "" & CrLf else if flagDisplay = 3 then Response.Write "
Product Categories
" & rstProductCategories("ProductCategoryName") & "
" & rstProductCategories("ProductCategoryName") & "
" & CrLf end if end if end if end if end if ' Close and clean up rstProductCategories.close set rstProductCategories = nothing OBJdbConn.close set OBJdbConn = nothing end function function ConvertStarStarToYesNoValues(strInput) if IsNull(strInput) then ' Christine uses this to mean false or no ConvertStarStarToYesNoValues = 0 else if strInput = "**" then ' Christine uses this to mean true or yes ConvertStarStarToYesNoValues = 1 else ' Christine uses this to mean false or no ConvertStarStarToYesNoValues = 0 end if end if end function ' intType 0 long ' 1 float ' 2 date/time function ConvertExcelNumeric(strInput,intType) if IsNull(strInput) then ' Null has to be forced to 0 if intType = 2 then ' Make a null date today ConvertExcelNumeric = Now() else ConvertExcelNumeric = 0 end if else ' If its a long do it as a long conversion if intType = 0 then ConvertExcelNumeric = CLng(strInput) else ' If its a float or double, make it floating point double if intType = 1 then if IsNumeric(strInput) = False then Response.Write "Invalid numeric value (" & strInput & ") ... Forcing to 0.00
" & CrLf ConvertExcelNumeric = 0.00 else ConvertExcelNumeric = CDbl(strInput) end if else if IsDate(strInput) = False then Response.Write "Invalid date value (" & strInput & ") ... Forcing to " & Now() & "
" & CrLf ConvertExcelNumeric = Now() else ConvertExcelNumeric = CDate(strInput) end if end if end if end if end function function ConvertExcelString(strInput) if IsNull(strInput) then ' Null has to be forced to empty string ConvertExcelString = "" else ConvertExcelString = strInput end if end function ' intCheckType = 1 Update ' 2 Insert ' FieldType = 1 Numeric ' 2 String ' 3 Date ' 4 YesNo function CheckUploadFields(intCheckType) Dim intLoop Dim intLoopFields Dim intFieldCount Dim UploadFieldNames(100,3) Dim flagFoundField Dim lngFieldErrors lngFieldErrors = 0 if intCheckType = 1 then ' Update intFieldCount = 19 UploadFieldNames(1,1) = "QTY" UploadFieldNames(1,2) = 1 UploadFieldNames(1,3) = 1 UploadFieldNames(2,1) = "SELL FOR 1to50" UploadFieldNames(2,2) = 1 UploadFieldNames(2,3) = 1 UploadFieldNames(3,1) = "SELL FOR 51to100" UploadFieldNames(3,2) = 1 UploadFieldNames(3,3) = 1 UploadFieldNames(4,1) = "PROTOCOL" UploadFieldNames(4,2) = 2 UploadFieldNames(4,3) = 1 UploadFieldNames(5,1) = "SELL FOR 100plus" UploadFieldNames(5,2) = 1 UploadFieldNames(5,3) = 1 UploadFieldNames(6,1) = "AMP" UploadFieldNames(6,2) = 2 UploadFieldNames(6,3) = 1 UploadFieldNames(7,1) = "DATE" UploadFieldNames(7,2) = 3 UploadFieldNames(7,3) = 1 UploadFieldNames(8,1) = "COMPLETE" UploadFieldNames(8,2) = 4 UploadFieldNames(8,3) = 1 UploadFieldNames(9,1) = "BOX" UploadFieldNames(9,2) = 2 UploadFieldNames(9,3) = 1 UploadFieldNames(10,1) = "HAND SET" UploadFieldNames(10,2) = 2 UploadFieldNames(10,3) = 1 UploadFieldNames(11,1) = "BRAND NEW" UploadFieldNames(11,2) = 4 UploadFieldNames(11,3) = 1 UploadFieldNames(12,1) = "REFURB" UploadFieldNames(12,2) = 4 UploadFieldNames(12,3) = 1 UploadFieldNames(13,1) = "C/R" UploadFieldNames(13,2) = 4 UploadFieldNames(13,3) = 1 UploadFieldNames(14,1) = "USED" UploadFieldNames(14,2) = 4 UploadFieldNames(14,3) = 1 UploadFieldNames(15,1) = "AS IS" UploadFieldNames(15,2) = 4 UploadFieldNames(15,3) = 1 UploadFieldNames(16,1) = "LOCKED" UploadFieldNames(16,2) = 2 UploadFieldNames(16,3) = 1 UploadFieldNames(17,1) = "UNLOCKED" UploadFieldNames(17,2) = 4 UploadFieldNames(17,3) = 1 UploadFieldNames(18,1) = "DESCRIPTION" UploadFieldNames(18,2) = 2 UploadFieldNames(18,3) = 1 UploadFieldNames(19,1) = "BASEPRODUCTID" UploadFieldNames(19,2) = 1 UploadFieldNames(19,3) = 1 UploadFieldNames(20,1) = "MAKE" UploadFieldNames(20,2) = 2 UploadFieldNames(20,3) = 1 UploadFieldNames(21,1) = "MODEL" UploadFieldNames(21,2) = 2 UploadFieldNames(21,3) = 1 else if intCheckType = 2 then ' Insert intFieldCount = 19 UploadFieldNames(1,1) = "QTY" UploadFieldNames(1,2) = 1 UploadFieldNames(1,3) = 1 UploadFieldNames(2,1) = "SELL FOR 1to50" UploadFieldNames(2,2) = 1 UploadFieldNames(2,3) = 1 UploadFieldNames(3,1) = "SELL FOR 51to100" UploadFieldNames(3,2) = 1 UploadFieldNames(3,3) = 1 UploadFieldNames(4,1) = "PROTOCOL" UploadFieldNames(4,2) = 2 UploadFieldNames(4,3) = 1 UploadFieldNames(5,1) = "SELL FOR 100plus" UploadFieldNames(5,2) = 1 UploadFieldNames(5,3) = 1 UploadFieldNames(6,1) = "AMP" UploadFieldNames(6,2) = 2 UploadFieldNames(6,3) = 1 UploadFieldNames(7,1) = "DATE" UploadFieldNames(7,2) = 3 UploadFieldNames(7,3) = 1 UploadFieldNames(8,1) = "COMPLETE" UploadFieldNames(8,2) = 4 UploadFieldNames(8,3) = 1 UploadFieldNames(9,1) = "BOX" UploadFieldNames(9,2) = 2 UploadFieldNames(9,3) = 1 UploadFieldNames(10,1) = "HAND SET" UploadFieldNames(10,2) = 2 UploadFieldNames(10,3) = 1 UploadFieldNames(11,1) = "BRAND NEW" UploadFieldNames(11,2) = 4 UploadFieldNames(11,3) = 1 UploadFieldNames(12,1) = "REFURB" UploadFieldNames(12,2) = 4 UploadFieldNames(12,3) = 1 UploadFieldNames(13,1) = "C/R" UploadFieldNames(13,2) = 4 UploadFieldNames(13,3) = 1 UploadFieldNames(14,1) = "USED" UploadFieldNames(14,2) = 4 UploadFieldNames(14,3) = 1 UploadFieldNames(15,1) = "AS IS" UploadFieldNames(15,2) = 4 UploadFieldNames(15,3) = 1 UploadFieldNames(16,1) = "LOCKED" UploadFieldNames(16,2) = 2 UploadFieldNames(16,3) = 1 UploadFieldNames(17,1) = "UNLOCKED" UploadFieldNames(17,2) = 4 UploadFieldNames(17,3) = 1 UploadFieldNames(18,1) = "DESCRIPTION" UploadFieldNames(18,2) = 2 UploadFieldNames(18,3) = 1 UploadFieldNames(19,1) = "BASEPRODUCTID" UploadFieldNames(19,2) = 1 UploadFieldNames(19,3) = 1 UploadFieldNames(20,1) = "MAKE" UploadFieldNames(20,2) = 2 UploadFieldNames(20,3) = 1 UploadFieldNames(21,1) = "MODEL" UploadFieldNames(21,2) = 2 UploadFieldNames(21,3) = 1 end if end if for intLoop = 1 to intFieldCount ' See if the field exists in our excel source recordset intLoopFields = 0 flagFoundField = 0 while ((intLoopFields < rstImport.Fields.Count) and (flagFoundField = 0)) if UploadFieldNames(intLoop,1) = rstImport.Fields(intLoopFields).Name then flagFoundField = 1 else intLoopFields = intLoopFields + 1 end if wend ' If it's missing if flagFoundField = 0 then ' If its a required field, let them know if UploadFieldNames(intLoop,3) = 1 then ' Show them the field and the record that's screwed up lngFieldErrors = lngFieldErrors + 1 Response.Write "Missing Field (" & UploadFieldNames(intLoop,1) & "): " for intLoopFields = 1 to intFieldCount if intLoopFields > 1 then Response.Write "," Response.Write rstImport(intLoopFields).Value next Response.Write "
" & CrLf end if end if next CheckUploadFields = lngFieldErrors end function function UploadInventoryFile() Dim strImportFileDSN Dim strQuery,strProvider Dim tableloop Dim cellpercentage Dim cellcount Dim fso Dim ts Dim fUploaded Dim s Dim lngItemsAdded Dim lngItemsSkipped Dim lngItemsRead Dim lngItemsUpdated Dim lngManufacturerID Dim lngProductID Dim OBJdbConn Dim ftPrice Dim OBJdbConn2 Dim intLoop Dim strTempModel ' Let them know we are working Response.Write "

Importing excel file... Please wait...

" & CrLf ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize counts lngItemsAdded = 0 lngItemsSkipped = 0 lngItemsRead = 0 lngItemsUpdated = 0 ' Process all files received for each fUploaded in Upload.Files fUploaded.Copy strScriptLogPath & "import.xls" ' Create a DSN for the imported file strImportFileDSN = "DRIVER=Microsoft Excel Driver (*.xls); DBQ=" & strScriptLogPath & "import.xls" ' Create and open connection object Set OBJdbConn2 = Server.CreateObject("ADODB.Connection") OBJdbConn2.Mode = adModeShareDenyNone OBJdbConn2.Open strImportFileDSN ' Setup a query to read the excel import data 'strQuery = "SELECT MAKE, QTY, MODEL, PROTOCOL, [SELL FOR], [SELL FOR 26to199], [SELL FOR 200to499], [SELL FOR 500plus], AMP, DATE, COMPLETE, BOX, [HAND SET], [BRAND NEW], REFURB, [C/R], USED, [AS IS], LOCKED, UNLOCKED, BASEPRODUCTID, DESCRIPTION FROM [Sheet1$]" strQuery = "SELECT * FROM [Sheet1$]" Set rstImport = OBJdbConn2.Execute(strQuery) if rstImport.EOF then Response.Write "

There are no products available in this category.

" else ' Read each record from the excel file while not rstImport.EOF lngItemsRead = lngItemsRead + 1 if CheckUploadFields(2) <> 0 then Response.Write "*** Record above had errors , not imported ***
" & CrLf else ' Look and see if this product is already in the database strQuery = "SELECT ProductID FROM Products INNER JOIN [Product Manufacturers] ON [Product Manufacturers].ProductManufacturerID = Products.ProductManufacturerID WHERE (" strQuery = strQuery & "(ProductManufacturerName = '" & ConvertExcelString(rstImport("MAKE")) & "')" strQuery = strQuery & " and (ProductName = '" & ConvertExcelString(rstImport("MODEL")) & "')" strQuery = strQuery & " and (ProductProtocol = '" & ConvertExcelString(rstImport("PROTOCOL")) & "')" strQuery = strQuery & " and (ProductCategoryID = " & Upload.Form("ProductCategoryID") & ")" strQuery = strQuery & " and (ProductCarrierID = " & Upload.Form("CarrierID") & ")" strQuery = strQuery & ")" Set rstProductsForImport = OBJdbConn.Execute(strQuery) if not rstProductsForImport.EOF then ' Already in database so update lngItemsUpdated = lngItemsUpdated + 1 strQuery = "UPDATE Products SET ProductQuantity = " & ConvertExcelNumeric(rstImport("QTY"),0) strQuery = strQuery & " , ProductManufacturerPrice = " & round((ConvertExcelNumeric(rstImport("SELL FOR"),1) / (1.0 + fltWholesalePercentage)),2) strQuery = strQuery & " , ProductRetailPrice = " & round(((ConvertExcelNumeric(rstImport("SELL FOR"),1) * (1.0 + fltRetailPercentage)) / (1.0 + fltWholesalePercentage)),2) strQuery = strQuery & " , ProductWholesalePrice1to50 = " & round(ConvertExcelNumeric(rstImport("SELL FOR 1to50"),1),2) strQuery = strQuery & " , ProductWholesalePrice51to100 = " & round(ConvertExcelNumeric(rstImport("SELL FOR 51to100"),1),2) strQuery = strQuery & " , ProductWholesalePrice100plus = " & round(ConvertExcelNumeric(rstImport("SELL FOR 100plus"),1),2) strQuery = strQuery & " , ProductNewQuantity = " & ConvertExcelNumeric(rstImport("NewQty"),0) strQuery = strQuery & " , ProductNewPrice = " & round(ConvertExcelNumeric(rstImport("NewPrice"),1),2) strQuery = strQuery & " , ProductRefurbQuantity = " & ConvertExcelNumeric(rstImport("RefurbQty"),0) strQuery = strQuery & " , ProductRefurbPrice = " & round(ConvertExcelNumeric(rstImport("RefurbPrice"),1),2) strQuery = strQuery & " , ProductTestedQuantity = " & ConvertExcelNumeric(rstImport("TestedQty"),0) strQuery = strQuery & " , ProductTestedPrice = " & round(ConvertExcelNumeric(rstImport("TestedPrice"),1),2) strQuery = strQuery & " , ProductUntestedQuantity = " & ConvertExcelNumeric(rstImport("UntestedQty"),0) strQuery = strQuery & " , ProductUntestedPrice = " & round(ConvertExcelNumeric(rstImport("UntestedPrice"),1),2) strQuery = strQuery & " , ProductAsisQuantity = " & ConvertExcelNumeric(rstImport("AsisQty"),0) strQuery = strQuery & " , ProductAsisPrice = " & round(ConvertExcelNumeric(rstImport("AsisPrice"),1),2) strQuery = strQuery & " , ProductAMP = '" & ConvertExcelString(rstImport("AMP")) & "'" strQuery = strQuery & " , ProductLastUpdated = '" & ConvertExcelNumeric(rstImport("DATE"),2) & "'" strQuery = strQuery & " , ProductComplete = " & ConvertStarStarToYesNoValues(rstImport("COMPLETE")) strQuery = strQuery & " , ProductBox = '" & ConvertExcelString(rstImport("BOX")) & "'" strQuery = strQuery & " , ProductHandset = '" & ConvertExcelString(rstImport("HAND SET")) & "'" strQuery = strQuery & " , ProductBrandNew = " & ConvertStarStarToYesNoValues(rstImport("BRAND NEW")) strQuery = strQuery & " , ProductRefurbished = " & ConvertStarStarToYesNoValues(rstImport("REFURB")) strQuery = strQuery & " , ProductCR = " & ConvertStarStarToYesNoValues(rstImport("C/R")) strQuery = strQuery & " , ProductUsed = " & ConvertStarStarToYesNoValues(rstImport("USED")) strQuery = strQuery & " , ProductAsIs = " & ConvertStarStarToYesNoValues(rstImport("AS IS")) strQuery = strQuery & " , ProductLocked = '" & ConvertExcelString(rstImport("LOCKED")) & "'" strQuery = strQuery & " , ProductUnlocked = " & ConvertStarStarToYesNoValues(rstImport("UNLOCKED")) strQuery = strQuery & " , ImageLink = '" & ConvertExcelString(rstImport("ImageLink")) & "'" strQuery = strQuery & " , ProductDescription = '" & ConvertExcelString(rstImport("DESCRIPTION")) & "'" strQuery = strQuery & " , ProductBaseProductID = " & ConvertExcelNumeric(rstImport("BASEPRODUCTID"),0) strQuery = strQuery & " WHERE ProductID = " & rstProductsForImport("ProductID") else ' New product so do an insert lngManufacturerID = GetManufacturerID(ConvertExcelString(rstImport("MAKE")),0) if lngManufacturerID = 0 then Response.Write "Skipped Invalid Manufacturer: (" & ConvertExcelString(rstImport("MAKE")) & "),(" & ConvertExcelNumeric(rstImport("QTY"),0) & "),(" & ConvertExcelString(rstImport("MODEL")) & "),(" & ConvertExcelString(rstImport("PROTOCOL")) & "))
" & CrLf strQuery = "" lngItemsSkipped = lngItemsSkipped + 1 else if len(ConvertExcelString(rstImport("PROTOCOL"))) < 1 then Response.Write "Skipped Missing Product Type / PROTOCOL: (" & ConvertExcelString(rstImport("MAKE")) & "),(" & ConvertExcelNumeric(rstImport("QTY"),0) & "),(" & ConvertExcelString(rstImport("MODEL")) & ")),(" & ConvertExcelString(rstImport("PROTOCOL")) & ")
" & CrLf strQuery = "" lngItemsSkipped = lngItemsSkipped + 1 else if ((len(ConvertExcelString(rstImport("MODEL"))) < 1) and (len(rstImport("MODEL")) <= 0)) then Response.Write "Skipped Missing Product Name / MODEL: (" & ConvertExcelString(rstImport("MAKE")) & "),(" & ConvertExcelNumeric(rstImport("QTY"),0) & "),(" & ConvertExcelString(rstImport("MODEL")) & ")),(" & ConvertExcelString(rstImport("PROTOCOL")) & ")
" & CrLf strQuery = "" lngItemsSkipped = lngItemsSkipped + 1 else if (len(ConvertExcelString(rstImport("MODEL"))) > 0) then strTempModel = ConvertExcelString(rstImport("MODEL")) else strTempModel = rstImport("MODEL") end if lngProductID = GetProductID("",0) + 1 lngItemsAdded = lngItemsAdded + 1 strQuery = "INSERT INTO Products (ProductID, ProductManufacturerID, ProductCategoryID, ProductCarrierID, ProductName, ProductType, " & _ "ProductProtocol, ProductQuantity, ProductManufacturerPrice, ProductRetailPrice, " & _ "ProductWholesalePrice1to50, ProductWholesalePrice51to100, " & _ "ProductWholesalePrice100plus, ProductNewQuantity, ProductNewPrice, ProductRefurbQuantity, ProductRefurbPrice, " & _ "ProductTestedQuantity, ProductTestedPrice, ProductUntestedQuantity, ProductUntestedPrice, " & _ "ProductAsisQuantity, ProductAsisPrice, ProductAMP, ProductLastUpdated, ProductComplete, ProductBox, " & _ "ProductHandset, ProductBrandNew, ProductRefurbished, ProductCR, ProductUsed, ProductAsIs, ProductLocked, " & _ "ProductUnlocked, ImageLink, ProductDescription, ProductBaseProductID) VALUES (" strQuery = strQuery & lngProductID & " , " & lngManufacturerID & " , " & Upload.Form("ProductCategoryID") & " , " & Upload.Form("CarrierID") strQuery = strQuery & " , '" & strTempModel & "'" strQuery = strQuery & " , '" & ConvertExcelString(rstImport("PROTOCOL")) & "'" strQuery = strQuery & " , '" & ConvertExcelString(rstImport("PROTOCOL")) & "'" strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("QTY"),0) strQuery = strQuery & " , " & round((ConvertExcelNumeric(rstImport("SELL FOR 1to50"),1) / (1.0 + fltWholesalePercentage)),2) strQuery = strQuery & " , " & ((ConvertExcelNumeric(rstImport("SELL FOR 1to50"),1) / fltRetailPercentage) * fltWholesalePercentage) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("SELL FOR 1to50"),1) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("SELL FOR 51to100"),1) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("SELL FOR 100plus"),1) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("NewQty"),0) strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("NewPrice"),1),2) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("RefurbQty"),0) strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("RefurbPrice"),1),2) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("TestedQty"),0) strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("TestedPrice"),1),2) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("UntestedQty"),0) strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("UntestedPrice"),1),2) strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("AsisQty"),0) strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("AsisPrice"),1),2) strQuery = strQuery & " , '" & ConvertExcelString(rstImport("AMP")) & "'" strQuery = strQuery & " , '" & ConvertExcelNumeric(rstImport("DATE"),2) & "'" strQuery = strQuery & " , " & ConvertStarStarToYesNoValues(rstImport("COMPLETE")) strQuery = strQuery & " , '" & ConvertExcelString(rstImport("BOX")) & "'" strQuery = strQuery & " , '" & ConvertExcelString(rstImport("HAND SET")) & "'" strQuery = strQuery & " , " & ConvertStarStarToYesNoValues(rstImport("BRAND NEW")) strQuery = strQuery & " , " & ConvertStarStarToYesNoValues(rstImport("REFURB")) strQuery = strQuery & " , " & ConvertStarStarToYesNoValues(rstImport("C/R")) strQuery = strQuery & " , " & ConvertStarStarToYesNoValues(rstImport("USED")) strQuery = strQuery & " , " & ConvertStarStarToYesNoValues(rstImport("AS IS")) strQuery = strQuery & " , '" & ConvertExcelString(rstImport("LOCKED")) & "'" strQuery = strQuery & " , " & ConvertStarStarToYesNoValues(rstImport("UNLOCKED")) strQuery = strQuery & " , '" & ConvertExcelString(rstImport("ImageLink")) & "'" if len(rstImport("DESCRIPTION")) > 0 then strQuery = strQuery & " , '" & ConvertExcelString(rstImport("DESCRIPTION")) & "'" else strQuery = strQuery & " , '" & ConvertExcelString(rstImport("MAKE")) & " " & strTempModel & ", " & ConvertExcelString(rstImport("PROTOCOL")) & "'" end if strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("BASEPRODUCTID"),0) strQuery = strQuery & ")" end if end if end if end if rstProductsForImport.close set rstProductsForImport = nothing ' Do the insert or update if strQuery <> "" then Set rstProductsForImport = OBJdbConn.Execute(strQuery) end if end if ' Go to the next import item rstImport.MoveNext wend end if ' Close and clean up rstImport.close set rstImport = nothing OBJdbConn2.close set OBJdbConn2 = nothing next ' Close and clean up OBJdbConn.close set OBJdbConn = nothing ' Let them know how we did Response.Write "

" & lngItemsRead & " items read, " & lngItemsSkipped & " items skipped, " & lngItemsAdded & " items added, " & lngItemsUpdated & " items updated." & "

" & CrLf end function function ModifyPercentages() Dim rstPercentage Dim OBJdbConn ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN if Upload("step") = 2 then ' Update percentages strQuery = "UPDATE tblPercentages SET fltWholesalePercentage1to49 = " & Upload("fltWholesalePercentage1to49") & ", fltWholesalePercentage50to99 = " & Upload("fltWholesalePercentage50to99") & ", fltWholesalePercentage100up = " & Upload("fltWholesalePercentage100up") & ", fltRetailPercentageV2 = " & Upload("fltRetailPercentageV2") & " FROM tblPercentages" Set rstPercentage = OBJdbConn.Execute(strQuery) Response.Write "

Percentages updated.

" & CrLf else ' Get percentages strQuery = "SELECT fltWholesalePercentage1to49, fltWholesalePercentage50to99, fltWholesalePercentage100up, fltRetailPercentageV2 FROM tblPercentages" Set rstPercentage = OBJdbConn.Execute(strQuery) Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf if not rstPercentage.EOF then Response.Write "Wholesaler Percentage ($1-$49):
" Response.Write "Wholesaler Percentage ($50-$99):
" Response.Write "Wholesaler Percentage ($100-Up):
" Response.Write "Retail Percentage (V2):
" else Response.Write "

*** Unable to read percentaqes defaulting to 12% wholesale, 25% retail ***

" & CrLf Response.Write "Wholesaler Percentage ($1-$49):
" Response.Write "Wholesaler Percentage ($50-$99):
" Response.Write "Wholesaler Percentage ($100-Up):
" Response.Write "Retail Percentage (V2):
" end if Response.Write "
" & CrLf rstPercentage.close end if ' Close and clean up set rstPercentage = nothing OBJdbConn.close set OBJdbConn = nothing end function ' V2 = MicroTelecom function UploadInventoryFileV2() Dim strImportFileDSN Dim strQuery,strProvider Dim tableloop Dim cellpercentage Dim cellcount Dim fso Dim ts Dim fUploaded Dim s Dim lngItemsAdded Dim lngItemsSkipped Dim lngItemsRead Dim lngItemsUpdated Dim lngItemsNotAllowed Dim lngItemsNotUpdated Dim lngManufacturerID Dim lngProductID Dim OBJdbConn Dim ftPrice Dim OBJdbConn2 Dim intLoop Dim strTempModel Dim flagImport Dim flagManufacturer Dim importProductProtocol Dim importProductCarrierID Dim fltWholesalePercentage1to49 Dim fltWholesalePercentage50to99 Dim fltWholesalePercentage100up Dim fltRetailPercentageV2 Dim rstPercentage Dim rstNotUpdated Dim rstManufacturer ' Let them know we are working Response.Write "

Importing excel file (MicroTelecom)... Please wait...

" & CrLf Response.Flush ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize counts lngItemsAdded = 0 lngItemsSkipped = 0 lngItemsRead = 0 lngItemsUpdated = 0 lngItemsNotAllowed = 0 lngItemsNotUpdated = 0 ' Get percentages strQuery = "SELECT fltWholesalePercentage1to49, fltWholesalePercentage50to99, fltWholesalePercentage100up, fltRetailPercentageV2 FROM tblPercentages" Set rstPercentage = OBJdbConn.Execute(strQuery) if not rstPercentage.EOF then fltWholesalePercentage1to49 = rstPercentage("fltWholesalePercentage1to49") fltWholesalePercentage50to99 = rstPercentage("fltWholesalePercentage50to99") fltWholesalePercentage100up = rstPercentage("fltWholesalePercentage100up") fltRetailPercentageV2 = rstPercentage("fltRetailPercentageV2") else Response.Write "

*** Unable to read percentaqes defaulting to 12% wholesale, 25% retail ***

" & CrLf fltWholesalePercentage1to49 = 0.12 fltWholesalePercentage50to99 = 0.12 fltWholesalePercentage100up = 0.12 fltRetailPercentageV2 = 0.25 end if rstPercentage.close set rstPercentage = nothing ' Process all files received for each fUploaded in Upload.Files fUploaded.Copy strScriptLogPath & "import.xls" ' Create a DSN for the imported file strImportFileDSN = "DRIVER=Microsoft Excel Driver (*.xls); DBQ=" & strScriptLogPath & "import.xls" ' Create and open connection object Set OBJdbConn2 = Server.CreateObject("ADODB.Connection") OBJdbConn2.Mode = adModeShareDenyNone OBJdbConn2.Open strImportFileDSN ' Setup a query to read the excel import data strQuery = "SELECT * FROM [Sheet1$]" Set rstImport = OBJdbConn2.Execute(strQuery) if rstImport.EOF then Response.Write "

There are no products available in this category.

" else ' Read each record from the excel file while not rstImport.EOF lngItemsRead = lngItemsRead + 1 flagImport = 0 ' Check the Main Cat if ((ConvertExcelString(rstImport("Main Cat")) <> "Phones") and (ConvertExcelString(rstImport("Main Cat")) <> "Mobile Accessories")) then flagImport = 1 lngItemsNotAllowed = lngItemsNotAllowed + 1 ' Response.Write "Skipping item not allowed: Main Cat (" & ConvertExcelString(rstImport("Main Cat")) & ") , Sub Cat (" & ConvertExcelString(rstImport("Sub Cat")) & ") , ItemID (" & ConvertExcelString(rstImport("ItemID")) & ") , ItemDesc (" & ConvertExcelString(rstImport("ItemDesc")) & ")
" else ' Look and see if this product is already in the database strQuery = "SELECT ProductID FROM Products INNER JOIN [Product Manufacturers] ON [Product Manufacturers].ProductManufacturerID = Products.ProductManufacturerID WHERE " if (ConvertExcelString(rstImport("Main Cat")) = "Phones") then strQuery = strQuery & "((ProductProtocol = 'GSM') and (ProductCategoryID = 2)" if (ConvertExcelString(rstImport("Sub Cat")) = "GSM") then if (mid(ConvertExcelString(rstImport("Main Cat")),1,2) = "TM") then strQuery = strQuery & " and (ProductCarrierID = 5)" else strQuery = strQuery & " and (ProductCarrierID = 6)" end if else if (ConvertExcelString(rstImport("Sub Cat")) = "CINGULAR") then strQuery = strQuery & " and (ProductCarrierID = 4)" else if (ConvertExcelString(rstImport("Sub Cat")) = "T-MOBILE") then strQuery = strQuery & " and (ProductCarrierID = 5)" else flagImport = 1 lngItemsNotAllowed = lngItemsNotAllowed + 1 ' Response.Write "Skipping item not allowed: Main Cat (" & ConvertExcelString(rstImport("Main Cat")) & ") , Sub Cat (" & ConvertExcelString(rstImport("Sub Cat")) & ") , ItemID (" & ConvertExcelString(rstImport("ItemID")) & ") , ItemDesc (" & ConvertExcelString(rstImport("ItemDesc")) & ")
" end if end if end if else strQuery = strQuery & "((ProductProtocol = 'NoProtocol') and (ProductCategoryID = 4)" ' if (ConvertExcelString(rstImport("Main Cat")) = "Mobile Accessories") then ' strQuery = strQuery & " and (ProductCarrierID = 6)" ' else flagImport = 1 lngItemsNotAllowed = lngItemsNotAllowed + 1 ' Response.Write "Skipping item not allowed: Main Cat (" & ConvertExcelString(rstImport("Main Cat")) & ") , Sub Cat (" & ConvertExcelString(rstImport("Sub Cat")) & ") , ItemID (" & ConvertExcelString(rstImport("ItemID")) & ") , ItemDesc (" & ConvertExcelString(rstImport("ItemDesc")) & ")
" ' end if end if end if if flagImport = 0 then strQuery = strQuery & " and (ProductName = '" & ConvertExcelString(rstImport("ItemDesc")) & "'))" ' Response.Write "

(" & strQuery & ")

" & CrLf Set rstProductsForImport = OBJdbConn.Execute(strQuery) if not rstProductsForImport.EOF then ' Already in database so update lngItemsUpdated = lngItemsUpdated + 1 strQuery = "UPDATE Products SET ProductQuantity = " & ConvertExcelNumeric(rstImport("QTY"),0) strQuery = strQuery & " , ProductManufacturerPrice = " & round(ConvertExcelNumeric(rstImport("Cost/Min"),1),2) strQuery = strQuery & " , ProductRetailPrice = " & round((ConvertExcelNumeric(rstImport("Price"),1)),2) if (ConvertExcelString(rstImport("Main Cat")) = "Phones") then if ConvertExcelNumeric(rstImport("Price"),1) <= 49 then strQuery = strQuery & " , ProductWholesalePrice1to50 = " & round((ConvertExcelNumeric(rstImport("Cost/Min"),1) * (1.0 + fltWholesalePercentage1to49)),2) else if ConvertExcelNumeric(rstImport("Price"),1) <= 99 then strQuery = strQuery & " , ProductWholesalePrice1to50 = " & round((ConvertExcelNumeric(rstImport("Cost/Min"),1) * (1.0 + fltWholesalePercentage50to99)),2) else strQuery = strQuery & " , ProductWholesalePrice1to50 = " & round((ConvertExcelNumeric(rstImport("Cost/Min"),1) * (1.0 + fltWholesalePercentage100up)),2) end if end if else strQuery = strQuery & " , ProductWholesalePrice1to50 = " & round((ConvertExcelNumeric(rstImport("Cost/Min"),1) * (1.0 + fltRetailPercentage)),2) end if strQuery = strQuery & " , ProductLastUpdated = '" & Date() & "'" strQuery = strQuery & " , ProductDescription = '" & ConvertExcelString(rstImport("ItemDesc")) & "'" strQuery = strQuery & " WHERE ProductID = " & rstProductsForImport("ProductID") else lngProductID = GetProductID("",0) + 1 lngItemsAdded = lngItemsAdded + 1 strQuery = "INSERT INTO Products (ProductID, ProviderID, ProductManufacturerID, ProductProtocol, ProductType, ProductCategoryID, ProductCarrierID, ProductName, " & _ "ProductQuantity, ProductManufacturerPrice, ProductRetailPrice, " & _ "ProductWholesalePrice1to50, ProductWholesalePrice51to100, " & _ "ProductWholesalePrice100plus, ProductNewQuantity, ProductNewPrice, ProductRefurbQuantity, ProductRefurbPrice, " & _ "ProductTestedQuantity, ProductTestedPrice, ProductUntestedQuantity, ProductUntestedPrice, " & _ "ProductAsisQuantity, ProductAsisPrice, ProductAMP, ProductLastUpdated, ProductComplete, ProductBox, " & _ "ProductHandset, ProductBrandNew, ProductRefurbished, ProductCR, ProductUsed, ProductAsIs, ProductLocked, " & _ "ProductUnlocked, ImageLink, ProductDescription, ProductBaseProductID) VALUES (" strQuery = strQuery & lngProductID & " , 10 , " ' Get Manufacturer flagManufacturer = 0 Set rstManufacturer = OBJdbConn.Execute("SELECT ProductManufacturerID, ProductManufacturerName FROM [Product Manufacturers]") while ((not rstManufacturer.EOF) and (flagManufacturer = 0)) if instr(UCASE(rstImport("ItemDesc")),UCASE(rstManufacturer("ProductManufacturerName"))) > 0 then flagManufacturer = 1 strQuery = strQuery & " " & rstManufacturer("ProductManufacturerID") & " , " else rstManufacturer.movenext end if wend if flagManufacturer = 0 then ' See if its any wierd manufacturers if instr(UCASE(rstImport("ItemDesc")),"RIM") > 0 then strQuery = strQuery & " 28 , " else if instr(UCASE(rstImport("ItemDesc")),"SIDEKICK") > 0 then strQuery = strQuery & " 26 , " else if instr(UCASE(rstImport("ItemDesc")),"ERIC") > 0 then strQuery = strQuery & " 11 , " else if instr(UCASE(rstImport("ItemDesc")),"EREIC") > 0 then strQuery = strQuery & " 11 , " else if instr(UCASE(rstImport("ItemDesc")),"TM DASH") > 0 then strQuery = strQuery & " 26 , " else if instr(UCASE(rstImport("ItemDesc")),"SAM.") > 0 then strQuery = strQuery & " 4 , " else if instr(UCASE(rstImport("ItemDesc")),"-SAM-") > 0 then strQuery = strQuery & " 4 , " else if instr(UCASE(rstImport("ItemDesc")),"MOTO") > 0 then strQuery = strQuery & " 2 , " else if instr(UCASE(rstImport("ItemDesc")),"T219") > 0 then strQuery = strQuery & " 4 , " else if instr(UCASE(rstImport("ItemDesc")),"T309") > 0 then strQuery = strQuery & " 4 , " else if instr(UCASE(rstImport("ItemDesc")),"x495") > 0 then strQuery = strQuery & " 4 , " else if instr(UCASE(rstImport("ItemDesc")),"CHOCOLATE") > 0 then strQuery = strQuery & " 6 , " else strQuery = strQuery & " 25 , " end if end if end if end if end if end if end if end if end if end if end if end if end if ' Get Product category if (ConvertExcelString(rstImport("Main Cat")) = "Phones") then strQuery = strQuery & "'GSM' , 'GSM', 2 , " if (ConvertExcelString(rstImport("Sub Cat")) = "GSM") then if (mid(ConvertExcelString(rstImport("Main Cat")),1,2) = "TM") then strQuery = strQuery & " 5 , " else strQuery = strQuery & " 6 , " end if else if (ConvertExcelString(rstImport("Sub Cat")) = "CINGULAR") then strQuery = strQuery & " 4 , " else if (ConvertExcelString(rstImport("Sub Cat")) = "T-MOBILE") then strQuery = strQuery & " 5 , " else flagImport = 1 lngItemsNotAllowed = lngItemsNotAllowed + 1 ' Response.Write "Skipping item not allowed: Main Cat (" & ConvertExcelString(rstImport("Main Cat")) & ") , Sub Cat (" & ConvertExcelString(rstImport("Sub Cat")) & ") , ItemID (" & ConvertExcelString(rstImport("ItemID")) & ") , ItemDesc (" & ConvertExcelString(rstImport("ItemDesc")) & ")
" end if end if end if else strQuery = strQuery & "'NoProtocol' , 'NoProtocol' , 4 , " ' if (ConvertExcelString(rstImport("Main Cat")) = "Mobile Accessories") then ' strQuery = strQuery & " 6 , " ' else flagImport = 1 lngItemsNotAllowed = lngItemsNotAllowed + 1 ' Response.Write "Skipping item not allowed: Main Cat (" & ConvertExcelString(rstImport("Main Cat")) & ") , Sub Cat (" & ConvertExcelString(rstImport("Sub Cat")) & ") , ItemID (" & ConvertExcelString(rstImport("ItemID")) & ") , ItemDesc (" & ConvertExcelString(rstImport("ItemDesc")) & ")
" ' end if end if if flagImport = 0 then strQuery = strQuery & "'" & ConvertExcelString(rstImport("ItemDesc")) & "'" strQuery = strQuery & " , " & ConvertExcelNumeric(rstImport("QTY"),0) strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("Cost/Min"),1),2) strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("Price"),1),2) if (ConvertExcelString(rstImport("Main Cat")) = "Phones") then if ConvertExcelNumeric(rstImport("Cost/Min"),1) <= 49 then strQuery = strQuery & " , " & round((ConvertExcelNumeric(rstImport("Cost/Min"),1) * (1.0 + fltWholesalePercentage1to49)),2) else if ConvertExcelNumeric(rstImport("Cost/Min"),1) <= 99 then strQuery = strQuery & " , " & round((ConvertExcelNumeric(rstImport("Cost/Min"),1) * (1.0 + fltWholesalePercentage50to99)),2) else strQuery = strQuery & " , " & round((ConvertExcelNumeric(rstImport("Cost/Min"),1) * (1.0 + fltWholesalePercentage100up)),2) end if end if else strQuery = strQuery & " , " & round(ConvertExcelNumeric(rstImport("Price"),1),2) end if strQuery = strQuery & " , 0.00 , 0.00 , 0 , 0.00 , 0 , 0.00 , 0 , 0.00 , 0 , 0.00 , 0 , 0.00, '' , '" & Date() & "' , 0, '', '', 0, 0, 0, 0, 0,'',0,''" strQuery = strQuery & " , '" & ConvertExcelString(rstImport("ItemDesc")) & "'" strQuery = strQuery & " , 0" strQuery = strQuery & ")" Response.Write "Adding item: Main Cat (" & ConvertExcelString(rstImport("Main Cat")) & ") , Sub Cat (" & ConvertExcelString(rstImport("Sub Cat")) & ") , ItemID (" & ConvertExcelString(rstImport("ItemID")) & ") , ItemDesc (" & ConvertExcelString(rstImport("ItemDesc")) & ")
" end if end if rstProductsForImport.close set rstProductsForImport = nothing end if ' Do the insert or update if flagImport = 0 then ' Response.Write "

(" & strQuery & ")

" & CrLf Set rstProductsForImport = OBJdbConn.Execute(strQuery) end if ' Go to the next import item rstImport.MoveNext wend end if ' Close and clean up rstImport.close set rstImport = nothing OBJdbConn2.close set OBJdbConn2 = nothing next ' Get NotUpdated items strQuery = "SELECT ProductName, ProductQuantity, ProductWholesalePrice1to50, ProductProtocol FROM Products WHERE ((ProductLastUpdated < '" & Date() & "') AND (ProviderID = 10))" Set rstNotUpdated = OBJdbConn.Execute(strQuery) if not rstNotUpdated.eof then Response.Write "The following items were not on the spreadsheet, so they were not updated:
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf while not rstNotUpdated.EOF lngItemsNotUpdated = lngItemsNotUpdated + 1 ' Table view Response.Write "" Response.Write "" if rstNotUpdated.Fields("ProductQuantity") = 0 then Response.Write "" else Response.Write "" end if if rstNotUpdated.Fields("ProductWholesalePrice1to50") > 0 then Response.Write "" else Response.Write "" Response.Write "" end if if len(rstNotUpdated.Fields("ProductProtocol")) > 0 then Response.Write "" else Response.Write "" end if Response.Write "" & CrLF rstNotUpdated.movenext wend Response.Write "
Item DescriptionQuantityPriceProtocol
" + rstNotUpdated.Fields("ProductName") + "(Call for Availability)" & rstNotUpdated.Fields("ProductQuantity") & "" & FormatPrice(rstNotUpdated.Fields("ProductWholesalePrice1to50")) & "$(Call)" & rstNotUpdated.Fields("ProductProtocol") & " 
" & CrLF end if ' Close and clean up rstNotUpdated.close set rstNotUpdated = nothing OBJdbConn.close set OBJdbConn = nothing ' Let them know how we did Response.Write "

" & lngItemsRead & " items read, " & lngItemsSkipped & " items skipped, " & lngItemsAdded & " items added, " & lngItemsUpdated & " items updated, " & lngItemsNotAllowed & " items not allowed, " & lngItemsNotUpdated & " items not updated that were not on worksheet." & "

" & CrLf end function function MaintainItems() Dim strImportFileDSN Dim strQuery,strProvider Dim rstImport Dim rstProducts Dim tableloop Dim cellpercentage Dim cellcount Dim fso Dim ts Dim fUploaded Dim s Dim lngItemsCount Dim lngManufacturerID Dim lngProductID Dim OBJdbConn Dim ftPrice Dim OBJdbConn2 Dim intLoop ' Initialize objects and variables set fso = CreateObject("Scripting.FileSystemObject") ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize counts lngItemsCount = 0 if Upload.Form("Step") <> "2" then ' Put a header up for our table Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf ' Setup our query to get all items strQuery = "SELECT Products.ProductID, Products.ProductName, Products.ProductType, Products.ProductManufacturerID, [Product Manufacturers].ProductManufacturerName, Products.ProductCategoryID, [Product Categories].ProductCategoryName, Products.ProductCarrierID, [tblProductCarriers].ProductCarrierName, Products.ProductRetailPrice, Products.ProductWholesalePrice1to50, Products.ProductWholesalePrice51to100, Products.ProductWholesalePrice100plus, Products.ProductManufacturerPrice, Products.ProductBaseProductID, Products.ProductLastUpdated, Products.ProductProtocol, Products.ProductQuantity, Products.ProductAMP, Products.ProductComplete, Products.ProductBox, Products.ProductHandset, Products.ProductBrandNew, Products.ProductRefurbished, Products.ProductCR, Products.ProductUsed, Products.ProductAsIs, Products.ProductLocked, Products.ProductUnlocked," strQuery = strQuery & " Products.ProductNewQuantity,Products.ProductRefurbQuantity,Products.ProductTestedQuantity,Products.ProductUntestedQuantity,Products.ProductAsisQuantity," strQuery = strQuery & " Products.ProductNewPrice,Products.ProductRefurbPrice,Products.ProductTestedPrice,Products.ProductUntestedPrice,Products.ProductAsisPrice, Products.ImageLink, Products.ProductDescription" strQuery = strQuery & " FROM (Products INNER JOIN [Product Categories] ON Products.ProductCategoryID = [Product Categories].ProductCategoryID) INNER JOIN [Product Manufacturers] ON Products.ProductManufacturerID = [Product Manufacturers].ProductManufacturerID INNER JOIN tblProductCarriers ON Products.ProductCarrierID = tblProductCarriers.ProductCarrierID " if len(strCriteria) > 0 then strQuery = strQuery & " WHERE (" & strCriteria & ")" end if strQuery = strQuery & " ORDER BY Products.ProductWholesalePrice1to50" Set rstProducts = OBJdbConn.Execute(strQuery) if rstProducts.EOF then ' No items in database Response.Write "" & CrLf else ' Show this item while not rstProducts.EOF lngItemsCount = lngItemsCount + 1 Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" Response.Write "" ' Check for product image Response.Write "" & CrLf Response.Write "" Response.Write "" & CrLf Response.Write "" Response.Write "" Response.Write "" Response.Write "" & CrLf ' Move to next item rstProducts.MoveNext wend end if ' Close the recordset rstProducts.close ' End our table Response.Write "
ProductIDProductNameProductTypeProductDescriptionProductManufacturerIDProductManufacturerNameProductCategoryIDProductCategoryNameProductCarrierIDProduct Carrier NameProductRetailPriceProductWholesalePrice1to50ProductWholesalePrice51to100ProductWholesalePrice100plusProduct New QuantityProduct New PriceProduct Refurb QuantityProduct Refurb PriceProduct Tested QuantityProduct Tested PriceProduct Untested QuantityProduct Untested PriceProduct Asis QuantityProduct Asis PriceProductManufacturerPriceProductLastUpdatedProductProtocolProductQuantityProductAMPProductCompleteProductBoxProductHandsetProductBrandNewProductRefurbishedProductCRProductUsedProductAsIsProductLockedProductUnlockedProductBaseProductID(ProductImageFile)
No items in the database.
" & CrLf if fso.FileExists(strImagePath & "Product" & CStr(rstProducts("ProductID")) & ".jpg") then ' If product image is there then just show it Response.Write "" & rstProducts("ProductName") & "
" & CrLf end if ' If no product image then let them browse for one to upload Response.Write "New Product Image file:
" & CrLf Response.Write "
" Response.Write "" Response.Write "
" Response.Write "
" & CrLf Response.Write "
" & CrLf else ' Step 2 is to update an item ' Make the update statement strQuery = "UPDATE Products SET" strQuery = strQuery & " ProductName = '" & Upload.Form("ProductName") & "'" strQuery = strQuery & " , ProductType = '" & Upload.Form("ProductType") & "'" strQuery = strQuery & " , ProductDescription = '" & FixQuotes(Upload.Form("ProductDescription")) & "'" strQuery = strQuery & " , ProductManufacturerID = " & Upload.Form("ProductManufacturerID") strQuery = strQuery & " , ProductCategoryID = " & Upload.Form("ProductCategoryID") strQuery = strQuery & " , ProductCarrierID = " & Upload.Form("ProductCarrierID") strQuery = strQuery & " , ProductQuantity = " & Upload.Form("ProductQuantity") strQuery = strQuery & " , ProductManufacturerPrice = " & Upload.Form("ProductManufacturerPrice") strQuery = strQuery & " , ProductRetailPrice = " & Upload.Form("ProductRetailPrice") strQuery = strQuery & " , ProductWholesalePrice1to50 = " & Upload.Form("ProductWholesalePrice1to50") strQuery = strQuery & " , ProductWholesalePrice51to100 = " & Upload.Form("ProductWholesalePrice51to100") strQuery = strQuery & " , ProductWholesalePrice100plus = " & Upload.Form("ProductWholesalePrice100plus") strQuery = strQuery & " , ProductNewQuantity = " & Upload.Form("ProductNewQuantity") strQuery = strQuery & " , ProductNewPrice = " & Upload.Form("ProductNewPrice") strQuery = strQuery & " , ProductRefurbQuantity = " & Upload.Form("ProductRefurbQuantity") strQuery = strQuery & " , ProductRefurbPrice = " & Upload.Form("ProductRefurbPrice") strQuery = strQuery & " , ProductTestedQuantity = " & Upload.Form("ProductTestedQuantity") strQuery = strQuery & " , ProductTestedPrice = " & Upload.Form("ProductTestedPrice") strQuery = strQuery & " , ProductUntestedQuantity = " & Upload.Form("ProductUntestedQuantity") strQuery = strQuery & " , ProductUntestedPrice = " & Upload.Form("ProductUntestedPrice") strQuery = strQuery & " , ProductAsisQuantity = " & Upload.Form("ProductAsisQuantity") strQuery = strQuery & " , ProductAsisPrice = " & Upload.Form("ProductAsisPrice") strQuery = strQuery & " , ProductAMP = '" & Upload.Form("ProductAMP") & "'" strQuery = strQuery & " , ProductLastUpdated = '" & Upload.Form("ProductLastUpdated") & "'" strQuery = strQuery & " , ProductComplete = " & Upload.Form("ProductComplete") strQuery = strQuery & " , ProductBox = '" & Upload.Form("ProductBox") & "'" strQuery = strQuery & " , ProductHandset = '" & Upload.Form("ProductHandset") & "'" strQuery = strQuery & " , ProductBrandNew = " & Upload.Form("ProductBrandNew") strQuery = strQuery & " , ProductRefurbished = " & Upload.Form("ProductRefurbished") strQuery = strQuery & " , ProductCR = " & Upload.Form("ProductCR") strQuery = strQuery & " , ProductUsed = " & Upload.Form("ProductUsed") strQuery = strQuery & " , ProductAsIs = " & Upload.Form("ProductAsIs") strQuery = strQuery & " , ProductLocked = '" & Upload.Form("ProductLocked") & "'" strQuery = strQuery & " , ProductUnlocked = " & Upload.Form("ProductUnlocked") strQuery = strQuery & " , ImageLink = '" & Upload.Form("ImageLink") & "'" strQuery = strQuery & " , ProductBaseProductID = " & Upload.Form("ProductBaseProductID") strQuery = strQuery & " WHERE (ProductID = " & Upload.Form("ProductID") & ")" ' Do the update Set rstProducts = OBJdbConn.Execute(strQuery) ' Process the picture if sent for each fUploaded in Upload.Files fUploaded.Copy strImagePath & "Product" & CStr(Upload.Form("ProductID")) & ".jpg" next Response.Write "

Product updated.

" & CrLf end if ' Close and clean up set rstProducts = nothing OBJdbConn.close set OBJdbConn = nothing end function ' intView = 1 Normal View ' 2 Table View for Wholesalers function ShowProducts(strRetailPrice,strWholesalePrice,intView) Dim strQuery,strProvider Dim rst Dim tableloop Dim cellpercentage Dim OBJdbConn Dim lngTotalQuantity Dim intWholesalePriceBreaks ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Make our sql statement strQuery = "SELECT Products.ProductID, Products.ProductName, Products.ProductType, Products.ProductQuantity, " strQuery = strQuery & "Products.ProductRetailPrice, Products.ProductWholesalePrice1to50, Products.ProductWholesalePrice51to100, Products.ProductWholesalePrice100plus, " strQuery = strQuery & "Products.ProductNewQuantity, Products.ProductNewPrice, Products.ProductRefurbQuantity, Products.ProductRefurbPrice, Products.ProductTestedQuantity, Products.ProductTestedPrice, " strQuery = strQuery & "Products.ProductUntestedQuantity, Products.ProductUntestedPrice, Products.ProductAsisQuantity, Products.ProductAsisPrice, Products.ProductProtocol, " strQuery = strQuery & "[Product Manufacturers].ProductManufacturerName, [Product Categories].ProductCategoryName, Products.ProductBaseProductID , [tblProductCarriers].ProductCarrierName, Products.ImageLink, Products.ProductDescription " strQuery = strQuery & "FROM ((Products INNER JOIN [Product Categories] ON Products.ProductCategoryID = [Product Categories].ProductCategoryID) INNER JOIN [Product Manufacturers] ON Products.ProductManufacturerID = [Product Manufacturers].ProductManufacturerID) INNER JOIN [tblProductCarriers] ON Products.ProductCarrierID = tblProductCarriers.ProductCarrierID" if len(strCriteria) > 0 then strQuery = strQuery & " WHERE (" & strCriteria & ") AND (Products.ProductQuantity > 0)" else strQuery = strQuery & " WHERE Products.ProductCategoryID = 2 AND (Products.ProductQuantity > 0)" end if strQuery = strQuery & " ORDER BY Products.ProductManufacturerID, Products.ProductName" ' Get products from database Set rst = OBJdbConn.Execute(strQuery) if rst.EOF then Response.Write "

There are no products available in this category.

" ' Response.Write "

(" & strQuery & ")

" & CrLf else Response.Write "" & CrLf if intView = 2 then Response.Write "" & CrLf end if tableloop = 0 cellpercentage = int(100 / cellcount) rst.MoveFirst while not rst.EOF if tableloop = cellcount then Response.Write "" & CrLf tableloop = 0 end if if tableloop = 0 then tableloop = 1 Response.Write "" & CrLf else tableloop = tableloop + 1 end if Response.Write "" & CrLf Response.Write "" Response.Write "" if intView = 1 then Response.Write "" else ' Table view Response.Write "" Response.Write "" if rst.Fields("ProductQuantity") <= 0 then Response.Write "" else Response.Write "" end if if rst.Fields("ProductWholesalePrice1to50") > 0 then Response.Write "" else Response.Write "" Response.Write "" end if if len(rst.Fields("ProductProtocol")) > 0 then Response.Write "" else Response.Write "" end if Response.Write "" Response.Write "" tableloop = cellcount end if Response.Write "" rst.MoveNext wend Response.Write "
 Item DescriptionQuantityPriceProtocolCarrierManufacturer
" & CrLf Response.Write "" & CrLf Response.Write "" Response.Write "" if len(rst.Fields("ProductProtocol")) > 0 then Response.Write "" end if Response.Write "" Response.Write "
Carrier:" & rst.Fields("ProductCarrierName") & "
Manufacturer:" & rst.Fields("ProductManufacturerName") & "
Protocol:" & rst.Fields("ProductProtocol") & "
Name:" + rst.Fields("ProductName") + "
" & CrLf if rst.Fields("ImageLink") <> "/" then Response.Write "" & CrLf else Response.Write "" & CrLf end if Response.Write "" & rst.Fields("ProductName") & "" & CrLf Response.Write "
(Click on picture to enlarge)
" & CrLf ' Response.Write "Product Description
" & CrLf ' Response.Write "Click here for Parts & Accessories
" & CrLf if strRetailPrice = "Y" then if rst.Fields("ProductRetailPrice") = 0 then Response.Write "Retail Price: $(Call)
" Response.Write "" else Response.Write "Retail Price: " & FormatPrice(rst.Fields("ProductRetailPrice")) & "
" & CrLf Response.Write "" end if end if if strWholesalePrice = "Y" then intWholesalePriceBreaks = 0 Response.Write "Wholesale Price:" Response.Write "" if rst.Fields("ProductWholesalePrice100plus") > 0 then intWholesalePriceBreaks = intWholesalePriceBreaks + 1 Response.Write "" & CrLf Response.Write "" else Response.Write "" end if if rst.Fields("ProductWholesalePrice51to100") > 0 then intWholesalePriceBreaks = intWholesalePriceBreaks + 1 Response.Write "" Response.Write "" & CrLf else Response.Write "" end if if rst.Fields("ProductWholesalePrice1to50") > 0 then if intWholesalePriceBreaks > 0 then Response.Write "" & CrLf else Response.Write "" & CrLf end if else Response.Write "" & CrLf Response.Write "" end if Response.Write "
100+" & FormatPrice(rst.Fields("ProductWholesalePrice100plus")) & "
51-100" & FormatPrice(rst.Fields("ProductWholesalePrice51to100")) & "
1-50" & FormatPrice(rst.Fields("ProductWholesalePrice1to50")) & "
" & FormatPrice(rst.Fields("ProductWholesalePrice1to50")) & "
$(Call)
" & CrLf if rst.Fields("ProductQuantity") <= 0 then Response.Write "Quantity On Hand: (Call for Availability)" & CrLf else Response.Write "Quantity On Hand: " & rst.Fields("ProductQuantity") & CrLf end if ' Pricing by condition lngTotalQuantity = rst.Fields("ProductNewQuantity") + rst.Fields("ProductRefurbQuantity") + rst.Fields("ProductTestedQuantity") + rst.Fields("ProductUntestedQuantity") + rst.Fields("ProductAsisQuantity") if lngTotalQuantity > 0 then Response.Write "" & CrLf Response.Write "" & CrLf if rst.Fields("ProductNewQuantity") > 0 then Response.Write "" & CrLf end if if rst.Fields("ProductRefurbQuantity") > 0 then Response.Write "" & CrLf end if if rst.Fields("ProductTestedQuantity") > 0 then Response.Write "" & CrLf end if if rst.Fields("ProductUntestedQuantity") > 0 then Response.Write "" & CrLf end if if rst.Fields("ProductAsisQuantity") > 0 then Response.Write "" & CrLf end if Response.Write "
Price by Condition:
New" & rst.Fields("ProductNewQuantity") & "" & FormatPrice(rst.Fields("ProductNewPrice")) & "
Refurb" & rst.Fields("ProductRefurbQuantity") & "" & FormatPrice(rst.Fields("ProductRefurbPrice")) & "
Tested" & rst.Fields("ProductTestedQuantity") & "" & FormatPrice(rst.Fields("ProductTestedPrice")) & "
Untested" & rst.Fields("ProductUntestedQuantity") & "" & FormatPrice(rst.Fields("ProductUntestedPrice")) & "
As Is" & rst.Fields("ProductAsisQuantity") & "" & FormatPrice(rst.Fields("ProductAsisPrice")) & "
" & CrLf end if end if Response.Write "

" Response.Write "
" + rst.Fields("ProductName") + "(Call for Availability)" & rst.Fields("ProductQuantity") & "" & FormatPrice(rst.Fields("ProductWholesalePrice1to50")) & "$(Call)" & rst.Fields("ProductProtocol") & " " & rst.Fields("ProductCarrierName") & "" & rst.Fields("ProductManufacturerName") & "
" end if ' Close and clean up rst.close set rst = nothing OBJdbConn.close set OBJdbConn = nothing end function function AddNewManufacturer() Dim rstManufacturers Dim strQuery Dim lngManufacturerID Dim lngTemp Dim OBJdbConn ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize values lngManufacturerID = 0 ' Instantiate a Recordset object and open a recordset using the Open method strQuery = "SELECT ProductManufacturerID FROM [Product Manufacturers] ORDER BY ProductManufacturerID DESC;" Set rstManufacturers = OBJdbConn.Execute(strQuery) if rstManufacturers.eof then lngManufacturerID = 1 else lngManufacturerID = rstManufacturers("ProductManufacturerID") + 1 end if rstManufacturers.close set rstManufacturers = nothing ' Create insert command ' strQuery = "INSERT INTO [Product Manufacturers] (ProductManufacturerID, ProductManufacturerName, ProductManufacturerWebsite) VALUES (" strQuery = "INSERT INTO [Product Manufacturers] (ProductManufacturerName, ProductManufacturerWebsite) VALUES (" ' strQuery = strQuery & lngManufacturerID & " , " strQuery = strQuery & "'" & Upload.Form("NewManufacturerName") & "'" strQuery = strQuery & " , '" & Upload.Form("NewManufacturerWebsite") & "'" strQuery = strQuery & ")" ' Insert the new record Set rstManufacturers = OBJdbConn.Execute(strQuery) ' Close and clean up set rstManufacturers = nothing OBJdbConn.close set OBJdbConn = nothing end function function ShowSearchBox() Dim strQuery Dim strTemp Dim strPreselected Dim lngCount Dim lngTemp Dim intLoop Dim OBJdbConn ' Search Box Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf ' Determine preselected technology if Instr(strCriteria,"((UPPER(Products.ProductProtocol) LIKE '%") = 0 then strPreselected = "GSM" else intLoop = instr(strCriteria,"((UPPER(Products.ProductProtocol) LIKE '%")+41 strTemp = "" while ((intLoop <= len(strCriteria)) and (mid(strCriteria,intLoop,1) <> "'") and (mid(strCriteria,intLoop,1) <> "%")) strTemp = strTemp & mid(strCriteria,intLoop,1) intLoop = intLoop + 1 wend strPreselected = strTemp end if ' Select a technology Response.Write "" & Crlf ' End the search by selectopm form Response.Write "" & CrLf Response.Write "" & CrLf ' Search by text form Response.Write "" & CrLf Response.Write "" & CrLf ' Select a manufacturer Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf ' End of search box Response.Write "
Protocol" & CrLf Response.Write "" & Crlf ' Select a product category Response.Write "Category" & CrLf ListProductCategories 4 Response.Write "" & Crlf ' Select a manufacturer Response.Write "Manufacturer" & CrLf GetManufacturerID "",2 Response.Write "" & Crlf ' Select a carrier Response.Write "Carrier" & CrLf GetCarrierID "",2 Response.Write "
Search Text:" & CrLf ' End the search by selectopm form Response.Write "
" & CrLf Response.Write "
" & CrLf end function function MakeSearchCriteria() Dim strProductProtocol, strProductCategoryID, strManufacturerID, strCarrierID if flagUpload = 1 then strProductProtocol = UCASE(Upload.Form("ProductProtocol")) strProductCategoryID = Upload.Form("ProductCategoryID") strManufacturerID = Upload.Form("ManufacturerID") strCarrierID = Upload.Form("CarrierID") else strProductProtocol = UCASE(Request("ProductProtocol")) strProductCategoryID = Request("ProductCategoryID") strManufacturerID = Request("ManufacturerID") strCarrierID = Request("CarrierID") end if if (strCommand = "SearchProductsByText") then if flagUpload = 1 then strCriteria = "(UPPER(Products.ProductName) LIKE '%" & Ucase(Upload.Form("SearchText")) & "%')" else strCriteria = "(UPPER(Products.ProductName) LIKE '%" & Ucase(Request("SearchText")) & "%')" end if else ' if (strCommand = "SearchProductsBySelection") then strCriteria = "((UPPER(Products.ProductProtocol) LIKE '%" & strProductProtocol & "%')" if len(strProductCategoryID) > 0 then strCriteria = strCriteria & " AND (Products.ProductCategoryID=" & strProductCategoryID & ")" end if if len(strManufacturerID) > 0 then strCriteria = strCriteria & " AND (Products.ProductManufacturerID=" & strManufacturerID & ")" end if if len(strCarrierID) > 0 then strCriteria = strCriteria & " AND (Products.ProductCarrierID=" & strCarrierID & ")" end if strCriteria = strCriteria & ")" ' emd if end if Session("criteria") = strCriteria end function function ShowMenu() ' Show our header ' Log window function Response.Write "" & CrLf Response.Write "

Product Management System Web Administration v1.0

" & CrLf Response.Write "View Log" & CrLf Response.Write "Last Log Entry:" & Session("LogStringLast") & "
" & CrLf Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf ' Import products Response.Write "" & CrLf ' Import Product V2 MicroTelecom Response.Write "" & CrLf ' Add new manufacturer Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "
Product Management System - Main Menu

" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "Select Product Category: " ListProductCategories 0 Response.Write "
" Response.Write "Select Carrier: " GetCarrierID "",2 Response.Write "
" Response.Write "Inventory file: 
" & CrLf Response.Write "" & CrLf Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "Inventory file: 
" & CrLf Response.Write "" & CrLf Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "Enter New Manufacturer Name: " Response.Write "
" & CrLf Response.Write "Enter New Manufacturer Website: " Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "
" & CrLf end function function AddToShoppingCart() Dim lngTemp Dim lngQuantity Dim fltTemp if len(Upload.Form("OrderQuantity")) > 0 then ' increment item count if len(Session("ShoppingCartItems")) < 1 then lngTemp = 1 else lngTemp = CLng(Session("ShoppingCartItems")) + 1 end if Session("ShoppingCartItems") = lngTemp ' Add item to session Session("ShoppingCartProductID" & lngTemp) = Upload.Form("ProductID") Session("ShoppingCartProductName" & lngTemp) = Upload.Form("ProductName") lngQuantity = CLng(Upload.Form("OrderQuantity")) if lngQuantity > GetProductID(Session("ShoppingCartProductID" & lngTemp),12) then Response.Write "

We may not be able to process the quantity you requested. Please contact celltech for availability of this item.

" & CrLf lngTemp = lngTemp - 1 Session("ShoppingCartItems") = lngTemp else Session("ShoppingCartProductQuantity" & lngTemp) = lngQuantity if Session("wholesaleprice") = "Y" then if lngQuantity > 100 then fltTemp = GetProductID(Upload.Form("ProductID"),53) if fltTemp = 0 then Response.Write "

Please call celltech for pricing at this quantity and to order this item.

" & CrLf lngTemp = lngTemp - 1 Session("ShoppingCartItems") = lngTemp else Session("ShoppingCartProductPrice" & lngTemp) = fltTemp end if else if lngQuantity > 50 then fltTemp = GetProductID(Upload.Form("ProductID"),52) if fltTemp = 0 then Response.Write "

Please call celltech for pricing at this quantity and to order this item.

" & CrLf lngTemp = lngTemp - 1 Session("ShoppingCartItems") = lngTemp else Session("ShoppingCartProductPrice" & lngTemp) = fltTemp end if else fltTemp = GetProductID(Upload.Form("ProductID"),51) if fltTemp = 0 then Response.Write "

Please call celltech for pricing at this quantity and to order this item.

" & CrLf lngTemp = lngTemp - 1 Session("ShoppingCartItems") = lngTemp else Session("ShoppingCartProductPrice" & lngTemp) = fltTemp end if end if end if else fltTemp = GetProductID(Upload.Form("ProductID"),54) if fltTemp = 0 then Response.Write "

Product pricing for this item is not available on-line. Please contact celltech for pricing on this item.

" & CrLf lngTemp = lngTemp - 1 Session("ShoppingCartItems") = lngTemp else Session("ShoppingCartProductPrice" & lngTemp) = fltTemp end if end if end if end if end function function DeleteItem(lngProductID) Dim rstProducts Dim strQuery Dim OBJdbConn ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Instantiate a Recordset object and open a recordset using the Open method strQuery = "DELETE FROM Products WHERE ProductID = " & lngProductID Set rstProducts = OBJdbConn.Execute(strQuery) set rstProducts = nothing Response.Write "

Product deleted.

" & CrLf end function function CheckCartForLiberty() Dim lngTemp Dim intLibertyFlag ' Add items to order products if len(Session("ShoppingCartItems")) < 1 then CheckCartForLiberty = 0 else lngTemp = CLng(Session("ShoppingCartItems")) while lngTemp > 0 ' Check liberty flag if ((CLng(Session("ShoppingCartProductID" & lngTemp)) >= 1) and (CLng(Session("ShoppingCartProductID" & lngTemp)) <= 10)) then intLibertyFlag = 1 end if ' Next item lngTemp = lngTemp - 1 wend end if if intLibertyFlag = 1 then CheckCartForLiberty = 1 else CheckCartForLiberty = 0 end if end function function CheckOut() Dim rstOrders Dim strQuery Dim lngOrderID Dim lngTemp Dim fltTemp Dim fltOrderTotal Dim lngQuantityTotal Dim OBJdbConn Dim Mail Dim strTemp Dim dtOrderDate Dim lngQuantity Dim intLibertyFlag if len(Session("WholesalerID")) < 1 then Response.Write "

Please login to check out your wholesaler order.

" & CrLf else if CLng(Session("WholesalerID")) < 1 then Response.Write "

Please login to check out your wholesaler order.

" & CrLf else if len(session("activated")) < 1 then session("activated") = "0" end if ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize values lngOrderID = 0 lngQuantityTotal = 0 fltOrderTotal = 0.00 intLibertyFlag = 0 ' Instantiate a Recordset object and open a recordset using the Open method strQuery = "SELECT OrderID FROM tblOrders ORDER BY OrderID DESC;" Set rstOrders = OBJdbConn.Execute(strQuery) if rstOrders.eof then lngOrderID = 1 else lngOrderID = rstOrders("OrderID") + 1 end if rstOrders.close set rstOrders = nothing ' Header info dtOrderDate = now() strTemp = "" & CrLf strTemp = strTemp & "" & CrLf ' Add items to order products if len(Session("ShoppingCartItems")) < 1 then lngTemp = 0 Response.Write "

Your order is empty.

" & CrLf else lngTemp = CLng(Session("ShoppingCartItems")) while lngTemp > 0 ' Show Order Details strTemp = strTemp & "" & CrLf strTemp = strTemp & "" & CrLf strTemp = strTemp & "" & CrLf lngQuantityTotal = lngQuantityTotal + CLng(Session("ShoppingCartProductQuantity" & lngTemp)) fltTemp = CLng(Session("ShoppingCartProductQuantity" & lngTemp)) * CDbl(Session("ShoppingCartProductPrice" & lngTemp)) fltOrderTotal = fltOrderTotal + fltTemp strTemp = strTemp & "" & CrLf ' Create insert command strQuery = "INSERT INTO tblOrderProducts (OrderID, ProductID, Quantity, Price) VALUES (" strQuery = strQuery & lngOrderID & " , " strQuery = strQuery & Session("ShoppingCartProductID" & lngTemp) & " , " strQuery = strQuery & Session("ShoppingCartProductQuantity" & lngTemp) & " , " strQuery = strQuery & Session("ShoppingCartProductPrice" & lngTemp) strQuery = strQuery & ")" ' Insert the new record Set rstOrders = OBJdbConn.Execute(strQuery) set rstOrders = nothing ' Update product quantity lngQuantity = Session("ShoppingCartProductQuantity" & lngTemp) if lngQuantity > GetProductID(Session("ShoppingCartProductID" & lngTemp),12) then lngQuantity = GetProductID(Session("ShoppingCartProductID" & lngTemp),12) end if strQuery = "UPDATE Products SET ProductQuantity = ProductQuantity - " & lngQuantity & " WHERE ProductID = " & Session("ShoppingCartProductID" & lngTemp) Set rstOrders = OBJdbConn.Execute(strQuery) set rstOrders = nothing ' Check liberty flag if ((CLng(Session("ShoppingCartProductID" & lngTemp)) >= 1) and (CLng(Session("ShoppingCartProductID" & lngTemp)) <= 10)) then intLibertyFlag = 1 end if ' Next item lngTemp = lngTemp - 1 wend ' Create insert command strQuery = "INSERT INTO tblOrders (OrderID, OrderDate, OrderTotal, WholesalerID, Activated, Zipcode) VALUES (" strQuery = strQuery & lngOrderID & " , " strQuery = strQuery & "'" & dtOrderDate & "'," strQuery = strQuery & fltOrderTotal & "," strQuery = strQuery & Session("WholesalerID") & "," strQuery = strQuery & Session("activated") & "," strQuery = strQuery & "'" & Session("zipcode") & "'" strQuery = strQuery & ")" ' Insert the new record Set rstOrders = OBJdbConn.Execute(strQuery) ' Show the total of the order strTemp = strTemp & "" & CrLf strTemp = strTemp & "" & CrLf ' Check if any liberty items if intLibertyFlag = 1 then if Upload.Form("activated") = 0 then strTemp = strTemp & "" & CrLf else strTemp = strTemp & "" & CrLf end if end if strTemp = strTemp & "
Wholesaler:" & Session("WholesalerCompanyName") & ", Order ID:" & lngOrderID & " , Date:" & dtOrderDate & "
Quantity
Item
Price
Extended Price
" & Session("ShoppingCartProductQuantity" & lngTemp) & "" & Session("ShoppingCartProductName" & lngTemp) & "" & FormatPrice(Session("ShoppingCartProductPrice" & lngTemp)) & "" & FormatPrice(fltTemp) & "

" & lngQuantityTotal & "Order Total" & FormatPrice(fltOrderTotal) & "
Phones are to be NOT ACTIVATED , Zipcode:" & Upload.Form("zipcode") & "
Phones are to be ACTIVATED , Zipcode:" & Upload.Form("zipcode") & "
" & CrLf ' Close and clean up set rstOrders = nothing ' Email the order Set Mail = Server.CreateObject("Persits.MailSender") Mail.From = "WebserverEmail@playboard.com" Mail.FromName = "WebserverEmail" Mail.AddAddress "ziad@celltechs.net" Mail.Subject = "Website Order#" & lngOrderID & " - www.celltechs.net" Mail.IsHTML = true Mail.Body = "" & "Website Order#" & lngOrderID & " - www.celltechs.net" & "" & strTemp & "" Mail.Queue = True On Error Resume Next Mail.Send If Err.Number <> 0 then Response.Write "Unable to send erder email...Please contact website administrator (Err.Number = " & Err.Number & ")" end if on error goto 0 Set Mail = nothing ' Show the order data Response.Write strTemp Response.Write "

Your order has been sent to Celltech for processing. Please allow 48-72 hours for processing.

" & CrLf end if OBJdbConn.close set OBJdbConn = nothing ' Empty their cart to start fresh EmptyCart end if end if end function function CheckOutRetail() Dim rstOrders Dim strQuery Dim lngOrderID Dim lngTemp Dim fltTemp Dim fltOrderTotal Dim lngQuantityTotal Dim OBJdbConn Dim Mail Dim strTemp Dim dtOrderDate Dim lngQuantity Dim intLibertyFlag ' Create and open connection object Set OBJdbConn = Server.CreateObject("ADODB.Connection") OBJdbConn.Mode = adModeShareDenyNone OBJdbConn.Open strDatabaseDSN ' Initialize values lngOrderID = 0 lngQuantityTotal = 0 fltOrderTotal = 0.00 intLibertyFlag = 0 ' Instantiate a Recordset object and open a recordset using the Open method strQuery = "SELECT OrderID FROM tblOrders ORDER BY OrderID DESC;" Set rstOrders = OBJdbConn.Execute(strQuery) if rstOrders.eof then lngOrderID = 1 else lngOrderID = rstOrders("OrderID") + 1 end if rstOrders.close set rstOrders = nothing ' Header info dtOrderDate = now() strTemp = "" & CrLf strTemp = strTemp & "" & CrLf ' Add items to order products if len(Session("ShoppingCartItems")) < 1 then lngTemp = 0 Response.Write "

Your order is empty.

" & CrLf else lngTemp = CLng(Session("ShoppingCartItems")) while lngTemp > 0 ' Show Order Details strTemp = strTemp & "" & CrLf strTemp = strTemp & "" & CrLf strTemp = strTemp & "" & CrLf lngQuantityTotal = lngQuantityTotal + CLng(Session("ShoppingCartProductQuantity" & lngTemp)) fltTemp = CLng(Session("ShoppingCartProductQuantity" & lngTemp)) * CDbl(Session("ShoppingCartProductPrice" & lngTemp)) fltOrderTotal = fltOrderTotal + fltTemp strTemp = strTemp & "" & CrLf ' Create insert command strQuery = "INSERT INTO tblOrderProducts (OrderID, ProductID, Quantity, Price) VALUES (" strQuery = strQuery & lngOrderID & " , " strQuery = strQuery & Session("ShoppingCartProductID" & lngTemp) & " , " strQuery = strQuery & Session("ShoppingCartProductQuantity" & lngTemp) & " , " strQuery = strQuery & Session("ShoppingCartProductPrice" & lngTemp) strQuery = strQuery & ")" ' Insert the new record Set rstOrders = OBJdbConn.Execute(strQuery) set rstOrders = nothing ' Update product quantity lngQuantity = Session("ShoppingCartProductQuantity" & lngTemp) if lngQuantity > GetProductID(Session("ShoppingCartProductID" & lngTemp),12) then lngQuantity = GetProductID(Session("ShoppingCartProductID" & lngTemp),12) end if strQuery = "UPDATE Products SET ProductQuantity = ProductQuantity - " & lngQuantity & " WHERE ProductID = " & Session("ShoppingCartProductID" & lngTemp) Set rstOrders = OBJdbConn.Execute(strQuery) set rstOrders = nothing ' Check liberty flag if ((CLng(Session("ShoppingCartProductID" & lngTemp)) >= 1) and (CLng(Session("ShoppingCartProductID" & lngTemp)) <= 10)) then intLibertyFlag = 1 end if ' Next item lngTemp = lngTemp - 1 wend ' Create insert command strQuery = "INSERT INTO tblOrders (OrderID, OrderDate, OrderTotal, WholesalerID, Activated, Zipcode) VALUES (" strQuery = strQuery & lngOrderID & " , " strQuery = strQuery & "'" & dtOrderDate & "'," strQuery = strQuery & fltOrderTotal & "," strQuery = strQuery & "0," strQuery = strQuery & "0," strQuery = strQuery & "'" & Session("zipcode") & "'" strQuery = strQuery & ")" ' Insert the new record Set rstOrders = OBJdbConn.Execute(strQuery) ' Show the total of the order strTemp = strTemp & "" & CrLf strTemp = strTemp & "" & CrLf strTemp = strTemp & "
Wholesaler:" & Session("WholesalerCompanyName") & ", Order ID:" & lngOrderID & " , Date:" & dtOrderDate & "
Quantity
Item
Price
Extended Price
" & Session("ShoppingCartProductQuantity" & lngTemp) & "" & Session("ShoppingCartProductName" & lngTemp) & "" & FormatPrice(Session("ShoppingCartProductPrice" & lngTemp)) & "" & FormatPrice(fltTemp) & "

" & lngQuantityTotal & "Order Sub-Total" & FormatPrice(fltOrderTotal) & "
" & CrLf ' Close and clean up set rstOrders = nothing ' Email the order Set Mail = Server.CreateObject("Persits.MailSender") Mail.From = "WebserverEmail@playboard.com" Mail.FromName = "WebserverEmail" Mail.AddAddress "ziad@celltechs.net" Mail.Subject = "Website Retail Order#" & lngOrderID & " - www.celltechs.net" Mail.IsHTML = true Mail.Body = "" & "Website Retail Order#" & lngOrderID & " - www.celltechs.net" & "" & strTemp & "" Mail.Queue = True On Error Resume Next Mail.Send If Err.Number <> 0 then Response.Write "Unable to send erder email...Please contact website administrator (Err.Number = " & Err.Number & ")" end if on error goto 0 Set Mail = nothing ' Show the order data Response.Write strTemp Response.Write "

Your order is being sent to Celltech's payment processor. Please wait while you are transferred to make payment for your order.

" & CrLf ' Create the paypal form Response.Write "
" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf lngTemp = CLng(Session("ShoppingCartItems")) while lngTemp > 0 ' Add items to paypal form Response.Write "" & CrLf fltTemp = CLng(Session("ShoppingCartProductQuantity" & lngTemp)) * CDbl(Session("ShoppingCartProductPrice" & lngTemp)) Response.Write "" & CrLf ' Next item lngTemp = lngTemp - 1 wend ' Finish the paypal form Response.Write "" & CrLf Response.Write "
" & CrLf Response.Write "" & CrLf end if OBJdbConn.close set OBJdbConn = nothing ' Empty their cart to start fresh EmptyCart end function function EmptyCart() Session("ShoppingCartItems") = "" end function function ShowShoppingCart Dim lngTemp Dim fltOrderTotal Dim fltTemp Dim lngQtyTotal Dim intLibertyFlag intLibertyFlag = 0 if len(Session("ShoppingCartItems")) < 1 then lngTemp = 0 else Response.Write "" & CrLf Response.Write "" & CrLf lngTemp = CLng(Session("ShoppingCartItems")) fltOrderTotal = 0.00 lngQtyTotal = 0 while lngTemp > 0 ' Show Order Details Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf fltTemp = CLng(Session("ShoppingCartProductQuantity" & lngTemp)) * CDbl(Session("ShoppingCartProductPrice" & lngTemp)) fltOrderTotal = fltOrderTotal + fltTemp lngQtyTotal = lngQtyTotal + CLng(Session("ShoppingCartProductQuantity" & lngTemp)) Response.Write "" & CrLf ' Check liberty flag if ((CLng(Session("ShoppingCartProductID" & lngTemp)) >= 1) and (CLng(Session("ShoppingCartProductID" & lngTemp)) <= 10)) then intLibertyFlag = 1 end if ' Next item lngTemp = lngTemp - 1 wend Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "
Shopping Cart
Quantity
Name
Price
Extended Price
" & Session("ShoppingCartProductQuantity" & lngTemp) & "" & Session("ShoppingCartProductName" & lngTemp) & "" & FormatPrice(Session("ShoppingCartProductPrice" & lngTemp)) & "" & FormatPrice(fltTemp) & "

" & lngQtyTotal & "Total" & FormatPrice(fltOrderTotal) & "
" ' Check for liberty item activation if intLibertyFlag = 1 then Response.Write "Activated: Zipcode:
" end if Response.Write "
" & CrLf end if end function ' Show our header PrintPageHeader Response.Write "" & CrLf Dim flagMenu If ((Session("WholesalerUsername") = strAdminUsername) And (Session("WholesalerPassword") = strAdminPassword)) Then flagMenu = 1 lngAccessLevel = 1 else lngAccessLevel = 0 flagMenu = 0 end if ' Main menu code if len(strCommand) > 0 then ' BrowseTitles command if ((strCommand = "UploadInventoryFile") and (CLng(lngAccessLevel) >= 1)) then UploadInventoryFile else if ((strCommand = "AddNewManufacturer") and (CLng(lngAccessLevel) >= 1)) then if len(Upload.Form("NewManufacturerName")) = 0 then Response.Write "

You must enter a name for the new manufacturer ... Press BACK on your browser and try again.

" & CrLf else if len(Upload.Form("NewManufacturerWebsite")) = 0 then Response.Write "

You must enter a website for the new manufacturer or enter n/a or none ... Press BACK on your browser and try again.

" & CrLf else AddNewManufacturer end if end if else if ((strCommand = "MaintainItems") and (CLng(lngAccessLevel) >= 1)) then MaintainItems else if strCommand = "ExitSystem" then Response.Redirect "http://www.celltechs.net" else if strCommand = "Login" then if flagUpload = 1 then VerifyWholesalerUsernamePassword Upload.Form("Username"), Upload.Form("Password"), 1 If Session("returnflag") = 0 Then Response.Redirect strScriptURL & "?command=" & Upload.Form("nextcommand") Else Session("WholesalerID") = "" Response.Write("

Your username and password do not exist in the system , please try again or press the new wholesaler button

" & CrLf) End If else Response.Write("" & CrLf) Response.Write("

Please enter your username and password and press Login button, if you do not have a username and password, click the New Wholesaler button

" & CrLf) Response.Write("
" & CrLf) Response.Write("" & CrLf) Response.Write("

Username:

" & CrLf) Response.Write("

Password:

" & CrLf) Response.Write("" & CrLf) Response.Write("" & CrLf) Response.Write(" " & CrLf) Response.Write(" " & CrLf) Response.Write("" & CrLf) Response.Write("
" & CrLf) Response.Write("" & CrLf) end if else if strCommand = "SelectProductCategory" then flagMenu = 0 else if ((strCommand = "SearchProductsBySelection") or (strCommand = "SearchProductsByText")) then MakeSearchCriteria else if (strCommand = "AddToShoppingCart") then AddToShoppingCart else if (strCommand = "CheckOut") then if flagUpload = 1 then if len(Upload.Form("activated")) > 0 then Session("activated") = Upload.Form("activated") Session("zipcode") = Upload.Form("zipcode") end if end if flagTemp = 0 ' Wholesale checkout if len(Session("WholesalerID")) > 0 then if CLng(Session("WholesalerID")) > 0 then flagTemp = 1 if CheckCartForLiberty() = 1 then if len(Session("activated")) > 0 then if len(Session("zipcode")) > 0 then CheckOut else Response.Write "

Please specify activated or not activated, and a zipcode.

" & CrLf end if else Response.Write "

Please specify activated or not activated, and a zipcode.

" & CrLf end if else CheckOut end if end if end if ' Retail checkout if flagTemp = 0 then CheckOutRetail ' Response.Write("

Retail checkout unavailable ... Coming Soon ... Please contact Celltech at (216) 587-2000 to purchase items.

" & CrLf) end if else if (strCommand = "EmptyCart") then EmptyCart else if ((strCommand = "DeleteItem") and (CLng(lngAccessLevel) >= 1)) then if CLng(Upload.Form("ProductID")) > 0 then DeleteItem Upload.Form("ProductID") end if else if ((strCommand = "UploadInventoryFileV2") and (CLng(lngAccessLevel) >= 1)) then UploadInventoryFileV2 else if ((strCommand = "UpdatePercentages") and (CLng(lngAccessLevel) >= 1)) then UpdatePercentages else if ((strCommand = "SwitchViewTable") and (CLng(lngAccessLevel) >= 1)) then Session("intView") = 2 else if ((strCommand = "SwitchViewPhotos") and (CLng(lngAccessLevel) >= 1)) then Session("intView") = 1 else ' Invalid command Response.Write "

Invalid or unauthorized command (" & strCommand & ")

" end if end if end if end if end if end if end if end if end if end if end if end if end if end if end if end if 'if flagMenu = 0 then ' Deal with speed issue for now if Session("PageViewed") <> "Y" then Session("PageViewed") = "Y" if strCommand = "" then strCommand = "SelectProductCategory" end if end if if strCommand <> "Login" then ' One large table to cover entire screen under header Response.Write "" & CrLf Response.Write "" & CrLf if len(Session("WholesalerID")) > 0 then if CLng(Session("WholesalerID")) > 0 then Response.Write "" & CrLf Response.Write "" & CrLf Response.Write "" & CrLf else Response.Write "" & CrLf end if else Response.Write "" & CrLf end if ' Show product categories on left side of table Response.Write " " & CrLf ShowShoppingCart Response.Write " " & CrLf Response.Write "
Product Pricing and Quantity Updated Daily
ALL WHOLESALE ORDERS MUST BE PAID BY WIRE TRANSFER. NO EXCEPTIONS. Wire Information

COMPANY NAME:CELLTECHS WIRELESS
COMPANY ADDRESS:4611 WARRENSVILLE CENTER RD.
NORTH RANDALL, OHIO 44137
BANK NAME:NATIONAL CITY BANK
BANK ADDRESS:NORTH RANDALL, OHIO 44128
ROUTING NUMBER:041000124
ACCOUNT NUMBER:985174477

Please call Celltech at (216) 587-2000 for any questions. Thank you.

'); return false;" & chr(34) & ">(click here for wire information)
Pricing: Wholesale
" & CrLf if Session("intView") = 1 then Response.Write "
" & CrLf else Response.Write "
" & CrLf end if Response.Write "
Pricing: Retail
Pricing: Retail
" & CrLf ShowSearchBox Response.Write "
" & CrLf if len(Session("WholesalerID")) > 0 then if CLng(Session("WholesalerID")) > 0 then if Session("intView") = 1 then ShowProducts Session("retailprice"),Session("wholesaleprice"),1 else ShowProducts Session("retailprice"),Session("wholesaleprice"),2 end if else ShowProducts Session("retailprice"),Session("wholesaleprice"),1 end if else ShowProducts Session("retailprice"),Session("wholesaleprice"),1 end if Response.Write "
" & CrLf end if 'else if CLng(lngAccessLevel) >= 1 then ShowMenu end if 'end if PrintPageFooter %>