Line 1: Imports Microsoft.VisualBasic
Line 2: Imports System.Security.Cryptography
Line 3: Imports System.Security.Cryptography.Xml
Line 4: Imports System.Xml
Line 5: Imports System.Collections.Generic
Line 6: Imports System.Drawing
Line 7: Imports ASIRemoteServiceProxy
Line 8: 'Imports System.Web.Mail
Line 9: Imports System.Net.Mail
Line 10: Imports System.Security.AccessControl
Line 11: Imports System.IO
Line 12: Imports PayPal.Payments.Common
Line 13: Imports PayPal.Payments.Common.Utility
Line 14: Imports PayPal.Payments.Communication
Line 15: Imports PayPal.Payments.DataObjects
Line 16: Imports PayPal.Payments.Transactions
Line 17: Imports com.paypal.sdk.services
Line 18: Imports com.paypal.sdk.profiles
Line 19: Imports com.paypal.sdk.util
Line 20: Imports System.Net
Line 21: Imports WebApiAccessor
Line 22: Imports MainDataModel.Models
Line 23: Imports System.Diagnostics
Line 24: Imports PerceptiveMCAPI.Types
Line 25: Imports PerceptiveMCAPI.Methods
Line 26: Imports PerceptiveMCAPI
Line 27: Imports FedexRateService
Line 28: Imports System.Globalization
Line 29:
Line 30: Public Class functions
Line 31: Inherits System.Web.UI.Page
Line 32: Dim r1 As System.Web.HttpContext = System.Web.HttpContext.Current
Line 33:
Line 34:
Line 35: Function getcomname() As String
Line 36:
Line 37: Return "asiec5.object"
Line 38:
Line 39: End Function
Line 40:
Line 41:
Line 42: Function VerifyPath(ByVal myPath As String) As Boolean
Line 43: Dim isValid As Boolean = False
Line 44: Try
Line 45: If IO.Directory.Exists(myPath) Then
Line 46: isValid = True
Line 47: End If
Line 48: Catch ex As Exception
Line 49: isValid = False
Line 50: End Try
Line 51:
Line 52: Return isValid
Line 53: End Function
Line 54:
Line 55: Function VerifyFile(ByVal myFile As String) As Boolean
Line 56: Dim isValid As Boolean = False
Line 57: If File.Exists(myFile) Then
Line 58: isValid = True
Line 59: End If
Line 60: Return isValid
Line 61: End Function
Line 62: Public Function FileExists(ByVal FileFullPath As String) _
Line 63: As Boolean
Line 64:
Line 65: Dim f As New IO.FileInfo(FileFullPath)
Line 66: Return f.Exists
Line 67:
Line 68: End Function
Line 69:
Line 70: Public Function FolderExists(ByVal FolderPath As String) _
Line 71: As Boolean
Line 72:
Line 73: Dim f As New IO.DirectoryInfo(FolderPath)
Line 74: Return f.Exists
Line 75:
Line 76: End Function
Line 77:
Line 78:
Line 79: Public Function MailChimpUnSubscribe(ByVal emailaddr As String) As Boolean
Line 80:
Line 81: Dim input As listsInput = New listsInput(getxmlval("mailchimpapikey"))
Line 82: Dim cmd As lists = New lists(input)
Line 83:
Line 84: Dim output As listsOutput = cmd.Execute()
Line 85: ' format output (Assuming a User control named show_lists)
Line 86: 'show_lists1.Display(output)
Line 87:
Line 88: Dim p As New listUnsubscribeParms()
Line 89: p.apikey = getxmlval("mailchimpapikey")
Line 90: For Each lr As listsResults In output.result
Line 91: If lr.name = getxmlval("mailchimplistname") Then
Line 92: p.id = lr.id
Line 93: End If
Line 94: Next
Line 95: p.email_address = emailaddr
Line 96: p.delete_member = True
Line 97:
Line 98:
Line 99: Dim i As New listUnsubscribeInput(p)
Line 100:
Line 101: Dim s As New listUnsubscribe(i)
Line 102: Dim ls1 As listUnsubscribeOutput = s.Execute()
Line 103:
Line 104: Dim a As String = ls1.result
Line 105: If a = "True" Then
Line 106: Return True
Line 107: Else
Line 108: Return False
Line 109: End If
Line 110:
Line 111:
Line 112: End Function
Line 113: Public Function MailChimpSubscribe(ByVal emailaddr As String, firstname As String, lastname As String) As Boolean
Line 114:
Line 115: Dim input As listsInput = New listsInput(getxmlval("mailchimpapikey"))
Line 116: Dim cmd As lists = New lists(input)
Line 117:
Line 118: Dim output As listsOutput = cmd.Execute()
Line 119: ' format output (Assuming a User control named show_lists)
Line 120: 'show_lists1.Display(output)
Line 121:
Line 122: Dim p As New listSubscribeParms()
Line 123: p.apikey = getxmlval("mailchimpapikey")
Line 124: For Each lr As listsResults In output.result
Line 125: If lr.name = getxmlval("mailchimplistname") Then
Line 126: p.id = lr.id
Line 127: End If
Line 128: Next
Line 129: p.email_type = EnumValues.emailType.html
Line 130: p.email_address = emailaddr
Line 131: p.double_optin = False
Line 132:
Line 133: Dim d As New System.Collections.Generic.Dictionary(Of String, Object)
Line 134: d.Add("FNAME", firstname)
Line 135: d.Add("LNAME", lastname)
Line 136:
Line 137:
Line 138: p.merge_vars = d
Line 139:
Line 140:
Line 141: Dim i As New listSubscribeInput(p)
Line 142:
Line 143: Dim s As New listSubscribe(i)
Line 144: Dim ls1 As listSubscribeOutput = s.Execute()
Line 145:
Line 146: Dim a As String = ls1.result
Line 147: If a = "True" Then
Line 148: Return True
Line 149: Else
Line 150: Return False
Line 151: End If
Line 152:
Line 153:
Line 154: End Function
Line 155: Public Function MailChimpSubscribed(ByVal emailaddr As String) As Boolean
Line 156: Dim input As listsInput = New listsInput(getxmlval("mailchimpapikey"))
Line 157: Dim cmd As lists = New lists(input)
Line 158:
Line 159: Dim output As listsOutput = cmd.Execute()
Line 160: ' format output (Assuming a User control named show_lists)
Line 161: 'show_lists1.Display(output)
Line 162:
Line 163: Dim p As New listMemberInfoParms()
Line 164: p.apikey = getxmlval("mailchimpapikey")
Line 165: For Each lr As listsResults In output.result
Line 166: If lr.name = getxmlval("mailchimplistname") Then
Line 167: p.id = lr.id
Line 168: End If
Line 169: Next
Line 170: p.email_address = emailaddr
Line 171:
Line 172:
Line 173:
Line 174: Dim i As New listMemberInfoInput(p)
Line 175: Dim s As New listMemberInfo(i)
Line 176: Dim ls1 As listMemberInfoOutput = s.Execute()
Line 177:
Line 178: If ls1.api_ErrorMessages.Count > 0 Then
Line 179: Return False
Line 180: Else
Line 181: Return True
Line 182: End If
Line 183: Return False
Line 184:
Line 185: End Function
Line 186:
Line 187: Function checkURL(ByVal theURL As String) As Boolean
Line 188: Dim isValidURL As Boolean = False
Line 189: Dim simptheURL As String = theURL
Line 190:
Line 191: simptheURL = simptheURL.Replace("+", "ASIPLUS")
Line 192: simptheURL = simptheURL.Replace(" ", "ASISPACE")
Line 193: simptheURL = simptheURL.Replace("$", "ASIDOLLARSIGN")
Line 194: simptheURL = simptheURL.Replace("|", "ASIPIPE")
Line 195: simptheURL = simptheURL.Replace("/", "ASISLASH")
Line 196: simptheURL = simptheURL.Replace("\", "ASIBACKSLASH")
Line 197: simptheURL = simptheURL.Replace("@", "ASIAT")
Line 198: simptheURL = simptheURL.Replace("1", "ASIONE")
Line 199: simptheURL = simptheURL.Replace("2", "ASITWO")
Line 200: simptheURL = simptheURL.Replace("3", "ASITHREE")
Line 201: simptheURL = simptheURL.Replace("4", "ASIFOUR")
Line 202: simptheURL = simptheURL.Replace("5", "ASIFIVE")
Line 203: simptheURL = simptheURL.Replace("6", "ASISIX")
Line 204: simptheURL = simptheURL.Replace("7", "ASISEVEN")
Line 205: simptheURL = simptheURL.Replace("8", "ASIEIGHT")
Line 206: simptheURL = simptheURL.Replace("9", "ASININE")
Line 207: simptheURL = simptheURL.Replace("0", "ASIZERO")
Line 208:
Line 209: If simptheURL = String.Empty Then
Line 210: isValidURL = False
Line 211: ElseIf Session("checkURL" & simptheURL) Is Nothing Then
Line 212: Dim req As System.Net.HttpWebRequest
Line 213: Try
Line 214: theURL = Replace(theURL, "https://", "http://")
Line 215: req = System.Net.WebRequest.Create(theURL)
Line 216: Dim resp As System.Net.HttpWebResponse
Line 217: Dim timeout As String = getxmlval("fileexiststimeout")
Line 218:
Line 219: If timeout = String.Empty OrElse Not (IsNumeric(timeout)) OrElse InStr(timeout, ".") > 0 Then
Line 220: timeout = "1500"
Line 221: End If
Line 222:
Line 223: req.Timeout = timeout
Line 224: resp = req.GetResponse()
Line 225: isValidURL = True
Line 226:
Line 227: Catch e As System.Net.WebException
Line 228: If InStr(e.Message, "The remote server returned an error: (403) Forbidden.") > 0 Then
Line 229: isValidURL = True
Line 230: End If
Line 231:
Line 232: Catch f As Exception
Line 233: isValidURL = False
Line 234: End Try
Line 235:
Line 236: Session("checkURL" & simptheURL) = isValidURL
Line 237:
Line 238: Else
Line 239: isValidURL = Session("checkURL" & simptheURL)
Line 240: End If
Line 241:
Line 242: Return isValidURL
Line 243: End Function
Line 244:
Line 245: Sub getItemImagesPath()
Line 246: Dim itemImagesFolder As String = getxmlval("itemimg_path")
Line 247: Try
Line 248: Dim site As String = "http://" & r1.Request.ServerVariables("SERVER_NAME") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 249: Dim aspxloc As Integer = InStr(site, "aspx")
Line 250: If aspxloc > 0 Then
Line 251: site = Left(site, aspxloc - 2)
Line 252: Dim lastslash As Integer = InStrRev(site, "/")
Line 253: site = Left(site, lastslash)
Line 254: End If
Line 255: If Left(itemImagesFolder, 3) = "../" Then
Line 256: itemImagesFolder = Right(itemImagesFolder, itemImagesFolder.Length - 3)
Line 257: If Right(site, 1) = "/" Then
Line 258: site = Left(site, site.Length - 1)
Line 259: End If
Line 260: Dim lastSlash As Integer = InStrRev(site, "/")
Line 261: site = Left(site, lastSlash)
Line 262: End If
Line 263:
Line 264: site = replaceHTTPS(site)
Line 265:
Line 266: If checkURL(itemImagesFolder) Then
Line 267: Session("itemimages") = itemImagesFolder
Line 268: ElseIf checkURL(site & itemImagesFolder) Then
Line 269: Session("itemimages") = site & itemImagesFolder
Line 270: End If
Line 271: Session("itemimages") = Replace(Session("itemimages"), "\", "/")
Line 272:
Line 273: If Session("itemimages") Is Nothing AndAlso itemImagesFolder = "itemimages/" Then
Line 274: Session("itemimages") = itemImagesFolder
Line 275: End If
Line 276:
Line 277: 'GET THE ITEMIMAGESFILEPATH
Line 278: Dim ItemImagesFilePath As String = getxmlval("itemimg_filepath")
Line 279: If VerifyPath(ItemImagesFilePath) Then
Line 280: Session("ItemImagesFilePath") = ItemImagesFilePath
Line 281: ElseIf VerifyPath(Server.MapPath(ItemImagesFilePath)) Then
Line 282: ItemImagesFilePath = ItemImagesFilePath.Replace("/", "\")
Line 283: Session("ItemImagesFilePath") = ItemImagesFilePath
Line 284: End If
Line 285: Session("itemimagesSecure") = Replace(Session("itemimages"), "http://", "https://")
Line 286: 'Session("itemimagesSecure") = Replace(site & itemImagesFolder, "http://", "https://")
Line 287: Catch ex As Exception
Line 288:
Line 289: End Try
Line 290:
Line 291: End Sub
Line 292:
Line 293: Function SwatchImagesExistForItem(ByVal itemimage As String, ByVal colors As Object) As Boolean
Line 294: Dim retval As Boolean = True
Line 295: Dim regending As String = getxmlval("itemimg_reg")
Line 296: Dim lrgending As String = getxmlval("itemimg_large")
Line 297: Dim thending As String = getxmlval("itemimg_thumb")
Line 298: For colorloop As Integer = 1 To UBound(colors)
Line 299: Dim colorcode As String
Line 300: If getSoftwareProductType() = "ASISB" Then
Line 301: colorcode = RepCharsInFilename(Trim(colors(colorloop, 2)))
Line 302: Else
Line 303: colorcode = RepCharsInFilename(Trim(colors(colorloop, 1)))
Line 304: End If
Line 305: If Session("ItemImagesFilePath") <> String.Empty Then
Line 306: Dim Fregimage As String = Session("ItemImagesFilePath") & itemimage & colorcode & regending
Line 307: Dim Flrgimage As String = Session("ItemImagesFilePath") & itemimage & colorcode & lrgending
Line 308: Dim Fthimage As String = Session("ItemImagesFilePath") & itemimage & colorcode & ".jpg"
Line 309: If Not (File.Exists(Fregimage) = True) OrElse Not (File.Exists(Fthimage)) Then
Line 310:
Line 311: retval = False
Line 312:
Line 313: Exit For
Line 314: End If
Line 315:
Line 316: Else 'We don't know where the item images are being stored in the file system, so we'll look for them by URL
Line 317: Dim regimage As String = Session("itemimages") & itemimage & colorcode & regending
Line 318: Dim lrgimage As String = Session("itemimages") & itemimage & colorcode & lrgending
Line 319: Dim thimage As String = Session("itemimages") & itemimage & colorcode & ".jpg"
Line 320: If Not (checkURL(regimage) = True) OrElse (getxmlval("itemimg_uselarge") = "Y" And Not (File.Exists(lrgimage))) OrElse Not (checkURL(thimage)) Then
Line 321: retval = False
Line 322:
Line 323: Exit For
Line 324: End If
Line 325: End If
Line 326:
Line 327: Next
Line 328: Session("SwatchImagesExistForItem" & itemimage) = retval.ToString()
Line 329:
Line 330: Return retval
Line 331: End Function
Line 332:
Line 333: Function getCorrectItemImages(ByVal pg As String) As String
Line 334: Dim httpsOn As String
Line 335: If Session("https" & pg) = String.Empty Then
Line 336: httpsOn = r1.Request.ServerVariables("HTTPS")
Line 337: Session("https" & pg) = httpsOn
Line 338: Else
Line 339: httpsOn = Session("https" & pg)
Line 340: End If
Line 341:
Line 342: Dim retval As String = Session("itemimages")
Line 343: If httpsOn <> "off" Then
Line 344: retval = Session("itemimagesSecure")
Line 345: End If
Line 346:
Line 347: Return retval
Line 348:
Line 349: End Function
Line 350:
Line 351: Function imageOnName(ByVal imgSrc As String) As String
Line 352: Dim newImage As String = String.Empty
Line 353: If imgSrc <> String.Empty Then
Line 354: Dim imageP As String = InStrRev(imgSrc, ".") - 1
Line 355: Dim imageL As String = Left(imgSrc, imageP)
Line 356: Dim imageR As String = Right(imgSrc, Len(imgSrc) - imageP - 1)
Line 357: newImage = imageL & "_on." & imageR
Line 358: End If
Line 359: Return (newImage)
Line 360:
Line 361: End Function
Line 362:
Line 363: Public Overloads Sub wt(ByVal enteringFunction As Boolean)
Line 364: If Not Trace.IsEnabled Then
Line 365: Return
Line 366: End If
Line 367: Dim callingFunctionName As String = "Undetermined method"
Line 368: Dim action As String = IIf(enteringFunction, "Entering", "Exiting")
Line 369: Try
Line 370: 'Determine the name of the calling function.
Line 371: Dim stackTrace As New System.Diagnostics.StackTrace()
Line 372: callingFunctionName = stackTrace.GetFrame(1).GetMethod().Name
Line 373: Catch
Line 374: End Try
Line 375: Trace.Write(action, callingFunctionName)
Line 376: End Sub
Line 377: Public Overloads Sub wt(ByVal enteringFunction As Boolean, ByVal comment As String)
Line 378: If Not Trace.IsEnabled Then
Line 379: Return
Line 380: End If
Line 381: Dim callingFunctionName As String = "Undetermined method"
Line 382: Dim action As String = IIf(enteringFunction, "Entering", "Exiting")
Line 383: Try
Line 384: 'Determine the name of the calling function.
Line 385: Dim stackTrace As New System.Diagnostics.StackTrace()
Line 386: callingFunctionName = stackTrace.GetFrame(1).GetMethod().Name
Line 387: Catch
Line 388: End Try
Line 389: If comment <> String.Empty Then
Line 390: callingFunctionName &= " : " & comment
Line 391: End If
Line 392: Trace.Write(action, callingFunctionName)
Line 393: End Sub
Line 394:
Line 395: Public Shared Function ComputeHash(ByVal plainText As String) As String
Line 396:
Line 397: ' Convert plain text into a byte array.
Line 398: Dim plainTextBytes As Byte()
Line 399: plainText = IIf(plainText Is Nothing, String.Empty, plainText)
Line 400: plainTextBytes = Encoding.UTF8.GetBytes(plainText)
Line 401:
Line 402: Dim hash As HashAlgorithm = New SHA256Managed()
Line 403:
Line 404: Dim hashBytes As Byte()
Line 405: hashBytes = hash.ComputeHash(plainTextBytes)
Line 406:
Line 407: ' Convert result into a base64-encoded string.
Line 408: Dim hashValue As String
Line 409: hashValue = Convert.ToBase64String(hashBytes)
Line 410:
Line 411: ' Return the result.
Line 412: ComputeHash = hashValue
Line 413:
Line 414: End Function
Line 415:
Line 416: Public Function EncryptString128Bit(ByVal vstrTextToBeEncrypted As String, ByVal vstrEncryptionKey As String) As String
Line 417:
Line 418: Dim bytValue() As Byte
Line 419: Dim bytKey() As Byte
Line 420: Dim bytEncoded() As Byte
Line 421: 'Dim bytIV() As Byte = {getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255), getrandom(1, 255)}
Line 422: 'Dim bytIV() As Byte = {121, 241, 10, 1, 132, 74, 11, 39, 255, 91, 45, 78, 14, 211, 22, 62}
Line 423: 'Dim bytIV() As Byte = {101, 41, 10, 10, 215, 34, 21, 67, 222, 29, 96, 92, 6, 80, 13, 2}
Line 424: 'Session("bytArray") = bytIV
Line 425:
Line 426: Dim bytIV() As Byte = Session("bytArray")
Line 427:
Line 428:
Line 429: Dim intLength As Integer
Line 430: Dim intRemaining As Integer
Line 431: Dim objMemoryStream As New MemoryStream
Line 432: Dim objCryptoStream As CryptoStream
Line 433: Dim objRijndaelManaged As RijndaelManaged
Line 434:
Line 435: vstrTextToBeEncrypted = StripNullCharacters(vstrTextToBeEncrypted)
Line 436:
Line 437: bytValue = Encoding.ASCII.GetBytes(vstrTextToBeEncrypted.ToCharArray)
Line 438:
Line 439: intLength = Len(vstrEncryptionKey)
Line 440:
Line 441: If intLength >= 32 Then
Line 442: vstrEncryptionKey = Strings.Left(vstrEncryptionKey, 32)
Line 443: Else
Line 444: intLength = Len(vstrEncryptionKey)
Line 445: intRemaining = 32 - intLength
Line 446: vstrEncryptionKey = vstrEncryptionKey & Strings.StrDup(intRemaining, "X")
Line 447: End If
Line 448:
Line 449: bytKey = Encoding.ASCII.GetBytes(vstrEncryptionKey.ToCharArray)
Line 450:
Line 451: objRijndaelManaged = New RijndaelManaged
Line 452:
Line 453: Try
Line 454:
Line 455: objCryptoStream = New CryptoStream(objMemoryStream, objRijndaelManaged.CreateEncryptor(bytKey, bytIV), CryptoStreamMode.Write)
Line 456: objCryptoStream.Write(bytValue, 0, bytValue.Length)
Line 457: objCryptoStream.FlushFinalBlock()
Line 458: bytEncoded = objMemoryStream.ToArray
Line 459: objMemoryStream.Close()
Line 460: objCryptoStream.Close()
Line 461: Catch e As Exception
Line 462: Session("errormessage") = e.Message
Line 463: End Try
Line 464:
Line 465: Return Convert.ToBase64String(bytEncoded)
Line 466:
Line 467: End Function
Line 468:
Line 469: Public Function DecryptString128Bit(ByVal vstrStringToBeDecrypted As String, ByVal vstrDecryptionKey As String) As String
Line 470:
Line 471: Dim bytDataToBeDecrypted() As Byte
Line 472: Dim bytTemp() As Byte
Line 473: 'Dim bytIV() As Byte = {121, 241, 10, 1, 132, 74, 11, 39, 255, 91, 45, 78, 14, 211, 22, 62}
Line 474: Dim bytIV() As Byte = Session("bytArray")
Line 475: Dim objRijndaelManaged As New RijndaelManaged
Line 476: Dim objMemoryStream As MemoryStream
Line 477: Dim objCryptoStream As CryptoStream
Line 478: Dim bytDecryptionKey() As Byte
Line 479: Dim intLength As Integer
Line 480: Dim intRemaining As Integer
Line 481: Dim intCtr As Integer
Line 482: Dim strReturnString As String = String.Empty
Line 483: Dim achrCharacterArray() As Char
Line 484: Dim intIndex As Integer
Line 485:
Line 486: bytDataToBeDecrypted = Convert.FromBase64String(vstrStringToBeDecrypted)
Line 487:
Line 488: intLength = Len(vstrDecryptionKey)
Line 489:
Line 490: If intLength >= 32 Then
Line 491: vstrDecryptionKey = Strings.Left(vstrDecryptionKey, 32)
Line 492: Else
Line 493: intLength = Len(vstrDecryptionKey)
Line 494: intRemaining = 32 - intLength
Line 495: vstrDecryptionKey = vstrDecryptionKey & Strings.StrDup(intRemaining, "X")
Line 496: End If
Line 497:
Line 498: bytDecryptionKey = Encoding.ASCII.GetBytes(vstrDecryptionKey.ToCharArray)
Line 499:
Line 500: ReDim bytTemp(bytDataToBeDecrypted.Length)
Line 501:
Line 502: objMemoryStream = New MemoryStream(bytDataToBeDecrypted)
Line 503:
Line 504: Try
Line 505:
Line 506: objCryptoStream = New CryptoStream(objMemoryStream, objRijndaelManaged.CreateDecryptor(bytDecryptionKey, bytIV), CryptoStreamMode.Read)
Line 507: objCryptoStream.Read(bytTemp, 0, bytTemp.Length)
Line 508: objCryptoStream.FlushFinalBlock()
Line 509: objMemoryStream.Close()
Line 510: objCryptoStream.Close()
Line 511:
Line 512: Catch
Line 513:
Line 514: End Try
Line 515:
Line 516: Return StripNullCharacters(Encoding.ASCII.GetString(bytTemp))
Line 517:
Line 518: End Function
Line 519:
Line 520:
Line 521: Public Function StripNullCharacters(ByVal vstrStringWithNulls As String) As String
Line 522:
Line 523: Dim intPosition As Integer
Line 524: Dim strStringWithOutNulls As String
Line 525:
Line 526: intPosition = 1
Line 527: strStringWithOutNulls = vstrStringWithNulls
Line 528:
Line 529: Do While intPosition > 0
Line 530: intPosition = InStr(intPosition, vstrStringWithNulls, vbNullChar)
Line 531:
Line 532: If intPosition > 0 Then
Line 533: strStringWithOutNulls = Left$(strStringWithOutNulls, intPosition - 1) & _
Line 534: Right$(strStringWithOutNulls, Len(strStringWithOutNulls) - intPosition)
Line 535: End If
Line 536:
Line 537: If intPosition > strStringWithOutNulls.Length Then
Line 538: Exit Do
Line 539: End If
Line 540: Loop
Line 541:
Line 542: Return strStringWithOutNulls
Line 543:
Line 544: End Function
Line 545:
Line 546: Public Function getxmlval(ByVal nodename As String) As String
Line 547:
Line 548: If Not IsNothing(HttpContext.Current.Application("xmldata")) Then
Line 549:
Line 550: Return xmlval(nodename)
Line 551:
Line 552: Else
Line 553:
Line 554: Dim ds As New XmlDocument()
Line 555:
Line 556: ' LOAD XML FILE UP TO 4 FOLDERS DEEP
Line 557: Try
Line 558: ds.Load(Server.MapPath("") & "\ecomdata.config")
Line 559: setApp(ds)
Line 560: Return xmlval(nodename)
Line 561: Catch
Line 562: Try
Line 563: ds.Load(Server.MapPath("..") & "\ecomdata.config")
Line 564: setApp(ds)
Line 565: Return xmlval(nodename)
Line 566: Catch
Line 567: Try
Line 568: ds.Load(Server.MapPath("..\..") & "\ecomdata.config")
Line 569: setApp(ds)
Line 570: Return xmlval(nodename)
Line 571: Catch
Line 572: Try
Line 573: ds.Load(Server.MapPath("..\..\..") & "\ecomdata.config")
Line 574: setApp(ds)
Line 575: Return xmlval(nodename)
Line 576: Catch
Line 577: r1.Response.Write("Data File Not Found! Contact Website Administrator.")
Line 578: r1.Response.End()
Line 579: End Try
Line 580: End Try
Line 581: End Try
Line 582: End Try
Line 583:
Line 584: ds = Nothing
Line 585:
Line 586: End If
Line 587:
Line 588: End Function
Line 589:
Line 590:
Line 591: Public Sub setApp(ByVal ds As Object)
Line 592:
Line 593: r1.Application.Lock()
Line 594: r1.Application("xmldata") = ds
Line 595: r1.Application.UnLock()
Line 596:
Line 597: End Sub
Line 598:
Line 599:
Line 600: Public Function xmlval(ByVal nodename As Object) As String
Line 601:
Line 602: Dim Source As XmlDocument
Line 603: Dim objNode As XmlNode
Line 604:
Line 605: Source = CType(HttpContext.Current.Application("xmldata"), XmlDocument)
Line 606: objNode = Source.DocumentElement.SelectSingleNode(LCase(nodename))
Line 607:
Line 608: If Not IsNothing(objNode) Then
Line 609:
Line 610: If Not IsNothing(objNode.FirstChild) Then
Line 611:
Line 612: If objNode.FirstChild.NodeType = XmlNodeType.Text Then
Line 613:
Line 614: Return objNode.FirstChild.Value
Line 615:
Line 616: End If
Line 617:
Line 618: End If
Line 619:
Line 620: End If
Line 621:
Line 622: End Function
Line 623:
Line 624: Public Function emailsend(ByVal sendto As String, ByVal subject As String, ByVal sendfrom As String, ByVal sendfromname As String, ByVal body As String, ByVal cc As String, ByVal bcc As String, ByVal mailserver As String, ByVal authenticate As String, ByVal usr As String, ByVal pwd As String, ByVal attachment As List(Of String)) As String
Line 625:
Line 626: Dim dbgstr As String
Line 627:
Line 628: dbgstr = "mailserver"
Line 629: If mailserver = "STANDARD" Then
Line 630: mailserver = getxmlval("emailserver")
Line 631: End If
Line 632:
Line 633: dbgstr = "authenticate"
Line 634: If authenticate = "STANDARD" Then
Line 635: authenticate = getxmlval("authenticateon")
Line 636: End If
Line 637:
Line 638: dbgstr = "usr"
Line 639: If usr = "STANDARD" Then
Line 640: usr = getxmlval("emailusr")
Line 641: End If
Line 642:
Line 643: dbgstr = "pwd"
Line 644: If pwd = "STANDARD" Then
Line 645: pwd = getxmlval("emailpwd")
Line 646: End If
Line 647:
Line 648: Dim returnval As String
Line 649:
Line 650: If getxmlval("emailmethod") = "remote" Then
Line 651:
Line 652: Dim s1 As Service1 = New Service1()
Line 653: s1.Url = "http://" & getxmlval("emailurl") & "/asiremoteservice/service1.asmx"
Line 654: Dim s As String = s1.Sendemail(sendto, subject, sendfrom, body, cc, bcc, mailserver, authenticate, usr, pwd)
Line 655:
Line 656: returnval = s
Line 657:
Line 658: Else
Line 659: ' removed and replaced 6/30/2014 to use System.Net.Mail classes (System.Web.Mail is obsolete)
Line 660: 'Dim objMessage As New MailMessage
Line 661: 'Dim msgAttachment As MailAttachment
Line 662:
Line 663: 'objMessage.To = sendto
Line 664: 'objMessage.Cc = cc
Line 665: 'objMessage.Bcc = bcc
Line 666: 'objMessage.From = sendfrom
Line 667: 'objMessage.Subject = subject
Line 668:
Line 669: 'objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = authenticate
Line 670: 'objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = usr
Line 671: 'objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = pwd
Line 672: 'If getxmlval("emailport") <> String.Empty Then
Line 673: ' objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = getxmlval("emailport")
Line 674: 'End If
Line 675:
Line 676: 'objMessage.Body = body
Line 677: 'objMessage.BodyFormat = MailFormat.Html
Line 678:
Line 679: 'If Not attachment Is Nothing Then
Line 680: ' For Each filename As String In attachment
Line 681: ' 'msgAttachment = New MailAttachment("c:\ecommerce\orders\" & filename)
Line 682: ' msgAttachment = New MailAttachment(filename)
Line 683: ' objMessage.Attachments.Add(msgAttachment)
Line 684: ' Next
Line 685: 'End If
Line 686:
Line 687:
Line 688: 'SmtpMail.SmtpServer = mailserver
Line 689:
Line 690: 'Try
Line 691: ' SmtpMail.Send(objMessage)
Line 692: ' returnval = "ok"
Line 693:
Line 694: 'Catch ehttp As Exception
Line 695: ' returnval = ehttp.InnerException.ToString()
Line 696:
Line 697: 'End Try
Line 698:
Line 699:
Line 700: Dim objMessage As New MailMessage
Line 701: Dim msgAttachment As Mail.Attachment
Line 702:
Line 703: dbgstr = "To"
Line 704: sendto = Replace(sendto, ";", ",")
Line 705: If Right(sendto, 1) = "," Then
Line 706: sendto = Left(sendto, sendto.Length - 1)
Line 707: End If
Line 708: objMessage.To.Add(sendto)
Line 709:
Line 710: dbgstr = "cc"
Line 711: If Not IsNothing(cc) Then
Line 712: cc = cc.Trim()
Line 713: If cc <> "" Then
Line 714: cc = Replace(cc, ";", ",")
Line 715: If Right(cc, 1) = "," Then
Line 716: cc = Left(cc, cc.Length - 1)
Line 717: End If
Line 718: 'in case the above now causes cc to be "" because cc only = "," recheck it
Line 719: If cc <> "" Then
Line 720: objMessage.CC.Add(cc)
Line 721: End If
Line 722: End If
Line 723: End If
Line 724:
Line 725: dbgstr = "bcc"
Line 726: If Not IsNothing(bcc) Then
Line 727: bcc = bcc.Trim()
Line 728: If bcc <> "" Then
Line 729: bcc = Replace(bcc, ";", ",")
Line 730: If Right(bcc, 1) = "," Then
Line 731: bcc = Left(bcc, bcc.Length - 1)
Line 732: End If
Line 733: If bcc <> "" Then
Line 734: objMessage.Bcc.Add(bcc)
Line 735: End If
Line 736: End If
Line 737: End If
Line 738:
Line 739: dbgstr = "from and fromname"
Line 740: objMessage.From = New MailAddress(sendfrom, sendfromname)
Line 741:
Line 742: dbgstr = "subject"
Line 743: objMessage.Subject = subject
Line 744:
Line 745: 'objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = authenticate
Line 746: 'objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = usr
Line 747: 'objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = pwd
Line 748: 'If getxmlval("emailport") <> String.Empty Then
Line 749: ' objMessage.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = getxmlval("emailport")
Line 750: 'End If
Line 751:
Line 752: dbgstr = "body"
Line 753: objMessage.Body = body
Line 754:
Line 755: dbgstr = "isbodyhtml"
Line 756: objMessage.IsBodyHtml = True
Line 757:
Line 758: dbgstr = "attachments"
Line 759: If Not attachment Is Nothing Then
Line 760: For Each filename As String In attachment
Line 761: 'msgAttachment = New MailAttachment("c:\ecommerce\orders\" & filename)
Line 762: msgAttachment = New Mail.Attachment(filename)
Line 763: objMessage.Attachments.Add(msgAttachment)
Line 764: Next
Line 765: End If
Line 766:
Line 767:
Line 768: 'SmtpMail.SmtpServer = mailserver
Line 769:
Line 770: Dim mailclient As New SmtpClient(mailserver)
Line 771:
Line 772: dbgstr = "emailport"
Line 773: If Not IsNothing(getxmlval("emailport")) Then
Line 774: mailclient.Port = getxmlval("emailport")
Line 775: End If
Line 776:
Line 777: dbgstr = "emailssl"
Line 778: If Not IsNothing(getxmlval("emailssl")) Then
Line 779: If getxmlval("emailssl") = "true" Then
Line 780: mailclient.EnableSsl = True
Line 781: Else
Line 782: mailclient.EnableSsl = False
Line 783: End If
Line 784: Else
Line 785: mailclient.EnableSsl = False
Line 786: End If
Line 787:
Line 788: dbgstr = "credentials"
Line 789: Dim cred As New System.Net.NetworkCredential(usr, pwd)
Line 790: mailclient.Credentials = cred
Line 791: Try
Line 792: 'SmtpMail.Send(objMessage)
Line 793: dbgstr = "send"
Line 794: mailclient.Send(objMessage)
Line 795: returnval = "ok"
Line 796:
Line 797: Catch ehttp As SmtpException
Line 798: 'returnval = ehttp.InnerException.ToString()
Line 799: returnval = ehttp.StatusCode.ToString() + "(" + dbgstr + ")"
Line 800: If Not IsNothing(ehttp.InnerException) Then
Line 801: returnval = returnval + " " + ehttp.InnerException.ToString() + "(" + dbgstr + ")"
Line 802: End If
Line 803: Catch e As Exception
Line 804: returnval = e.InnerException.ToString() + "(" + dbgstr + ")"
Line 805: End Try
Line 806:
Line 807:
Line 808:
Line 809:
Line 810: Return returnval
Line 811:
Line 812: End If
Line 813:
Line 814: End Function
Line 815:
Line 816: Function getrandom(ByVal min As Integer, ByVal max As Integer) As Integer
Line 817: Randomize()
Line 818: Return (Int((max - min + 1) * Rnd() + min))
Line 819: End Function
Line 820: ' Adds an ACL entry on the specified file for the specified account.
Line 821: Sub AddFileSecurity(ByVal fileName As String, ByVal account As String, _
Line 822: ByVal rights As FileSystemRights, ByVal controlType As AccessControlType)
Line 823:
Line 824: ' Get a FileSecurity object that represents the
Line 825: ' current security settings.
Line 826: Dim fSecurity As FileSecurity = File.GetAccessControl(fileName)
Line 827:
Line 828: ' Add the FileSystemAccessRule to the security settings.
Line 829: Try
Line 830: Dim accessRule As FileSystemAccessRule = _
Line 831: New FileSystemAccessRule(account, rights, controlType)
Line 832: fSecurity.AddAccessRule(accessRule)
Line 833:
Line 834: ' Set the new access settings.
Line 835: File.SetAccessControl(fileName, fSecurity)
Line 836: Catch ex As Exception
Line 837: Dim EvRule As FileSystemAccessRule = _
Line 838: New FileSystemAccessRule("EVERYONE", rights, controlType)
Line 839: fSecurity.AddAccessRule(EvRule)
Line 840:
Line 841: ' Set the new access settings.
Line 842: File.SetAccessControl(fileName, fSecurity)
Line 843: End Try
Line 844:
Line 845:
Line 846:
Line 847: End Sub
Line 848:
Line 849: Function SessionRemoveSelected(ByVal sItemPrefix As String)
Line 850: '/////////////////////////////////////////////////
Line 851: ' Remove Selected Items starting with sItemPrefix
Line 852: ' from the Session. e.g. SS. will remove SS.ID and
Line 853: ' SS.NAME but not CustomerID Returns True or False
Line 854: ' depending on whether any items where removed.
Line 855: '---------------------------------------
Line 856: ' sItemPrefix [string] : Item Prefix
Line 857: '/////////////////////////////////////////////////
Line 858: Dim arySession()
Line 859: Dim lCount As Integer
Line 860: Dim lPrefixLength As Integer
Line 861: Dim SessionItem As String
Line 862: Dim blnResult As Boolean
Line 863:
Line 864: lCount = -1
Line 865: lPrefixLength = Len(sItemPrefix)
Line 866: blnResult = False
Line 867:
Line 868: ' temporarily store in array items to remove
Line 869: For Each SessionItem In Session.Contents
Line 870: If Left(SessionItem, lPrefixLength) = sItemPrefix Then
Line 871: lCount = lCount + 1
Line 872: ReDim Preserve arySession(lCount)
Line 873: arySession(lCount) = SessionItem
Line 874: End If
Line 875: Next
Line 876:
Line 877: ' remove items
Line 878: If IsArray(arySession) And lCount >= 0 Then
Line 879: For lCount = LBound(arySession) To UBound(arySession)
Line 880: Session.Contents.Remove(arySession(lCount))
Line 881: Next
Line 882: blnResult = True
Line 883: End If
Line 884:
Line 885: SessionRemoveSelected = blnResult
Line 886: End Function
Line 887:
Line 888: Function validatecc(ByVal ccnum As String, ByVal ccsecurity As String, ByVal ccmonth As String, ByVal ccyear As String, ByVal cardholder As String) As Boolean
Line 889: Dim orderid As String = Session("orderid")
Line 890: Dim aItem As Object
Line 891: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 892: Try
Line 893: aItem = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_valiatecc", Server.MapPath(""), "getorderinfo", "EORDER", orderid)
Line 894: Finally
Line 895: dbservermanager = Nothing
Line 896: End Try
Line 897:
Line 898: Dim orderamount As Object
Line 899: Dim pono As String = CStr(aItem(27)) 'Customer PO#
Line 900: Dim street As String = CStr(aItem(8)) 'BillTo Addr1
Line 901: Dim city As String = CStr(aItem(10)) 'BillTo City
Line 902: Dim state As String = CStr(aItem(11)) 'BillTo State
Line 903: Dim zip As String = CStr(aItem(12)) 'BillTo Zip
Line 904: Dim company As String = aItem(6) 'BillTo Company
Line 905: Dim country As String = Session("bcountry")
Line 906: Dim phone As String
Line 907: Dim email As String = aItem(41) 'Email address
Line 908: Dim freightAmt As String = aItem(22) 'Shipping amount
Line 909: Dim taxAmt As String = aItem(23) 'Tax Amount
Line 910: Dim discountAmt As String = aItem(26) 'Total discount
Line 911: Dim sZip As String = aItem(19) 'ShipToZip
Line 912: Dim sCountryCode As String = aItem(64) 'ShipTo Country Code
Line 913:
Line 914: Dim validated As Boolean
Line 915:
Line 916: If IsNumeric(getxmlval("scripttimeout")) Then
Line 917: Server.ScriptTimeout = getxmlval("scripttimeout")
Line 918: End If
Line 919:
Line 920: orderamount = IIf(Session("diffamount") > 0, Math.Round(Session("diffamount"), 2), Math.Round(aItem(33), 2))
Line 921:
Line 922: If getxmlval("sphonepm") = "Y" And Session("sphone") <> String.Empty Then
Line 923: phone = Session("sphone")
Line 924: ElseIf getxmlval("sphonepm") = "Y" And Session("s_phone") <> String.Empty Then
Line 925: phone = Session("s_phone")
Line 926: Else
Line 927: phone = aItem(20)
Line 928: End If
Line 929:
Line 930: Session("goyo") = False
Line 931:
Line 932: If getxmlval("onlineprocessing") = "paypal" Then
Line 933: validated = validatepaypal(ccnum, ccsecurity, ccmonth, ccyear, pono, street, zip, orderamount, freightAmt, taxAmt, discountAmt, sCountryCode, sZip)
Line 934: ElseIf getxmlval("onlineprocessing") = "authorizenetsdk" Then
Line 935: validated = validateauthorizenet(ccnum, ccsecurity, ccmonth, ccyear, cardholder, orderamount)
Line 936: ElseIf getxmlval("onlineprocessing") = "USAePay" Then
Line 937: validated = validateusaepay(ccnum, ccsecurity, ccmonth, ccyear, cardholder, orderamount)
Line 938: Else
Line 939: Session("goyo") = True
Line 940: End If
Line 941:
Line 942: If validated = True Then
Line 943: Session("CCProcessed") = True
Line 944:
Line 945: End If
Line 946:
Line 947: Session("goyo") = validated
Line 948: Return validated
Line 949: End Function
Line 950:
Line 951: Private Function validatepaypal(ByVal ccnum As String, ByVal ccsecurity As String, ByVal ccmonth As String, ByVal ccyear As String, ByVal pono As String, ByVal street As String, ByVal zip As String, ByVal orderamount As String, ByVal freightAmt As String, ByVal taxAmt As String, ByVal discountAmt As String, ByVal sCountryCode As String, ByVal sZip As String) As Boolean
Line 952: Dim paypaltrxtype As String = IIf(getxmlval("paypaltrxtype") <> String.Empty, getxmlval("paypaltrxtype"), "A")
Line 953:
Line 954: If Len(ccmonth) = 1 Then
Line 955: ccmonth = "0" & ccmonth
Line 956: End If
Line 957: ccyear = Right(ccyear, 2)
Line 958:
Line 959: Dim ccexp As String = ccmonth & ccyear
Line 960: Dim value As String
Line 961: Dim repsvalue As String
Line 962: Dim ref As String
Line 963: Dim authcode As String
Line 964: Dim respns As String
Line 965: Dim User As UserInfo
Line 966: Dim paypalvalid As Boolean = False
Line 967: Dim payPalLevel3Data As String = getxmlval("paypallevel3data")
Line 968:
Line 969: If getxmlval("paypalvendor") = String.Empty Then
Line 970: User = New UserInfo(getxmlval("paypalusr"), getxmlval("paypalusr"), getxmlval("paypalpartner"), getxmlval("paypalpwd"))
Line 971: Else
Line 972: User = New UserInfo(getxmlval("paypalusr"), getxmlval("paypalvendor"), getxmlval("paypalpartner"), getxmlval("paypalpwd"))
Line 973: End If
Line 974:
Line 975: Dim Connection As PayflowConnectionData = New PayflowConnectionData
Line 976:
Line 977: ' Create a new Invoice data object with the Amount, Billing Address etc. details.
Line 978: Dim Inv As Invoice = New Invoice
Line 979:
Line 980: ' Set Amount.
Line 981: Dim Amt As Currency = New Currency(orderamount)
Line 982: Inv.Amt = Amt
Line 983:
Line 984: ' PONum, InvNum and CustRef are sent to the processors and could show up on a customers
Line 985: ' or your bank statement. These fields are reportable but not searchable in PayPal Manager.
Line 986: Inv.PoNum = pono
Line 987: Inv.InvNum = Session("getno")
Line 988:
Line 989: ' Comment1
Line 990: Dim Cmnt1 As String = Session("getno")
Line 991: Inv.Comment1 = Cmnt1
Line 992:
Line 993: ' Set the Billing Address details.
Line 994: Dim Bill As BillTo = New BillTo
Line 995:
Line 996: Bill.Street = street
Line 997: Bill.Zip = zip
Line 998: Inv.BillTo = Bill
Line 999:
Line 1000: If payPalLevel3Data = "Y" Then
Line 1001: Dim totalFreightAmt As Decimal = freightAmt
Line 1002: Dim totalDutyAmt As Decimal = 0.0
Line 1003: Dim dutyMcItem As String = getxmlval("dutymc")
Line 1004:
Line 1005: Inv.Discount = New Currency(discountAmt)
Line 1006: Inv.TaxAmt = New Currency(taxAmt)
Line 1007:
Line 1008: If taxAmt = 0.0 Then
Line 1009: Inv.TaxExempt = "Y"
Line 1010: Else
Line 1011: Inv.TaxExempt = "N"
Line 1012: End If
Line 1013:
Line 1014: Dim ShipTo As ShipTo = New ShipTo
Line 1015: ShipTo.ShipToCountry = sCountryCode
Line 1016: ShipTo.ShipToZip = sZip
Line 1017: ShipTo.ShipFromZip = getxmlval("upsshipfrom")
Line 1018: Inv.ShipTo = ShipTo
Line 1019:
Line 1020: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 1021: Dim elines As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "getorderiteminfo", "ELINITM", Session("orderid"))
Line 1022: dbservermanager = Nothing
Line 1023:
Line 1024: Dim aIcount As Integer = UBound(elines)
Line 1025: Dim icount As Integer
Line 1026: Dim maxLineItemsToSend As Integer
Line 1027: maxLineItemsToSend = IIf((aIcount - 1) < 101, (aIcount - 1), 99) 'Note - they have a 99 line item limit
Line 1028: Dim itemNo As String
Line 1029: Dim itemAmt As Decimal
Line 1030:
Line 1031: If aIcount > 0 Then
Line 1032: For icount = 1 To maxLineItemsToSend
Line 1033: Dim LineItem As PayPal.Payments.DataObjects.LineItem = New PayPal.Payments.DataObjects.LineItem
Line 1034: itemNo = elines(icount, 3).Trim()
Line 1035: itemAmt = elines(icount, 10)
Line 1036: LineItem.Qty = elines(icount, 9)
Line 1037: LineItem.CommCode = "ADSPEC" 'Item commodity code (matches PM)
Line 1038: LineItem.Desc = elines(icount, 6)
Line 1039: LineItem.UOM = "EA" 'Item unit of measure (matches PM)
Line 1040: LineItem.Cost = New Currency(0.0)
Line 1041: LineItem.UPC = itemNo + elines(icount, 4).Trim() 'item#/sub (matches PM)
Line 1042: LineItem.Discount = New Currency(0.0)
Line 1043: LineItem.Amt = New Currency(elines(icount, 10))
Line 1044: LineItem.TaxAmt = New Currency(0.0)
Line 1045:
Line 1046: Inv.AddLineItem(LineItem)
Line 1047:
Line 1048: If itemNo = "SH" Then
Line 1049: totalFreightAmt += itemAmt
Line 1050: End If
Line 1051:
Line 1052: If Trim(dutyMcItem) <> "" Then
Line 1053: If itemNo.Trim = Trim(dutyMcItem) Then
Line 1054: totalDutyAmt += itemAmt
Line 1055: End If
Line 1056: End If
Line 1057: Next
Line 1058:
Line 1059: End If
Line 1060:
Line 1061: Inv.FreightAmt = New Currency(totalFreightAmt)
Line 1062: Inv.DutyAmt = New Currency(totalDutyAmt)
Line 1063:
Line 1064: End If
Line 1065:
Line 1066: ' Create a new Payment Device - Credit Card data object.
Line 1067: ' The input parameters are Credit Card No. and Expiry Date for the Credit Card.
Line 1068: Dim CC As CreditCard = New CreditCard(ccnum, ccexp)
Line 1069: CC.Cvv2 = ccsecurity
Line 1070:
Line 1071: ' Create a new Tender - Card Tender data object.
Line 1072: Dim Card As CardTender = New CardTender(CC)
Line 1073: '/////////////////////////////////////////////////////////////////
Line 1074:
Line 1075: Dim Trans As Object = Nothing
Line 1076: If paypaltrxtype = "A" Then
Line 1077: ' Create a new Auth Transaction.
Line 1078: Trans = New AuthorizationTransaction(User, Connection, Inv, Card, PayflowUtility.RequestId)
Line 1079: ElseIf paypaltrxtype = "S" Then
Line 1080: ' Create a new Sale Transaction.
Line 1081: Trans = New SaleTransaction(User, Connection, Inv, Card, PayflowUtility.RequestId)
Line 1082: End If
Line 1083:
Line 1084: ' Submit the transaction.
Line 1085: Dim Resp As Response = Trans.SubmitTransaction()
Line 1086: Dim responstring As New StringBuilder()
Line 1087:
Line 1088: If Not Resp Is Nothing Then
Line 1089: ' Get the Transaction Response parameters.
Line 1090: Dim TrxnResponse As TransactionResponse = Resp.TransactionResponse
Line 1091:
Line 1092: If Not TrxnResponse Is Nothing Then
Line 1093: responstring.Append("RESULT = " + TrxnResponse.Result.ToString)
Line 1094: responstring.Append("PNREF = " + TrxnResponse.Pnref)
Line 1095: responstring.Append("RESPMSG = " + TrxnResponse.RespMsg)
Line 1096: responstring.Append("AUTHCODE = " + TrxnResponse.AuthCode)
Line 1097: responstring.Append("AVSADDR = " + TrxnResponse.AVSAddr)
Line 1098: responstring.Append("AVSZIP = " + TrxnResponse.AVSZip)
Line 1099: responstring.Append("IAVS = " + TrxnResponse.IAVS)
Line 1100: responstring.Append("CVV2MATCH = " + TrxnResponse.CVV2Match)
Line 1101: ' If value is true, then the Request ID has not been changed and the original response
Line 1102: ' of the original transction is returned.
Line 1103: responstring.Append("DUPLICATE = " + TrxnResponse.Duplicate)
Line 1104:
Line 1105: If TrxnResponse.Result.ToString = 0 Then
Line 1106: paypalvalid = True
Line 1107: Else
Line 1108: repsvalue = TrxnResponse.Result.ToString
Line 1109: End If
Line 1110:
Line 1111: ref = TrxnResponse.Pnref
Line 1112: Session("refnumber") = ref
Line 1113:
Line 1114: If repsvalue = 12 Then
Line 1115: repsvalue += "<br />This could be caused by an invalid card number, expired card, amount exceeding credit limit, etc."
Line 1116: End If
Line 1117: respns = "<font class=""head1"">" & value & "Your credit card transaction was invalid.</font><br /><br />"
Line 1118:
Line 1119: authcode = TrxnResponse.AuthCode
Line 1120: Session("authcode") = authcode
Line 1121: End If
Line 1122:
Line 1123: ' Get the Fraud Response parameters.
Line 1124: Dim FraudResp As FraudResponse = Resp.FraudResponse
Line 1125: If Not FraudResp Is Nothing Then
Line 1126: responstring.Append("PREFPSMSG = " + FraudResp.PreFpsMsg)
Line 1127: responstring.Append("POSTFPSMSG = " + FraudResp.PostFpsMsg)
Line 1128: End If
Line 1129:
Line 1130: ' Display the response.
Line 1131: responstring.Append(Environment.NewLine + PayflowUtility.GetStatus(Resp))
Line 1132:
Line 1133: ' Get the Transaction Context and check for any contained SDK specific errors (optional code).
Line 1134: Dim TransCtx As Context = Resp.TransactionContext
Line 1135: If (Not TransCtx Is Nothing) And (TransCtx.getErrorCount() > 0) Then
Line 1136: responstring.Append(Environment.NewLine + "Transaction Errors = " + TransCtx.ToString())
Line 1137: End If
Line 1138:
Line 1139: End If
Line 1140: Session("responstring") = responstring.ToString
Line 1141:
Line 1142: 'End If
Line 1143:
Line 1144: If paypalvalid = True Then
Line 1145: Session("goyo") = True
Line 1146: Else
Line 1147:
Line 1148: Session("ccinvalidmessage") = respns & "Your Transaction Response Code is " & repsvalue & ".<br /><br /> Please correct your payment information or contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " with this information for assistance.</font>"
Line 1149: Session("errors") += 1
Line 1150: End If
Line 1151: Return paypalvalid
Line 1152:
Line 1153: End Function
Line 1154: Function validateauthorizenet(ByVal ccnum As String, ByVal ccsecurity As String, ByVal ccmonth As String, ByVal ccyear As String, ByVal cardholder As String, ByVal orderamount As String) As Boolean
Line 1155: Dim getpath, lResolve, lConnect, lSend, lReceive, inixmlhttp, anXMLhttpObject, strResult, transacturl, mode
Line 1156: Dim dbservermanager As Object
Line 1157: Dim anetvalid As Boolean = False
Line 1158: Dim ccProcessStep As String = "Unknown"
Line 1159:
Line 1160: Try
Line 1161: Dim getinisettings As String
Line 1162: Dim aItem As Object
Line 1163: ccProcessStep = "1"
Line 1164: dbservermanager = Server.CreateObject(getcomname())
Line 1165:
Line 1166: Try
Line 1167: ccProcessStep = "2a"
Line 1168: getinisettings = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE,ECOMMERCE,ECOMMERCE,ECOMMERCE,ECOMMERCE,ECOMMERCE", "TIMEOUTRESOLVE,TIMEOUTCONNECT,TIMEOUTSEND,TIMEOUTRECEIVE,DATAPATH,XMLHTTP", "5000,5000,5000,5000,c:\ecommerce\orders,MSXML2.ServerXMLHTTP")
Line 1169: ccProcessStep = "2b"
Line 1170: Finally
Line 1171: ccProcessStep = "2c"
Line 1172: System.Runtime.InteropServices.Marshal.ReleaseComObject(dbservermanager)
Line 1173: dbservermanager = Nothing
Line 1174: End Try
Line 1175:
Line 1176: dbservermanager = Server.CreateObject(getcomname())
Line 1177: Try
Line 1178: ccProcessStep = "3a"
Line 1179: aItem = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_validateauthorizenet", Server.MapPath(""), "getorderinfo", "EORDER", Session("orderid"))
Line 1180: ccProcessStep = "3b"
Line 1181: Finally
Line 1182: ccProcessStep = "3c"
Line 1183: System.Runtime.InteropServices.Marshal.ReleaseComObject(dbservermanager)
Line 1184: dbservermanager = Nothing
Line 1185: End Try
Line 1186:
Line 1187: Dim street As String = CStr(aItem(8))
Line 1188: Dim city As String = CStr(aItem(10))
Line 1189: Dim state As String = CStr(aItem(11))
Line 1190: Dim zip As String = CStr(aItem(12))
Line 1191: Dim company As String = aItem(6)
Line 1192: Dim country As String = Session("bcountry")
Line 1193: Dim phone As String = aItem(20)
Line 1194: Dim email As String = aItem(41)
Line 1195: Dim parmList As Object
Line 1196: Dim ccexp As String = ""
Line 1197: Dim getiniarray As Array = Split(getinisettings, ",")
Line 1198: Dim authorizenetcustid As String = ""
Line 1199: Dim authorizenettax As String = String.Empty
Line 1200: Dim gettot As Object = getcarttotals()
Line 1201: Dim gettax As String = gettot(4)
Line 1202:
Line 1203: If getxmlval("authorizenetemulator") = "Y" Then
Line 1204: ccexp = IIf(Len(ccmonth) = 1, "0" & ccmonth, ccmonth) & Right(ccyear, 2)
Line 1205: Else
Line 1206: ccexp = ccmonth & ccyear
Line 1207: End If
Line 1208:
Line 1209: If getxmlval("authorizenetcustid") = "Y" Then
Line 1210: authorizenetcustid = "&x_Cust_ID=" & Session("custno")
Line 1211: End If
Line 1212:
Line 1213: If getxmlval("authorizenettax") = "Y" Then
Line 1214: authorizenettax = "&x_Tax=" & gettax
Line 1215: End If
Line 1216:
Line 1217: lResolve = Trim(getiniarray(0))
Line 1218: lConnect = Trim(getiniarray(1))
Line 1219: lSend = Trim(getiniarray(2))
Line 1220: lReceive = Trim(getiniarray(3))
Line 1221: getpath = addwack(Trim(getiniarray(4)))
Line 1222: inixmlhttp = Trim(getiniarray(5))
Line 1223:
Line 1224: If getxmlval("paypalmode") = "live" Then
Line 1225: If getxmlval("authorizenetemulator") = "Y" Then
Line 1226: transacturl = "https://fts.prinpay.com:8443/cardconnect/znet?"
Line 1227: Else
Line 1228: transacturl = "https://secure.authorize.net/gateway/transact.dll"
Line 1229: End If
Line 1230:
Line 1231: mode = "FALSE"
Line 1232: Else
Line 1233: If getxmlval("authorizenetemulator") = "Y" Then
Line 1234: transacturl = "https://fts.prinpay.com:6443/cardconnect/znet?"
Line 1235: Else
Line 1236: transacturl = "https://test.authorize.net/gateway/transact.dll"
Line 1237: End If
Line 1238:
Line 1239: mode = "TRUE"
Line 1240: End If
Line 1241:
Line 1242: Dim xtype As String
Line 1243: If getxmlval("paypaltrxtype") = "A" Then
Line 1244: xtype = "AUTH_ONLY"
Line 1245: Else
Line 1246: xtype = "AUTH_CAPTURE"
Line 1247: End If
Line 1248:
Line 1249: ' fix to add the .00 when orderamount comes in as an integer
Line 1250: If orderamount.IndexOf(".") < 0 Then
Line 1251: orderamount = orderamount + ".00"
Line 1252: End If
Line 1253:
Line 1254: parmList = "x_login=" & getxmlval("authorizenetusr") & "&x_tran_key=" & getxmlval("authorizenetkey") & "&x_test_request=" & mode & "&x_delim_data=TRUE&x_first_name=" & cardholder & "&x_company=" & company & "&x_address=" & street & "&x_city=" & city & "&x_state=" & state & "&x_zip=" & zip & authorizenetcustid & "&x_country=" & country & "&x_phone=" & phone & "&x_email=" & email & "&x_invoice_num=" & Session("getno") & "&x_amount=" & orderamount & "&x_method=CC&x_type=" & xtype & authorizenettax & "&x_card_num=" & ccnum & "&x_exp_date=" & ccexp & "&x_card_code=" & ccsecurity
Line 1255:
Line 1256: anXMLhttpObject = Server.CreateObject(inixmlhttp)
Line 1257:
Line 1258: Try
Line 1259: ccProcessStep = "4a"
Line 1260: anXMLhttpObject.open("POST", transacturl, False)
Line 1261: ccProcessStep = "4b"
Line 1262: Catch
Line 1263: 'formerror("Authorize.net Connection cannot be established. Please try again later.")
Line 1264: ccProcessStep = "4c"
Line 1265: r1.Response.End()
Line 1266: End Try
Line 1267:
Line 1268: anXMLhttpObject.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Line 1269: anXMLhttpObject.setTimeouts(lResolve, lConnect, lSend, lReceive)
Line 1270: anXMLhttpObject.send((parmList))
Line 1271: strResult = anXMLhttpObject.responseText
Line 1272:
Line 1273: Dim newarray As Array = Split(strResult, ",")
Line 1274: If newarray(0) = 1 Then
Line 1275: anetvalid = True
Line 1276: Session("refnumber") = newarray(4)
Line 1277: Session("authcode") = newarray(4)
Line 1278: Session("goyo") = True
Line 1279: Else
Line 1280: Session("ccinvalidmessage") = "<font class=""head1"">" & newarray(3) & "<br /><br />Your credit card has not been processed!</font><br /><br />Your Transaction Response Code is " & newarray(0) & ".<br /><br />Please correct your payment information or contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " with this information for assistance.</font>"
Line 1281: Session("errors") += 1
Line 1282: End If
Line 1283:
Line 1284: Catch ex As Exception
Line 1285: Session("ccinvalidmessage") = "<font class=""head1"">Error: " & "<br /><br />Your credit card has not been processed! The credit card processor had an error on Step #" & ccProcessStep & ".<br /><br />Please try to enter your payment information again and if the problem persists, contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " with this information for assistance.</font>"
Line 1286:
Line 1287: Session("errors") += 1
Line 1288: End Try
Line 1289:
Line 1290: Return anetvalid
Line 1291: End Function
Line 1292:
Line 1293: Function validateusaepay(ByVal ccnum As String, ByVal ccsecurity As String, ByVal ccmonth As String, ByVal ccyear As String, ByVal cardholder As String, ByVal orderamount As String) As Boolean
Line 1294:
Line 1295: Dim orderid As String = Session("orderid")
Line 1296: Dim dbservermanager As Object
Line 1297: Dim usaepayvalid As Boolean = False
Line 1298: Dim ccProcessStep As String = "Unknown"
Line 1299: Dim uSAePayMode = getxmlval("usaepaymode")
Line 1300: Dim transactionType = getxmlval("paypaltrxtype")
Line 1301:
Line 1302: Try
Line 1303: ccProcessStep = "1"
Line 1304: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "Before dbservermanager CreateObject"
Line 1305:
Line 1306: ccProcessStep = "2"
Line 1307: dbservermanager = Server.CreateObject(getcomname())
Line 1308: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "After dbservermanager CreateObject"
Line 1309:
Line 1310: If IsNothing(dbservermanager) Then
Line 1311: ccProcessStep = "3"
Line 1312: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "dbservermanager is nothing"
Line 1313: End If
Line 1314:
Line 1315: Dim aOrder As Object
Line 1316:
Line 1317: Try
Line 1318: aOrder = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_validateUSAepay", Server.MapPath(""), "getorderinfo", "EORDER", orderid)
Line 1319: Finally
Line 1320: System.Runtime.InteropServices.Marshal.ReleaseComObject(dbservermanager)
Line 1321: dbservermanager = Nothing
Line 1322: End Try
Line 1323:
Line 1324: Dim pono As String = CStr(aOrder(27)) 'custpo
Line 1325: Dim fullName As String = aOrder(7)
Line 1326: Dim street As String = CStr(aOrder(8))
Line 1327: Dim city As String = CStr(aOrder(10))
Line 1328: Dim state As String = CStr(aOrder(11))
Line 1329: Dim zip As String = CStr(aOrder(12))
Line 1330: Dim company As String = aOrder(6)
Line 1331: Dim country As String = Session("bcountry")
Line 1332: Dim phone As String = aOrder(20)
Line 1333: Dim email As String = aOrder(41)
Line 1334:
Line 1335: If Len(ccmonth) = 1 Then
Line 1336: ccmonth = "0" & ccmonth
Line 1337: End If
Line 1338:
Line 1339: ccyear = Right(ccyear, 2)
Line 1340: Dim ccexp As String = ccmonth & ccyear
Line 1341: usaepayvalid = False
Line 1342:
Line 1343: ccProcessStep = "4"
Line 1344: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "Before USAePayAPI CreateObject"
Line 1345:
Line 1346: Dim usaepay As USAePayAPI.USAePay = New USAePayAPI.USAePay
Line 1347:
Line 1348: ccProcessStep = "5"
Line 1349: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "After USAePayAPI CreateObject"
Line 1350:
Line 1351: If IsNothing(usaepay) Then
Line 1352: ccProcessStep = "6"
Line 1353: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "Unable to create USAePayAPI com object"
Line 1354: End If
Line 1355:
Line 1356: usaepay.SourceKey = getxmlval("usaepaykey")
Line 1357:
Line 1358: 'This allows fraud blocking on the customers IP address
Line 1359: Dim h1 As System.Web.HttpContext = System.Web.HttpContext.Current
Line 1360: usaepay.ClientIP = h1.Request.ServerVariables("REMOTE_ADDR")
Line 1361:
Line 1362: If uSAePayMode = "test" Then
Line 1363: usaepay.UseSandbox = True
Line 1364: usaepay.Email = "deniseb@asicomp.com" 'email want test receipt to go to
Line 1365: usaepay.CustReceipt = True
Line 1366: usaepay.CustReceiptName = "My Receipt"
Line 1367: Else
Line 1368: usaepay.UseSandbox = False
Line 1369: End If
Line 1370:
Line 1371: usaepay.OrderID = aOrder(1) 'Ordno; note PM fills Invoice; so if put here, won't be overridden. Must be unique.
Line 1372: usaepay.PoNum = pono 'custpo
Line 1373: usaepay.Amount = orderamount 'Charge amount in dollars
Line 1374: usaepay.Tax = aOrder(23)
Line 1375:
Line 1376: usaepay.CardHolder = cardholder 'Name of card holder
Line 1377: usaepay.CardNumber = ccnum 'Card number, no dashes, no spaces
Line 1378: usaepay.CardExp = ccexp 'Expiration date 4 digits
Line 1379: usaepay.Cvv2 = ccsecurity 'CVV2 code
Line 1380: usaepay.AvsStreet = street 'Street address
Line 1381: usaepay.AvsZip = zip 'Zip code
Line 1382:
Line 1383: 'Don't have first and last name so split out as best can
Line 1384: If fullName.Contains(" ") Then
Line 1385: Dim aFirstLastNames As Array = ParseFullNameToFirstLast(fullName.Trim())
Line 1386: usaepay.BillingFirstName = aFirstLastNames(0)
Line 1387: usaepay.BillingLastName = aFirstLastNames(1)
Line 1388: Else
Line 1389: usaepay.BillingFirstName = fullName
Line 1390: End If
Line 1391:
Line 1392: usaepay.BillingCompany = company
Line 1393: usaepay.BillingStreet = street
Line 1394: usaepay.BillingStreet2 = aOrder(9)
Line 1395: usaepay.BillingCity = aOrder(10)
Line 1396: usaepay.BillingState = aOrder(11)
Line 1397: usaepay.BillingZip = zip
Line 1398:
Line 1399: If uSAePayMode = "test" Then
Line 1400: usaepay.Description = "Test Sale Transaction - TrxType: " + transactionType
Line 1401: Else
Line 1402: usaepay.Description = "Online Order"
Line 1403: End If
Line 1404:
Line 1405: Try
Line 1406: If transactionType = "A" Then ' aka Pre Authorization
Line 1407: usaepay.Command = "authonly"
Line 1408: usaepay.Process()
Line 1409: ElseIf transactionType = "S" Then ' aka Sale Transaction
Line 1410: usaepay.Sale()
Line 1411: Else
Line 1412: usaepay.Sale()
Line 1413: End If
Line 1414:
Line 1415: Catch ex As Exception
Line 1416:
Line 1417: End Try
Line 1418:
Line 1419: Dim message As String
Line 1420:
Line 1421: If usaepay.ResultCode = "A" Then
Line 1422: message = "Transaction approved" & vbLf _
Line 1423: & "Auth Code: " & usaepay.AuthCode & vbLf _
Line 1424: & "Ref Num: " & usaepay.ResultRefNum & vbLf _
Line 1425: & "AVS: " & usaepay.AvsResult & vbLf _
Line 1426: & "CVV: " & usaepay.Cvv2Result & vbLf & vbLf _
Line 1427: & "Request: " & usaepay.ResponseSize & " bytes" & vbLf _
Line 1428: & "Response: " & usaepay.RequestSize & " bytes"
Line 1429:
Line 1430: Session("refnumber") = usaepay.ResultRefNum
Line 1431: Session("authcode") = usaepay.AuthCode
Line 1432: Session("goyo") = True
Line 1433: usaepayvalid = True
Line 1434: Else
Line 1435:
Line 1436: If usaepay.ResultCode = "D" Then
Line 1437: message = "Transaction Declined" & vbLf _
Line 1438: & "Ref Num: " & usaepay.ResultRefNum & vbLf _
Line 1439: & "Error: " & usaepay.ErrorMesg & vbLf _
Line 1440: & "Error Code: " & usaepay.ErrorCode & vbLf
Line 1441:
Line 1442: Else
Line 1443: message = "Transaction Error" & vbLf _
Line 1444: & "Ref Num: " & usaepay.ResultRefNum & vbLf _
Line 1445: & "Error: " & usaepay.ErrorMesg & vbLf _
Line 1446: & "Error Code: " & usaepay.ErrorCode & vbLf
Line 1447:
Line 1448: End If
Line 1449:
Line 1450: Session("ccinvalidmessage") = "<font class=""head1"">Error Code: " & usaepay.ErrorCode & "<br /><br />Your credit card has not been processed!</font><br /><br />Your Transaction Response Code is: " & usaepay.ErrorMesg & ".<br /><br />Please correct your payment information or contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " with this information for assistance.</font>"
Line 1451: Session("errors") += 1
Line 1452:
Line 1453: End If
Line 1454:
Line 1455: Session("TEMPDEBUG_usaepayMessage") = message
Line 1456:
Line 1457: Catch ex As Exception
Line 1458:
Line 1459: Session("ccinvalidmessage") = "<font class=""head1"">Error: " & "<br /><br />Your credit card has not been processed! The credit card processor had an error on Step #" & ccProcessStep & ".<br /><br />Please try to enter your payment information again and if the problem persists, contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " with this information for assistance.</font>"
Line 1460: Session("errors") += 1
Line 1461: End Try
Line 1462:
Line 1463: Return usaepayvalid
Line 1464: End Function
Line 1465:
Line 1466: Function validateusaepayORIG(ByVal ccnum As String, ByVal ccsecurity As String, ByVal ccmonth As String, ByVal ccyear As String, ByVal cardholder As String, ByVal orderamount As String) As Boolean
Line 1467: 'Dim orderid As String = Session("getno")
Line 1468: Dim orderid As String = Session("orderid")
Line 1469: Dim dbservermanager As Object
Line 1470: Dim usaepayvalid As Boolean = False
Line 1471: Dim ccProcessStep As String = "Unknown"
Line 1472:
Line 1473: Try
Line 1474: ccProcessStep = "1"
Line 1475: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "Before dbservermanager CreateObject"
Line 1476:
Line 1477: ccProcessStep = "2"
Line 1478: dbservermanager = Server.CreateObject(getcomname())
Line 1479: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "After dbservermanager CreateObject"
Line 1480:
Line 1481: If IsNothing(dbservermanager) Then
Line 1482: ccProcessStep = "3"
Line 1483: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "dbservermanager is nothing"
Line 1484: End If
Line 1485:
Line 1486: Dim aItem As Object
Line 1487: Try
Line 1488: aItem = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_validateUSAepay", Server.MapPath(""), "getorderinfo", "EORDER", orderid)
Line 1489: Finally
Line 1490: System.Runtime.InteropServices.Marshal.ReleaseComObject(dbservermanager)
Line 1491: dbservermanager = Nothing
Line 1492: End Try
Line 1493:
Line 1494: Dim pono As String = CStr(aItem(27))
Line 1495: Dim street As String = CStr(aItem(8))
Line 1496: Dim city As String = CStr(aItem(10))
Line 1497: Dim state As String = CStr(aItem(11))
Line 1498: Dim zip As String = CStr(aItem(12))
Line 1499: Dim company As String = aItem(6)
Line 1500: Dim country As String = Session("bcountry")
Line 1501: Dim phone As String = aItem(20)
Line 1502: Dim email As String = aItem(41)
Line 1503:
Line 1504: If Len(ccmonth) = 1 Then
Line 1505: ccmonth = "0" & ccmonth
Line 1506: End If
Line 1507:
Line 1508: ccyear = Right(ccyear, 2)
Line 1509: Dim ccexp As String = ccmonth & ccyear
Line 1510: usaepayvalid = False
Line 1511:
Line 1512: ccProcessStep = "4"
Line 1513: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "Before USAePayXChargeCom2 CreateObject"
Line 1514: Dim XCharge1 As Object = Server.CreateObject("USAePayXChargeCom2.XChargeCom2")
Line 1515:
Line 1516: ccProcessStep = "5"
Line 1517: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "After USAePayXChargeCom2 CreateObject"
Line 1518:
Line 1519: If IsNothing(XCharge1) Then
Line 1520: ccProcessStep = "6"
Line 1521: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "XCharge1 is nothing"
Line 1522: End If
Line 1523:
Line 1524: If getxmlval("paypaltrxtype") = "A" Then
Line 1525: XCharge1.Command = 3
Line 1526: ElseIf getxmlval("paypaltrxtype") = "S" Then
Line 1527: XCharge1.Command = 0
Line 1528: End If
Line 1529: XCharge1.Sourcekey = getxmlval("usaepaykey")
Line 1530:
Line 1531: 'This allows fraud blocking on the customers IP address
Line 1532: Dim h1 As System.Web.HttpContext = System.Web.HttpContext.Current
Line 1533: XCharge1.IP = h1.Request.ServerVariables("REMOTE_ADDR")
Line 1534: XCharge1.Testmode = False 'Change this to False for the transaction to process
Line 1535: XCharge1.Card = ccnum 'Card number, no dashes, no spaces
Line 1536: XCharge1.Exp = ccexp 'Expiration date 4 digits
Line 1537: XCharge1.Amount = orderamount 'Charge amount in dollars
Line 1538: XCharge1.Invoice = pono 'Invoice number. must be unique.
Line 1539: XCharge1.TransHolderName = cardholder 'Name of card holder
Line 1540: XCharge1.Street = street 'Street address
Line 1541: XCharge1.Zip = zip 'Zip code
Line 1542: XCharge1.Description = "Online Order" 'Description of charge
Line 1543: XCharge1.CVV2 = ccsecurity 'CVV2 code
Line 1544: XCharge1.Process()
Line 1545:
Line 1546: If XCharge1.ErrorExists = True Then
Line 1547: Dim XError, conditional1 As Object
Line 1548: conditional1 = 0
Line 1549:
Line 1550: For Each XError In XCharge1.Errors
Line 1551: If conditional1 = 0 Then
Line 1552: Session("ccinvalidmessage") = "<font class=""head1"">Error Code: " & XError.ErrorCode & "<br /><br />Your credit card has not been processed!</font><br /><br />Your Transaction Response Code is: " & XError.ErrorText & ".<br /><br />Please correct your payment information or contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " with this information for assistance.</font>"
Line 1553: Session("errors") += 1
Line 1554: End If
Line 1555: conditional1 += 1
Line 1556: Next
Line 1557:
Line 1558: Else
Line 1559: Session("refnumber") = XCharge1.ResponseReferenceNum
Line 1560: Session("authcode") = XCharge1.ResponseAuthCode
Line 1561: Session("goyo") = True
Line 1562: usaepayvalid = True
Line 1563: End If
Line 1564:
Line 1565: Dim strResponseStatus As String
Line 1566:
Line 1567: Select Case XCharge1.ResponseStatus
Line 1568: 'Case "Approved"
Line 1569: Case 1
Line 1570: strResponseStatus = "Approved"
Line 1571: 'Case "Declined"
Line 1572: Case 3
Line 1573: strResponseStatus = "Declined"
Line 1574: 'Case "Verification"
Line 1575: Case 4
Line 1576: strResponseStatus = "Verification"
Line 1577: 'Case "Errors"
Line 1578: Case 5
Line 1579: strResponseStatus = "Error"
Line 1580: End Select
Line 1581:
Line 1582: ccProcessStep = "7"
Line 1583: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "Before set XCharge1 to nothing"
Line 1584:
Line 1585: ' Clear the component instance from memory
Line 1586: System.Runtime.InteropServices.Marshal.ReleaseComObject(XCharge1)
Line 1587: XCharge1 = Nothing
Line 1588:
Line 1589: ccProcessStep = "8"
Line 1590: Session("TEMPDEBUG_ValidateUSAePay_ecomCOM") = "After set XCharge1 to nothing"
Line 1591:
Line 1592: Catch ex As Exception
Line 1593:
Line 1594: Session("ccinvalidmessage") = "<font class=""head1"">Error: " & "<br /><br />Your credit card has not been processed! The credit card processor had an error on Step #" & ccProcessStep & ".<br /><br />Please try to enter your payment information again and if the problem persists, contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " with this information for assistance.</font>"
Line 1595:
Line 1596: Session("errors") += 1
Line 1597: End Try
Line 1598:
Line 1599: Return usaepayvalid
Line 1600:
Line 1601: End Function
Line 1602:
Line 1603: Function addwack(ByVal val As String) As String
Line 1604:
Line 1605: val = Trim(val)
Line 1606:
Line 1607: If Right(val, 1) <> "\" Then
Line 1608: Return val & "\"
Line 1609: Else
Line 1610: Return val
Line 1611: End If
Line 1612:
Line 1613: End Function
Line 1614:
Line 1615: Function addforwardslash(ByVal val As String) As String
Line 1616:
Line 1617: val = Trim(val)
Line 1618:
Line 1619: If Right(val, 1) <> "/" Then
Line 1620: Return val & "/"
Line 1621: Else
Line 1622: Return val
Line 1623: End If
Line 1624:
Line 1625: End Function
Line 1626:
Line 1627: Function getcarttotals() As Object
Line 1628: ' NOTE - if make a change here, make same change in _function.ascx > Private Function getcarttotals until all places in code are switched over to use this one
Line 1629: Dim pOrderid, aItem, aGrdTotal, aICount, aTax, aShipping, aSubtotal, duty, pointsSubtotal
Line 1630: pOrderid = Session("orderid")
Line 1631: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 1632:
Line 1633: aItem = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_Getcarttotals", Server.MapPath(""), "GetOrderInfo", "EORDER", pOrderid)
Line 1634:
Line 1635: dbservermanager = Nothing
Line 1636:
Line 1637: aGrdTotal = aItem(33) ' 0 Grand Total
Line 1638: aICount = aItem(49) '1 Item Count
Line 1639: aSubtotal = aItem(21) '2 Subtotal
Line 1640: aShipping = aItem(22) '3 Shipping
Line 1641: aTax = aItem(23) '4 Tax
Line 1642: duty = aItem(58) '5 Duty
Line 1643: pointsSubtotal = aItem(77) '6 Points Subtotal on Order
Line 1644:
Line 1645: Dim myObjArray() As Object = {aGrdTotal, aICount, aSubtotal, aShipping, aTax, duty, pointsSubtotal}
Line 1646:
Line 1647: Return myObjArray
Line 1648:
Line 1649: End Function
Line 1650:
Line 1651: Function showhtml(ByVal area As String) As String
Line 1652: Dim retval As String
Line 1653: If getxmlval(area) <> String.Empty Then
Line 1654: Try
Line 1655: If File.Exists(getxmlval(area)) Then
Line 1656: retval = getxmlval(area)
Line 1657: ElseIf File.Exists(Server.MapPath(getxmlval(area))) Then
Line 1658: retval = Server.MapPath(getxmlval(area))
Line 1659: Else
Line 1660: retval = String.Empty
Line 1661: End If
Line 1662: Catch ex As Exception
Line 1663: retval = String.Empty
Line 1664: End Try
Line 1665: Else
Line 1666: retval = String.Empty
Line 1667: End If
Line 1668: Return retval
Line 1669: End Function
Line 1670:
Line 1671: Function subsorsize(ByVal category As String, ByVal subcat As String) As String
Line 1672: Dim retval As String
Line 1673: Dim catsubval As String = getxmlval("cat" & category & "sub" & subcat & "itemmatrix")
Line 1674: Dim catval As String = getxmlval("cat" & category & "itemmatrix")
Line 1675: Dim allval As String = getxmlval("viewitemmatrix")
Line 1676: If catsubval = "All Subs" Then
Line 1677: retval = "subs"
Line 1678: ElseIf catsubval = "By Size" Then
Line 1679: retval = "size"
Line 1680: ElseIf catsubval = "All Subs W/Inventory" Then
Line 1681: retval = "inventory"
Line 1682: ElseIf catval = "All Subs" Then
Line 1683: retval = "subs"
Line 1684: ElseIf catval = "By Size" Then
Line 1685: retval = "size"
Line 1686: ElseIf catval = "All Subs W/Inventory" Then
Line 1687: retval = "inventory"
Line 1688: ElseIf allval <> String.Empty Then
Line 1689: retval = allval
Line 1690: Else
Line 1691: retval = "size"
Line 1692: End If
Line 1693:
Line 1694: Return retval
Line 1695: End Function
Line 1696:
Line 1697: Function CatSubcatOptions(ByVal category As String, ByVal subcat As String, ByVal optiontype As String) As String
Line 1698: Dim retval As String = String.Empty
Line 1699: Dim catsubval As String = getxmlval("cat" & category & "sub" & subcat & optiontype)
Line 1700: Dim catval As String = getxmlval("cat" & category & optiontype)
Line 1701: Dim allval As String = String.Empty
Line 1702:
Line 1703: Select Case optiontype
Line 1704: Case "sizecaption"
Line 1705: allval = "Size"
Line 1706: Case "colorcaption"
Line 1707: allval = "Color"
Line 1708: End Select
Line 1709:
Line 1710: If catsubval <> String.Empty Then
Line 1711: retval = catsubval
Line 1712: ElseIf catval <> String.Empty Then
Line 1713: retval = catval
Line 1714: Else
Line 1715: retval = allval
Line 1716: End If
Line 1717:
Line 1718: Return retval
Line 1719: End Function
Line 1720:
Line 1721: Function iscloseout(ByVal category As String, ByVal subcat As String, ByVal Itemno As String, ByVal Subno As String) As String
Line 1722: Dim retval As String = "No"
Line 1723:
Line 1724: ' No closeout code that I know of in SB so just comment out for now
Line 1725: Dim catsubval As String = getxmlval("cat" & category & "sub" & subcat & "closeout")
Line 1726: Dim catval As String = getxmlval("cat" & category & "closeout")
Line 1727: If catsubval <> String.Empty Then
Line 1728: retval = catsubval
Line 1729: ElseIf catval <> String.Empty Then
Line 1730: retval = catval
Line 1731: Else
Line 1732: retval = "No"
Line 1733: End If
Line 1734:
Line 1735: If Itemno <> String.Empty Then
Line 1736: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 1737: Dim itMast As Object
Line 1738: Dim sesGetItemMastInfo As String = "GetItemMastInfo:" & getxmlval("sprogram") & "|" & Trim(Itemno) & "|" & Session("itemcust")
Line 1739: If Session("cisson") = False OrElse Session(sesGetItemMastInfo) Is Nothing OrElse (getSoftwareProductType() = "ASISB" Or CheckItemChanged("GetItemMastInfo", Trim(Itemno), String.Empty, Session("itemcust"))) Then
Line 1740: If getSoftwareProductType() <> "ASISB" Then
Line 1741: itMast = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetItemMastInfo", "baseandsub", getxmlval("sprogram"), Itemno, String.Empty, Session("itemcust"))
Line 1742: Else
Line 1743: itMast = ecomwrapperGetItemInfo(Itemno, getxmlval("sprogram"), Session("itemcust"), "_")
Line 1744: End If
Line 1745: Session(sesGetItemMastInfo) = itMast
Line 1746: Else
Line 1747: itMast = Session(sesGetItemMastInfo)
Line 1748: End If
Line 1749: dbservermanager = Nothing
Line 1750: If getSoftwareProductType() <> "ASISB" Then
Line 1751: If itMast.rank = 2 Then
Line 1752: If Trim(Subno) <> String.Empty Then
Line 1753: For x As Integer = 2 To UBound(itMast)
Line 1754: If itMast(x, 1) = Subno Then
Line 1755: If itMast(x, 2) = "DS" Or itMast(x, 2) = "MC" Or itMast(x, 3) = "DS" Then
Line 1756: retval = "No"
Line 1757: Exit For
Line 1758: End If
Line 1759: End If
Line 1760: Next
Line 1761: Else
Line 1762: If itMast(1, 2) = "DS" Or itMast(1, 2) = "MC" Or itMast(1, 3) = "DS" Then
Line 1763: retval = "No"
Line 1764: End If
Line 1765: End If
Line 1766: End If
Line 1767: Else ' getSoftwareProductType() <> "ASISB"
Line 1768: ' if methodofinventory is DS then return "No
Line 1769: If UBound(itMast) > 0 Then
Line 1770: If itMast(1, 41) = "DS" Then
Line 1771: retval = "No"
Line 1772: End If
Line 1773: Else
Line 1774: retval = "No"
Line 1775: End If
Line 1776: End If
Line 1777: End If
Line 1778:
Line 1779: Return retval
Line 1780: End Function
Line 1781:
Line 1782: Function checkcatpermission(ByVal cat As String, ByVal subcat As String) As Boolean
Line 1783: Dim retval As Boolean = True
Line 1784: Dim permissions As String = UCase(Session("loginpermissions"))
Line 1785: Dim loggedin As Boolean = Session("loggedin")
Line 1786: Dim catcode As String = UCase(getxmlval("cat" & cat & "code"))
Line 1787: Dim subcatcode As String = getxmlval("cat" & cat & "subcode" & subcat)
Line 1788: If getxmlval("restrictedcatson") = "Y" Then
Line 1789: If getxmlval("cat" & cat & "restrictpermissions") = "R" Then
Line 1790: 'LOGGED IN
Line 1791: If loggedin = False Then
Line 1792: If getxmlval("restrictedcatshowbeforelogin") <> "Y" Then
Line 1793: retval = False
Line 1794: End If
Line 1795: 'NOT LOGGED IN
Line 1796: ElseIf InStr(permissions, catcode) = 0 Then
Line 1797: retval = False
Line 1798: End If
Line 1799: End If
Line 1800:
Line 1801: If retval = True And subcat <> "0" AndAlso subcatcode <> String.Empty And getxmlval("cat" & cat & "sub" & subcat & "restrictpermissions") = "R" Then
Line 1802: 'LOGGED IN
Line 1803: If loggedin = False Then
Line 1804: If getxmlval("restrictedcatshowbeforelogin") <> "Y" Then
Line 1805: retval = False
Line 1806: End If
Line 1807: 'NOT LOGGED IN
Line 1808: ElseIf InStr(permissions, subcatcode) = 0 Then
Line 1809: retval = False
Line 1810: End If
Line 1811: End If
Line 1812: End If
Line 1813: Return retval
Line 1814: End Function
Line 1815: 'Use this if the sender isn't passed
Line 1816: Overloads Function filterInput(ByVal input As String) As String
Line 1817: Dim output As String = String.Empty
Line 1818: If Not input Is Nothing Then
Line 1819: Dim anregex As New Regex("[^0-9a-zA-Z\ -]")
Line 1820: If anregex.IsMatch(input) Then
Line 1821: Session("filtercatch") += "<li>Invalid input. </li>"
Line 1822: End If
Line 1823: output = anregex.Replace(input, "")
Line 1824: End If
Line 1825: Return output
Line 1826: End Function
Line 1827:
Line 1828: 'Use this if the sender is passed, or the regex is unique. More useful if the consumer will need to be notified
Line 1829: 'that their input has changed, such as an invalid input on a username or password
Line 1830: Overloads Function filterInput(ByVal input As String, ByVal wRegex As String, ByVal sender As String) As String
Line 1831: Dim output As String = String.Empty
Line 1832: If Not input Is Nothing Then
Line 1833:
Line 1834: Dim myregex As Regex
Line 1835: Select Case wRegex
Line 1836: Case "alpha"
Line 1837: myregex = New Regex("[^a-zA-Z\ " & getxmlval("inputexcepalpha") & "]")
Line 1838: Case "numeric"
Line 1839: myregex = New Regex("[^0-9\.\ " & getxmlval("inputexcepnumeric") & "]")
Line 1840: Case "AN"
Line 1841: myregex = New Regex("[^\w\ " & getxmlval("inputexcepalphanumeric") & "]")
Line 1842: Case "datetime"
Line 1843: myregex = New Regex("[^0-9 apmAPM\ :/" & getxmlval("inputexcepdatetime") & "]")
Line 1844: Case "address"
Line 1845: myregex = New Regex("[^\w \.\ #,&-" & getxmlval("inputexcepaddress") & "]")
Line 1846: Case "email"
Line 1847: myregex = New Regex("[^\w@\._\-'" & getxmlval("inputexcepemail") & "]")
Line 1848: Case "hash"
Line 1849: myregex = New Regex("[^\w\ =&%+/" & getxmlval("inputexcephash") & "]")
Line 1850: Case "phone"
Line 1851: myregex = New Regex("[^\w\-\.\ /()*" & getxmlval("inputexcepphone") & "]")
Line 1852: Case "password"
Line 1853: myregex = New Regex("[^\w@\._\-@%_+=,#!$&" & getxmlval("inputexceppassword") & "]")
Line 1854: Case "url"
Line 1855: myregex = New Regex("[^\w \.?#:/&=%" & getxmlval("inputexcepurl") & "]")
Line 1856: Case "querystring"
Line 1857: myregex = New Regex("[^\w?&=@%/\ :+\-\." & getxmlval("inputexcepquerystring") & "]")
Line 1858: Case "everything"
Line 1859: myregex = New Regex("[^\w\._\-\\@%_+=,\ ?#:/!$&()[]" & getxmlval("inputexcepeverything") & "]")
Line 1860: Case "blacklist"
Line 1861: Dim allowBehavior As String = "behavior|"
Line 1862: If getxmlval("inputexcepallowbehavior") = "Y" Then
Line 1863: allowBehavior = String.Empty
Line 1864: End If
Line 1865:
Line 1866: Dim allowExpression As String = "expression|"
Line 1867: If getxmlval("inputexcepallowexpression") = "Y" Then
Line 1868: allowExpression = String.Empty
Line 1869: End If
Line 1870: myregex = New Regex("(?i)(<script>|<object>|javascript|obabort|onblur|onchange|onclick|ondblclick|onerror|onfocus|onkeydown|onkeypress|onkeyup|onload|onmousedown|onmousemove|onmouseout|onmouseup|onreset|onresize|onselect|onsubmit|onunload|<embed>|" & allowBehavior & allowExpression & "src" & getxmlval("inputexcepblacklist") & ")")
Line 1871:
Line 1872: End Select
Line 1873: output = myregex.Replace(input, "")
Line 1874: If myregex.IsMatch(input) Then
Line 1875: Session("filtercatch") += "<li>Invalid input or characters from " & sender & ". </li>"
Line 1876: output = String.Empty
Line 1877: End If
Line 1878:
Line 1879: End If
Line 1880: 'Session("antixss") = Microsoft.Security.Application.AntiXss.GetSafeHtmlFragment("<form name=""frm"" method=""post""><font class=""head1"">Hi</font><br/><br/>")
Line 1881:
Line 1882: Return output
Line 1883: End Function
Line 1884: 'TO ZERO INTEGER - if a zero integer is expected, but filterInput is producing an empty string
Line 1885: Function tzi(ByVal input As String) As Integer
Line 1886: Dim retval As Integer
Line 1887: If input = String.Empty Then
Line 1888: retval = 0
Line 1889: Else
Line 1890: Try
Line 1891: retval = CInt(input)
Line 1892: Catch ex As System.FormatException
Line 1893: Session("filtercatch") += "<li>Invalid input. </li>"
Line 1894: End Try
Line 1895:
Line 1896: End If
Line 1897: Return retval
Line 1898:
Line 1899: End Function
Line 1900:
Line 1901: Sub filtercatch()
Line 1902: If Session("filtercatch") <> String.Empty And (getxmlval("invalidinputfeedback") <> "N") Then
Line 1903: r1.Response.Write("<font color=""" & Session("errormsgcolor") & """><b>A Problem Occurred:</b></font><br /><br />" & Session("filtercatch") & "Please go <span class=""backlink""><a href=""javascript: history.back(1);"">back</a></span> and correct this.")
Line 1904: Session.Remove("filtercatch")
Line 1905: r1.Response.End()
Line 1906: Else
Line 1907: Session.Remove("filtercatch")
Line 1908: End If
Line 1909:
Line 1910: End Sub
Line 1911:
Line 1912: Function getsubcats(ByVal category As String) As String
Line 1913: Dim subcatlist As String
Line 1914: For t As Integer = 1 To 30
Line 1915: If getxmlval("cat" & category & "subcode" & t) <> String.Empty Then
Line 1916: subcatlist &= "," & catrightlength(getxmlval("cat" & category & "subcode" & t))
Line 1917: End If
Line 1918: Next
Line 1919: Return subcatlist
Line 1920: End Function
Line 1921:
Line 1922: Function catrightlength(ByVal catcode As String) As String
Line 1923: If Len(catcode) = "2" Then
Line 1924: catcode += " "
Line 1925: ElseIf Len(catcode) = "1" Then
Line 1926: catcode += " "
Line 1927: End If
Line 1928: Return catcode
Line 1929: End Function
Line 1930: Function reformatcurrency(ByVal price) As String
Line 1931:
Line 1932: Dim currencysymbol As String = getcurrencysymbol()
Line 1933:
Line 1934: If currencysymbol <> "$" Then
Line 1935: price = Replace(price, "$", currencysymbol)
Line 1936: End If
Line 1937:
Line 1938: If getxmlval("currencysymbolplacement") = "afteramt" Or getxmlval("currencysymbol") = "label" Then
Line 1939: price = Replace(price, currencysymbol, "") & currencysymbol
Line 1940: End If
Line 1941:
Line 1942: If getxmlval("currencyremovezeroes") = "Y" Then
Line 1943: If getxmlval("currencyformat") = 3 Then
Line 1944: price = Replace(price, ".000", "")
Line 1945: Else
Line 1946: price = Replace(price, ".00", "")
Line 1947: End If
Line 1948:
Line 1949: End If
Line 1950:
Line 1951: Return price
Line 1952:
Line 1953: End Function
Line 1954: Function getcurrencysymbol() As String
Line 1955:
Line 1956: Dim currencysymbol As String
Line 1957: Dim currencytype As String = getxmlval("currencysymbol")
Line 1958:
Line 1959: If currencytype = "dollar" Or currencytype = String.Empty Then
Line 1960: currencysymbol = "$"
Line 1961: ElseIf currencytype = "euro" Then
Line 1962: currencysymbol = "€"
Line 1963: ElseIf currencytype = "hkd" Then
Line 1964: currencysymbol = "HK$"
Line 1965: ElseIf currencytype = "pound" Then
Line 1966: currencysymbol = "£"
Line 1967: ElseIf currencytype = "yen" Then
Line 1968: currencysymbol = "¥"
Line 1969: ElseIf currencytype = "label" And getxmlval("currencylabel") <> String.Empty Then
Line 1970: currencysymbol = " " & getxmlval("currencylabel")
Line 1971: Else
Line 1972: currencysymbol = "$"
Line 1973: End If
Line 1974:
Line 1975: Return currencysymbol
Line 1976:
Line 1977: End Function
Line 1978:
Line 1979: Function addtologinhist(ByVal login As String, ByVal pwd As String, ByVal status As String) As Boolean
Line 1980: Dim retval As Boolean = False
Line 1981: If getxmlval("loginhistory") = "Y" Then
Line 1982: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 1983: Dim Action As String = "Add"
Line 1984: Dim ip As String = r1.Request.ServerVariables("REMOTE_HOST")
Line 1985: Dim browser As String = r1.Request.ServerVariables("HTTP_USER_AGENT")
Line 1986: Dim site As String = "http://" & r1.Request.ServerVariables("SERVER_NAME") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 1987: site = site.Replace("default.aspx", "")
Line 1988: site = replaceHTTPS(site)
Line 1989: If getxmlval("pwdinloginhist") = "N" Then
Line 1990: pwd = String.Empty
Line 1991: End If
Line 1992: Dim dotdot As String = IIf(InStr(r1.Request.ServerVariables("SCRIPT_NAME"), "/admin/") > 0, "..", String.Empty)
Line 1993: Dim lha As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dotdot), "loginhistoryadmin", Action, login, ip, browser, site, status, , pwd)
Line 1994:
Line 1995: If lha = "success" Then
Line 1996: retval = True
Line 1997: End If
Line 1998:
Line 1999: dbservermanager = Nothing
Line 2000: End If
Line 2001: Return retval
Line 2002: End Function
Line 2003:
Line 2004: Function removespaces(ByVal input As String) As String
Line 2005: input = input.Replace("\ ", "\")
Line 2006: input = input.Replace(" \", "\")
Line 2007: input = input.Replace("/ ", "/")
Line 2008: input = input.Replace(" /", "/")
Line 2009: Return input
Line 2010: End Function
Line 2011:
Line 2012: Function postformbuild(ByVal website As String, ByVal login As String, ByVal pwd As String) As String
Line 2013: Dim postform As New StringBuilder()
Line 2014: postform.Append("<html><body onload=""javascript:document.forms.frm.submit() "">")
Line 2015: postform.Append("<form name=""frm"" action=""" & website & "default.aspx?p=login&submitok=Submit"" method=""post"" >")
Line 2016: postform.Append("<input type=""hidden"" name=""login"" value=""" & login & """/>")
Line 2017: postform.Append("<input type=""hidden"" name=""pwd"" value=""" & pwd & """/>")
Line 2018: postform.Append("</form></body></html>")
Line 2019: Return postform.ToString()
Line 2020: End Function
Line 2021:
Line 2022: Function determinelockout(ByVal login As String, ByVal pwd As String, ByVal admin As Boolean) As Boolean
Line 2023: Dim islockout As Boolean = False
Line 2024: Dim adminprefix As String = IIf(admin, "admin", String.Empty)
Line 2025: Dim lockoutmins As Integer = IIf(getxmlval(adminprefix & "lockoutminutes") <> String.Empty, getxmlval(adminprefix & "lockoutminutes"), 10)
Line 2026: Dim lockoutuntil As Date
Line 2027: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2028: Dim lockoutdate As Object
Line 2029: If admin = "true" Then
Line 2030: lockoutdate = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(".."), "GetEAdmnlogLockoutDate", login)
Line 2031: Else
Line 2032: lockoutdate = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetLockoutDateTime", login)
Line 2033: End If
Line 2034:
Line 2035: Dim existinglockoutuntil As Date
Line 2036: If IsDate(lockoutdate) Then
Line 2037: existinglockoutuntil = DateAdd("n", lockoutmins, lockoutdate)
Line 2038: End If
Line 2039:
Line 2040: If (IsDate(Session(adminprefix & "loginlockedout" & login))) And (Session(adminprefix & "loginlockedout" & login) >= Now) Then
Line 2041: islockout = True
Line 2042: Session.Remove(adminprefix & "loginfail" & login)
Line 2043: ElseIf IsDate(lockoutdate) And existinglockoutuntil >= Now Then
Line 2044: islockout = True
Line 2045: Session("loginlockedout" & login) = existinglockoutuntil
Line 2046: Session.Remove(adminprefix & "loginfail" & login)
Line 2047: ElseIf getxmlval(adminprefix & "numloginfails") <> String.Empty AndAlso Session(adminprefix & "loginfail" & login) >= getxmlval(adminprefix & "numloginfails") Then
Line 2048: islockout = True
Line 2049: lockoutuntil = DateAdd("n", lockoutmins, Now())
Line 2050:
Line 2051: Dim uldt As Object
Line 2052: If admin = "true" Then
Line 2053: uldt = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(".."), "UpdateEAdmnlogLockoutDate", login, Now.ToString())
Line 2054: Else
Line 2055: uldt = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateLockoutDateTime", login, Now.ToString())
Line 2056: End If
Line 2057:
Line 2058: addtologinhist(login, pwd, adminprefix & "Login:Locked Out")
Line 2059:
Line 2060: Session.Remove(adminprefix & "loginfail" & login)
Line 2061: Session(adminprefix & "loginlockedout" & login) = lockoutuntil
Line 2062: r1.Response.Write("<font color=""" & Session("errormsgcolor") & """><b>A Problem Occurred:</b></font><br /><br />This account has been locked out. Please contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " for assistance.")
Line 2063: Else
Line 2064: Session.Remove("loginlockedout" & login)
Line 2065: End If
Line 2066: dbservermanager = Nothing
Line 2067: Return islockout
Line 2068: End Function
Line 2069:
Line 2070: ''' a changedate of "01/01/90" means that this is the second login after a password reset, the password is still random, and a hard lockout is required
Line 2071: ''' a changedate of "01/01/00"
Line 2072: ''' means that this follows a password reset, and the password is still random
Line 2073: Sub ispwdtooold(ByVal login As String, ByVal pwd As String, ByVal admin As Boolean)
Line 2074: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2075: Dim adminprefix As String = IIf(admin, "admin", String.Empty)
Line 2076:
Line 2077: If getxmlval(adminprefix & "maxpwdage") <> String.Empty Then
Line 2078: Dim getpwdage As Object
Line 2079: If admin = "true" Then
Line 2080: getpwdage = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(".."), "EAdmnLogAdmin", "View", login, pwd)
Line 2081: Else
Line 2082: getpwdage = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "LoginAdmin", "view", login, pwd)
Line 2083: End If
Line 2084:
Line 2085: Dim pwdchangedate As Object = getpwdage(IIf(admin, 9, 42))
Line 2086: If Trim(pwdchangedate) <> String.Empty AndAlso IsDate(pwdchangedate) Then
Line 2087:
Line 2088: Dim maxpwdageval As Integer = getxmlval(adminprefix & "maxpwdage")
Line 2089: If pwdchangedate.ToString() = "01/01/90" Then
Line 2090: 'hardLockout(login, admin)
Line 2091:
Line 2092: addtologinhist(login, pwd, adminprefix & "Login:Password was not changed")
Line 2093: ElseIf (getxmlval("adminemaillinkvital") = "Y" And pwdchangedate.ToString() = "01/01/00" And Session("admincode") = String.Empty) And admin = True Then
Line 2094: 'hardLockout(login, admin)
Line 2095: Session("youmustchangepwd") = True
Line 2096: addtologinhist(login, pwd, adminprefix & "Login:changepwd")
Line 2097: ElseIf pwdchangedate.ToString() = "01/01/00" Then
Line 2098: Session(adminprefix & "forcechange") = "true"
Line 2099: adminlastchangedate(login, pwd, "01/01/90")
Line 2100: Session("youmustchangepwd") = True
Line 2101: ElseIf DateAdd("D", maxpwdageval, pwdchangedate) <= Now.ToString() Then
Line 2102: Session(adminprefix & "forcechange") = "true"
Line 2103: End If
Line 2104: End If
Line 2105: End If
Line 2106:
Line 2107: dbservermanager = Nothing
Line 2108: End Sub
Line 2109: Function adminlastchangedate(ByVal login As String, ByVal pwd As String, ByVal chngdate As String)
Line 2110: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2111: Dim getvals As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(".."), "EAdmnLogAdmin", "View", login, pwd)
Line 2112: Dim aOutp As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(".."), "EAdmnLogAdmin", "edit", login, getvals(2), getvals(2), getvals(3), getvals(3), getvals(5), getvals(6), getvals(7), getvals(8), chngdate, , getvals(11), getvals(12), getvals(13), getvals(14), getvals(15), getvals(16))
Line 2113: Dim retval As String = IIf(Not (aOutp(1) Is Nothing), aOutp(1), String.Empty)
Line 2114: Return retval
Line 2115: End Function
Line 2116:
Line 2117: Sub hardLockout(ByVal login As String, ByVal admin As Boolean)
Line 2118: Dim lockoutuntil As String = DateAdd("yyyy", 20, Now())
Line 2119: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2120: Dim dolockout As Object
Line 2121: If admin = "true" Then
Line 2122: dolockout = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(".."), "UpdateEAdmnlogLockoutDate", login, lockoutuntil)
Line 2123: Else
Line 2124: dolockout = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateLockoutDateTime", login, lockoutuntil)
Line 2125: End If
Line 2126:
Line 2127: Dim adminprefix As String = IIf(admin, "admin", String.Empty)
Line 2128: Session(adminprefix & "loginlockedout" & login) = lockoutuntil
Line 2129: r1.Response.Write("<font color=""" & Session("errormsgcolor") & """><b>A Problem Occurred:</b></font><br /><br />This account has been locked out. Please contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " for assistance.")
Line 2130:
Line 2131: IIf(admin, addtologinhist(login, String.Empty, "Admin:Login:Locked Out"), addtologinhist(login, String.Empty, "Login:Locked Out"))
Line 2132: If admin Then
Line 2133: newRandomPassword(login)
Line 2134: End If
Line 2135:
Line 2136: End Sub
Line 2137: Sub usessl()
Line 2138: If getxmlval("adminssl") = "Y" Then
Line 2139: Dim https As String = r1.Request.ServerVariables("HTTPS")
Line 2140: Dim qstr As String = filterInput(r1.Request.ServerVariables("QUERY_STRING"), "querystring", "Querystring")
Line 2141: Dim redir As String = "http://" & r1.Request.ServerVariables("SERVER_NAME") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 2142:
Line 2143: If qstr <> "" Then
Line 2144: redir += "?" & qstr
Line 2145: End If
Line 2146: If https = "off" Then
Line 2147: redir = Replace(redir, "http://", "https://")
Line 2148: r1.Response.Redirect(redir)
Line 2149: End If
Line 2150:
Line 2151:
Line 2152: End If
Line 2153: End Sub
Line 2154: Sub formerror(ByVal code As String)
Line 2155:
Line 2156: r1.Response.Write("<font color=""" & Session("errormsgcolor") & """><b>A Problem Occurred:</b></font><br /><br />" & code & "")
Line 2157:
Line 2158: End Sub
Line 2159: Sub formsuccess(ByVal code As String)
Line 2160:
Line 2161: r1.Response.Write("<font color=""" & Session("successmsgcolor") & """><b>Success!</b></font><br /><br />" & code & "")
Line 2162:
Line 2163: End Sub
Line 2164: Function badstring(ByVal code As String) As Boolean
Line 2165:
Line 2166: If InStr(code, Chr(34)) <> 0 Then
Line 2167: Return True
Line 2168: Else
Line 2169: Return False
Line 2170: End If
Line 2171:
Line 2172: End Function
Line 2173: Function RegExpPassword(ByVal mypassword As String) As Boolean
Line 2174:
Line 2175: 'Dim pattern As String = "^.*(?=.{7,})(?=.*\d)(?=.*[a-z])(?=.*[A-Z])(?=.*[@#$%^&+=]).*$"
Line 2176: Dim Min As String = IIf(getxmlval("passwordminchars") <> String.Empty, getxmlval("passwordminchars"), "1")
Line 2177:
Line 2178: Dim Upper As String = "^.*(?=.*[A-Z]).*$"
Line 2179: Dim Lower As String = "^.*(?=.*[a-z]).*$"
Line 2180: Dim Numerals As String = "^.*(?=.*\d).*$"
Line 2181: Dim NonAlphanumeric As String = "^.*(?=.*[@%_+=,]).*$"
Line 2182: Dim MinChars As String = "^.*(?=.{"
Line 2183: MinChars += Min
Line 2184: MinChars += ",}).*$"
Line 2185:
Line 2186: 'Dim re As Regex = New Regex(pattern)
Line 2187:
Line 2188: Dim UpperRe As Regex = New Regex(Upper)
Line 2189: Dim LowerRe As Regex = New Regex(Lower)
Line 2190: Dim NumeralsRe As Regex = New Regex(Numerals)
Line 2191: Dim NonAlphanumericRe As Regex = New Regex(NonAlphanumeric)
Line 2192: Dim MinCharsRe As Regex = New Regex(MinChars)
Line 2193:
Line 2194: Dim MatchCount As Integer = 0
Line 2195: Dim Result As Boolean = True
Line 2196: Dim MatchSome As Boolean = True
Line 2197: Dim MatchUpper As Boolean = True
Line 2198: Dim MatchLower As Boolean = True
Line 2199: Dim MatchNumeral As Boolean = True
Line 2200: Dim MatchNonAlphaNum As Boolean = True
Line 2201: Dim MatchMinChars As Boolean = True
Line 2202:
Line 2203:
Line 2204: If mypassword <> "" Then
Line 2205:
Line 2206: If (UpperRe.IsMatch(mypassword)) Then
Line 2207: MatchCount += 1
Line 2208: ElseIf (Not (UpperRe.IsMatch(mypassword))) And (getxmlval("passwordupper") = "Y") Then
Line 2209: MatchUpper = False
Line 2210: End If
Line 2211:
Line 2212: If (LowerRe.IsMatch(mypassword)) Then
Line 2213: MatchCount += 1
Line 2214: ElseIf (Not (LowerRe.IsMatch(mypassword))) And (getxmlval("passwordlower") = "Y") Then
Line 2215: MatchLower = False
Line 2216: End If
Line 2217:
Line 2218: If (NumeralsRe.IsMatch(mypassword)) Then
Line 2219: MatchCount += 1
Line 2220: ElseIf (Not (NumeralsRe.IsMatch(mypassword))) And (getxmlval("passwordnumeric") = "Y") Then
Line 2221: MatchNumeral = False
Line 2222: End If
Line 2223:
Line 2224: If (NonAlphanumericRe.IsMatch(mypassword)) Then
Line 2225: MatchCount += 1
Line 2226: ElseIf (Not (NonAlphanumericRe.IsMatch(mypassword))) And (getxmlval("passwordnonalphanum") = "Y") Then
Line 2227: MatchNonAlphaNum = False
Line 2228: End If
Line 2229:
Line 2230: If (MinCharsRe.IsMatch(mypassword)) And (getxmlval("passwordminchars") <> "N") Or (getxmlval("passwordminchars") = "N") Then
Line 2231: 'do nothing
Line 2232: Else
Line 2233: MatchMinChars = False
Line 2234: End If
Line 2235:
Line 2236: If (MatchCount < 2) And getxmlval("passwordmatchsome") = "Two" Then
Line 2237: MatchSome = False
Line 2238: ElseIf (MatchCount < 3) And getxmlval("passwordmatchsome") = "Three" Then
Line 2239: MatchSome = False
Line 2240: End If
Line 2241:
Line 2242: If (MatchSome = False) OrElse (MatchUpper = False) OrElse (MatchLower = False) OrElse (MatchNumeral = False) OrElse (MatchNonAlphaNum = False) OrElse (MatchMinChars = False) Then
Line 2243: Result = False
Line 2244: End If
Line 2245:
Line 2246: Else
Line 2247: Result = False
Line 2248: End If
Line 2249:
Line 2250: Return Result
Line 2251: End Function
Line 2252:
Line 2253: Function newRandomPassword(ByVal login As String) As String
Line 2254: Dim retval As String = String.Empty
Line 2255: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2256: Dim minpwdlen As Integer = IIf(getxmlval("passwordminchars") <> String.Empty, getxmlval("passwordminchars"), 8)
Line 2257: Dim newpwd As String = RandomPassword.Generate(minpwdlen, 10)
Line 2258: Dim newpwdtodb As String = IIf(getxmlval("adminhashpwds") = "Y", ComputeHash(newpwd), newpwd)
Line 2259: Dim forgotPW As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(".."), "ForgotEAdmnPassword", login)
Line 2260: Dim oldpwd As String = forgotPW(1) '''check
Line 2261: Dim getpwdinfo As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(".."), "EAdmnLogAdmin", "view", login, oldpwd)
Line 2262: Dim aOutp As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(".."), "ChangeEAdminLogPassword", login, oldpwd, newpwdtodb, oldpwd, getpwdinfo(5), getpwdinfo(6), getpwdinfo(7), Now.ToString())
Line 2263: dbservermanager = Nothing
Line 2264: retval = IIf(aOutp <> "Changed Successfully", "Not successful", newpwd)
Line 2265: Return retval
Line 2266:
Line 2267: End Function
Line 2268: Function checkexpire(ByVal expire As Date, ByVal intervalscope As String, ByVal intervalnum As Integer) As Boolean
Line 2269: Dim isexpired As Boolean
Line 2270: Dim nowstamp As Date = Now()
Line 2271: Dim interval As DateInterval
Line 2272:
Line 2273: Select Case intervalscope
Line 2274: Case "yyyy"
Line 2275: interval = DateInterval.Year
Line 2276: Case "q"
Line 2277: interval = DateInterval.Quarter
Line 2278: Case "m"
Line 2279: interval = DateInterval.Month
Line 2280: Case "y"
Line 2281: interval = DateInterval.DayOfYear
Line 2282: Case "d"
Line 2283: interval = DateInterval.Day
Line 2284: Case "w"
Line 2285: interval = DateInterval.Weekday
Line 2286: Case "ww"
Line 2287: interval = DateInterval.WeekOfYear
Line 2288: Case "h"
Line 2289: interval = DateInterval.Hour
Line 2290: Case "n"
Line 2291: interval = DateInterval.Minute
Line 2292: Case "s"
Line 2293: interval = DateInterval.Second
Line 2294:
Line 2295: End Select
Line 2296: If DateDiff(interval, expire, nowstamp) > intervalnum Then
Line 2297: isexpired = True
Line 2298: Else
Line 2299: isexpired = False
Line 2300: End If
Line 2301:
Line 2302: Return isexpired
Line 2303:
Line 2304: End Function
Line 2305:
Line 2306: Overloads Sub checkadmin()
Line 2307: If getxmlval("passadmin") = "Y" Then
Line 2308: If Not Session("goadmin") Then
Line 2309: r1.Response.Redirect("default.aspx")
Line 2310: ElseIf Session("adminforcechange") = "true" And InStr(r1.Request.ServerVariables("SCRIPT_NAME"), "changepwd") = 0 Then
Line 2311: r1.Response.Redirect("changepwd.aspx")
Line 2312: End If
Line 2313: End If
Line 2314: End Sub
Line 2315: Overloads Sub checkadmin(ByVal top As Boolean)
Line 2316: If getxmlval("passadmin") = "Y" Then
Line 2317: If Not Session("goadmin") Then
Line 2318: r1.Response.Redirect("default.aspx")
Line 2319: ElseIf Not Session("masteradmin") And CheckAdminDb() = "master admin exists" Then
Line 2320: Session("accesscatch") = "<div style=""color:red; padding:15px; font-size:2em;"">You do not have permission to access that page. </div>"
Line 2321: r1.Response.Redirect("default.aspx")
Line 2322: ElseIf Session("adminforcechange") = "true" And InStr(r1.Request.ServerVariables("SCRIPT_NAME"), "changepwd") = 0 Then
Line 2323: r1.Response.Redirect("changepwd.aspx")
Line 2324: End If
Line 2325: End If
Line 2326: End Sub
Line 2327:
Line 2328: Function CheckAdminDb() As String
Line 2329: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2330: Dim aOutp As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(".."), "EAdmnLogList", "ALL", "ALL")
Line 2331: Dim retval As String = "no records"
Line 2332: If aOutp.rank = 2 Then
Line 2333: retval = "no master admin"
Line 2334: For record As Integer = LBound(aOutp) To UBound(aOutp)
Line 2335: If aOutp(record, 15) = "Y" Then
Line 2336: retval = "master admin exists"
Line 2337: Exit For
Line 2338: End If
Line 2339: Next
Line 2340:
Line 2341: End If
Line 2342: Return retval
Line 2343: End Function
Line 2344:
Line 2345:
Line 2346: Function RegExpEmail(ByVal email As String) As Boolean
Line 2347: Dim pattern As String = "^[\w-\.\']{1,}\@([\da-zA-Z-]{1,}\.){1,}[\da-zA-Z-]{2,}$"
Line 2348: Dim re As Regex = New Regex(pattern)
Line 2349:
Line 2350: If email <> "" Then
Line 2351: If re.IsMatch(email) Then
Line 2352: Return True
Line 2353: End If
Line 2354: End If
Line 2355:
Line 2356: Return False
Line 2357: End Function
Line 2358:
Line 2359: Function getABAddressList(ByVal login As String, ByVal admin As Boolean) As String
Line 2360:
Line 2361: Dim sbAdTable As New StringBuilder()
Line 2362: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2363: Dim dotdot As String = String.Empty
Line 2364: If admin = True Then
Line 2365: dotdot = ".."
Line 2366: End If
Line 2367: Dim aAddresses As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "ELoginShipToList", login)
Line 2368:
Line 2369: If aAddresses IsNot Nothing Then
Line 2370: If aAddresses.rank = 2 Then
Line 2371: sbAdTable.Append("<option value=""notselected"">--Please Select One--</option>")
Line 2372: For ae As Integer = LBound(aAddresses) To UBound(aAddresses)
Line 2373: Dim selected As String = String.Empty
Line 2374: If aAddresses(ae, 2) = Session("abAddrID") Then
Line 2375: selected = " selected=""selected"" "
Line 2376: End If
Line 2377: sbAdTable.Append("<option value=""" & aAddresses(ae, 2) & """" & selected & " >" & aAddresses(ae, 2) & "</option>")
Line 2378: Next
Line 2379: Else
Line 2380: sbAdTable.Append("<option value=""notselected"">--No Records--</option>")
Line 2381: End If
Line 2382: End If
Line 2383:
Line 2384: dbservermanager = Nothing
Line 2385:
Line 2386: Return sbAdTable.ToString()
Line 2387: End Function
Line 2388:
Line 2389: Sub getABSingleAddress(ByVal login As String, ByVal shipAddID As String, ByVal admin As Boolean)
Line 2390: If shipAddID <> "notselected" Then
Line 2391: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2392: Dim dotdot As String = String.Empty
Line 2393: If admin = True Then
Line 2394: dotdot = ".."
Line 2395: End If
Line 2396: Dim aAddresses As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "ELoginShipTo", "view", login, shipAddID)
Line 2397:
Line 2398: If aAddresses IsNot Nothing Then
Line 2399: Session("abAddrID") = aAddresses(2)
Line 2400: Session("absCompany") = aAddresses(3)
Line 2401: Session("absName") = aAddresses(4)
Line 2402: Session("absAddr1") = aAddresses(5)
Line 2403: Session("absAddr2") = aAddresses(6)
Line 2404: Session("absCity") = aAddresses(7)
Line 2405: Session("absState") = aAddresses(8)
Line 2406: Session("absZip") = aAddresses(9)
Line 2407: Session("absCountryCode") = aAddresses(10)
Line 2408: Session("absCountryName") = aAddresses(11)
Line 2409: Session("absPhone") = aAddresses(12)
Line 2410: Session("absFax") = aAddresses(13)
Line 2411: End If
Line 2412: dbservermanager = Nothing
Line 2413: End If
Line 2414: End Sub
Line 2415:
Line 2416: Sub addeditABSingleAddress(ByVal action As String, ByVal login As String, ByVal shipAddID As String, ByVal shipCompany As String, ByVal shipName As String, ByVal shipAddr1 As String, ByVal shipAddr2 As String, ByVal shipCity As String, ByVal shipState As String, ByVal shipZip As String, ByVal shipCntryCode As String, ByVal shipCntryName As String, ByVal shipPhone As String, ByVal shipFax As String, ByVal admin As Boolean)
Line 2417: If shipAddID = String.Empty Then
Line 2418: Session("abMessage") = "Please enter the Address ID."
Line 2419: Exit Sub
Line 2420: ElseIf login = String.Empty And admin = True Then
Line 2421: Session("abMessage") = "No login is selected. The session may have timed out."
Line 2422: Exit Sub
Line 2423: ElseIf login = String.Empty And admin = False Then
Line 2424: Session("abMessage") = "Please log in."
Line 2425: Exit Sub
Line 2426: End If
Line 2427: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2428:
Line 2429: Dim dotdot As String = String.Empty
Line 2430: If admin = True Then
Line 2431: dotdot = ".."
Line 2432: End If
Line 2433:
Line 2434: Dim aAddresses As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "ELoginShipTo", action, login, shipAddID, shipCompany, shipName, shipAddr1, shipAddr2, shipCity, shipState, shipZip, shipCntryCode, shipCntryName, shipPhone, shipFax)
Line 2435:
Line 2436: If aAddresses.rank = 1 AndAlso aAddresses(1) = login Then
Line 2437: Session("abMessage") = "Success"
Line 2438: Else
Line 2439: Session("abMessage") = aAddresses(1)
Line 2440: End If
Line 2441:
Line 2442: dbservermanager = Nothing
Line 2443:
Line 2444: clearABsessions()
Line 2445: 'Session("abAddrID") = shipAddID
Line 2446: 'Session("absCompany") = shipCompany
Line 2447: 'Session("absName") = shipName
Line 2448: 'Session("absAddr1") = shipAddr1
Line 2449: 'Session("absAddr2") = shipAddr2
Line 2450: 'Session("absCity") = shipCity
Line 2451: 'Session("absState") = shipState
Line 2452: 'Session("absZip") = shipZip
Line 2453: 'Session("absCountryCode") = shipCntryCode
Line 2454: 'Session("absCountryName") = shipCntryName
Line 2455: 'Session("absPhone") = shipPhone
Line 2456: 'Session("absFax") = shipFax
Line 2457: End Sub
Line 2458:
Line 2459: Sub dltABDeleteAddress(ByVal login As String, ByVal shipAddID As String, ByVal admin As Boolean)
Line 2460:
Line 2461: If shipAddID <> String.Empty Then
Line 2462: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2463: Dim dotdot As String = String.Empty
Line 2464: If admin = True Then
Line 2465: dotdot = ".."
Line 2466: End If
Line 2467: Dim aAddresses As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "ELoginShipTo", "delete", login, shipAddID)
Line 2468: If aAddresses.rank = 1 AndAlso aAddresses(1) = "Login ship to addr deleted" Then
Line 2469: Session("abMessage") = "Address Book entry successfully deleted"
Line 2470:
Line 2471: Else
Line 2472: Session("abMessage") = aAddresses(1)
Line 2473: End If
Line 2474:
Line 2475: dbservermanager = Nothing
Line 2476: Else
Line 2477: Session("abMessage") = "Please select an Address Book entry."
Line 2478: End If
Line 2479:
Line 2480: clearABsessions()
Line 2481:
Line 2482: End Sub
Line 2483: Sub dltABDeleteLogin(ByVal login As String, ByVal admin As Boolean)
Line 2484:
Line 2485: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2486: Dim dotdot As String = String.Empty
Line 2487: If admin = True Then
Line 2488: dotdot = ".."
Line 2489: End If
Line 2490: Dim aAddresses As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dotdot), "DeleteELoginShipTo", login)
Line 2491: If aAddresses = "success" Then
Line 2492: Session("abMessage") = "Address Book entry successfully deleted"
Line 2493: Else
Line 2494: Session("abMessage") = aAddresses
Line 2495: End If
Line 2496:
Line 2497: dbservermanager = Nothing
Line 2498:
Line 2499: clearABsessions()
Line 2500:
Line 2501: End Sub
Line 2502:
Line 2503: Sub clearABsessions()
Line 2504:
Line 2505: Session.Remove("abAddrID")
Line 2506: Session.Remove("absCompany")
Line 2507: Session.Remove("absName")
Line 2508: Session.Remove("absAddr1")
Line 2509: Session.Remove("absAddr2")
Line 2510: Session.Remove("absCity")
Line 2511: Session.Remove("absState")
Line 2512: Session.Remove("absZip")
Line 2513: Session.Remove("absCountryCode")
Line 2514: Session.Remove("absCountryName")
Line 2515: Session.Remove("absPhone")
Line 2516: Session.Remove("absFax")
Line 2517:
Line 2518: End Sub
Line 2519: Sub changepersonalization(ByVal orderid As String, ByVal initsegment As String, ByVal endsegment As String)
Line 2520:
Line 2521: Dim dbservermanager, aitem, dotdot, datatype1, porderid, itemloop, initvalue, endvalue
Line 2522: Dim result As Object
Line 2523:
Line 2524: Dim st As System.Diagnostics.StackTrace
Line 2525: Dim sf As System.Diagnostics.StackFrame
Line 2526:
Line 2527:
Line 2528:
Line 2529: dbservermanager = Server.CreateObject(getcomname())
Line 2530: datatype1 = "ELINITM"
Line 2531: wt(True, "getorderiteminfo")
Line 2532: aitem = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "GetOrderItemInfo", datatype1, orderid)
Line 2533: wt(False, "getorderiteminfo")
Line 2534: For itemloop = 1 To UBound(aitem)
Line 2535: If InStr(aitem(itemloop, 13), initsegment) > 0 Then
Line 2536:
Line 2537: initvalue = (aitem(itemloop, 13))
Line 2538: endvalue = Replace(initvalue, initsegment, endsegment)
Line 2539: 'result = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "additemstocart", "pers", orderid, getxmlval("sprogram"), aitem(itemloop, 3), aitem(itemloop, 4), aitem(itemloop, 5), aitem(itemloop, 8), aitem(itemloop, 9), endvalue
Line 2540: wt(True, "additemstocart")
Line 2541: st = New StackTrace(New StackFrame(True))
Line 2542: result = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "additemstocart", "pers", orderid, getxmlval("sprogram"), aitem(itemloop, 3), aitem(itemloop, 4), aitem(itemloop, 5), aitem(itemloop, 8), aitem(itemloop, 9), endvalue, getxmlval("freighttype"), , , , , checkprogram())
Line 2543: wt(False, "additemstocart")
Line 2544: Session("resultpers" & itemloop) = result
Line 2545: End If
Line 2546: Next
Line 2547: dbservermanager = Nothing
Line 2548:
Line 2549: End Sub
Line 2550:
Line 2551: Sub DeductGiftCerts(ByVal orderid As String)
Line 2552: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2553: Dim e As Integer
Line 2554: Dim chargegift
Line 2555: Dim updategc As Object
Line 2556: Dim ler As Object = getcarttotals()
Line 2557: Session("gcrunning") = CDbl(Session("giftcertamt"))
Line 2558: Session("gcstart") = Session("gcrunning")
Line 2559:
Line 2560: If getxmlval("attachloginstogiftcerts") = "Y" And Session("loggedin") = "True" And Session("getno") <> String.Empty And getxmlval("attachloginstogiftcertsbutallowpayment") <> "Y" Then
Line 2561:
Line 2562: Dim DeductGCsFromAcct As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateGCBook", Session("login"), Session("gtotal"))
Line 2563:
Line 2564: Session("LoginGCLeftOver") = DeductGCsFromAcct
Line 2565: For a As Integer = 1 To Session("numofgiftcerts")
Line 2566:
Line 2567: If Session("giftcertno" & a) <> String.Empty Then
Line 2568: Dim getgcinfo As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GCAdmin", "view", Session("giftcertno" & a))
Line 2569: If getgcinfo(1, 1) <> "Gift certificate does not exist" Then
Line 2570:
Line 2571: If Session("AttachedGiftStart " & getgcinfo(1, 1)) <> getgcinfo(1, 12) Then
Line 2572:
Line 2573: Dim addwebtracktogc As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GCAdmin", "edit", getgcinfo(1, 1), orderid, getgcinfo(1, 2), getgcinfo(1, 3), getgcinfo(1, 11), getgcinfo(1, 12), getgcinfo(1, 13), , , , , , getgcinfo(1, 17), getgcinfo(1, 18), getgcinfo(1, 19), " " & Session("getno") & " ", getgcinfo(1, 21))
Line 2574:
Line 2575: End If
Line 2576: End If
Line 2577:
Line 2578: End If
Line 2579: Next
Line 2580: Else
Line 2581:
Line 2582: For e = 0 To Int(Session("numofgiftcerts") / 5)
Line 2583: If (Not (Session("subtotal" & e) Is Nothing)) And (CDbl(Session("gcrunning")) > 0.0) And getxmlval("singleitemon") <> "Y" Then
Line 2584: If Session("subtotal" & e) > FormatNumber((Session("gcrunning")), 3) Then
Line 2585:
Line 2586: updategc = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateGCItems", Session("giftcertno" & (1 + (e * 5))), Session("giftcertno" & (2 + (e * 5))), Session("giftcertno" & (3 + (e * 5))), Session("giftcertno" & (4 + (e * 5))), Session("giftcertno" & (5 + (e * 5))), orderid, getxmlval("gcexpire"), Session("login"), Session("gcrunning"), "F")
Line 2587: 'Dim updategcord As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateGCItems", Session("giftcertno1"), Session("giftcertno2"), Session("giftcertno3"), Session("giftcertno4"), Session("giftcertno5"), orderid, getxmlval("gcexpire"), Session("login"), Session("giftcertamt"))
Line 2588: Session("gcfinal") = Session("gcrunning")
Line 2589: Exit For
Line 2590: Else
Line 2591: updategc = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateGCItems", Session("giftcertno" & (1 + (e * 5))), Session("giftcertno" & (2 + (e * 5))), Session("giftcertno" & (3 + (e * 5))), Session("giftcertno" & (4 + (e * 5))), Session("giftcertno" & (5 + (e * 5))), orderid, getxmlval("gcexpire"), Session("login"), Session("subtotal" & e), "F")
Line 2592: Session("gcrunning") -= Session("subtotal" & e)
Line 2593: End If
Line 2594: 'IF SINGLE ITEM SITE
Line 2595: ElseIf getxmlval("singleitemon") = "Y" Then
Line 2596: Dim updategcord As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateGCItems", Session("giftcertno1"), "", "", "", "", orderid, getxmlval("gcexpire"), Session("login"), Session("giftcertamt"), IIf(getxmlval("singleitemenforcesingleuse") = "Y", "T", "F"))
Line 2597: Exit For
Line 2598: 'IF JUST UPDATING GC ITEMS WITH ORDER NUMBER
Line 2599: Else
Line 2600: Dim updategcord As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateGCItems", "", "", "", "", "", orderid, getxmlval("gcexpire"), Session("login"), Session("giftcertamt"), "F")
Line 2601: End If
Line 2602: Next
Line 2603:
Line 2604: End If
Line 2605: dbservermanager = Nothing
Line 2606: End Sub
Line 2607:
Line 2608: Sub SendGCEmails(ByVal Passorderid As String, ByVal useDotdot As Boolean)
Line 2609:
Line 2610: Dim svspecon As Boolean = IIf(getxmlval("svspecialon") = "Y", True, False)
Line 2611: Dim orderid As String = Trim(Passorderid)
Line 2612: Session("functionorderid") = orderid
Line 2613: Dim dotdot As String
Line 2614: If useDotdot = True Then
Line 2615: dotdot = ".."
Line 2616: Else
Line 2617: dotdot = ""
Line 2618: End If
Line 2619:
Line 2620: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2621: 'IF SUPERVISOR SPECIAL IS NOT ON, WE ADD THE GIFT CERTIFICATES AT THIS POINT
Line 2622: If svspecon = False Then
Line 2623: Dim updateerror As Integer = 0
Line 2624:
Line 2625: For a As Integer = 1 To Session("nextgc") - 1
Line 2626: If Session("gcn" & a & "itemno") <> String.Empty Then
Line 2627: Dim addgc As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "AddGCItems", Session("orderid"), Session("gcn" & a & "itemno"), Session("gcn" & a & "subno"), Session("itemcust"), Session("gcn" & a & "email"), Session("gcn" & a & "message"), CStr(getxmlval("gcexpire")), getxmlval("giftcertsallnumeric"))
Line 2628: If addgc <> "success" Then
Line 2629: updateerror = updateerror + 1
Line 2630: Else
Line 2631: Session.Remove("gcn" & a & "itemno")
Line 2632: Session.Remove("gcn" & a & "subno")
Line 2633: Session.Remove("gcn" & a & "email")
Line 2634: Session.Remove("gcn" & a & "message")
Line 2635: End If
Line 2636: End If
Line 2637: Next
Line 2638: If updateerror > 0 Then
Line 2639:
Line 2640: formerror("There was a problem adding gift certificate information. Please contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " for assistance.")
Line 2641: End If
Line 2642: End If
Line 2643:
Line 2644: Dim getgcemails As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "GCAdmin", "view", , orderid)
Line 2645: dbservermanager = Nothing
Line 2646: Dim giftCertLogo As String
Line 2647: Dim giftCertMessage As String
Line 2648:
Line 2649: If getxmlval("giftcertmessage") <> "" Then
Line 2650: giftCertMessage = getxmlval("giftcertmessage")
Line 2651: Else
Line 2652: giftCertMessage = ""
Line 2653: End If
Line 2654:
Line 2655: Dim i As Integer
Line 2656: Dim sendto, gcmessage, gcno, gcexpire, gcamount, emailfrom, subject, cc, body, bcc As String
Line 2657: sendto = ""
Line 2658: cc = ""
Line 2659: bcc = ""
Line 2660: subject = ReplaceTokens(getxmlval("gcspecsubject"))
Line 2661: Dim mailserver As String = getxmlval("emailserver")
Line 2662: Dim authenticate As String = getxmlval("authenticateon")
Line 2663: Dim usr As String = getxmlval("emailusr")
Line 2664: Dim pwd As String = getxmlval("emailpwd")
Line 2665: Dim servername As String = r1.Request.ServerVariables("SERVER_NAME")
Line 2666: If getxmlval("externalurl") <> String.Empty Then
Line 2667: servername = getxmlval("externalurl")
Line 2668: End If
Line 2669: Dim url As String = "http://" & servername & r1.Request.ServerVariables("SCRIPT_NAME")
Line 2670:
Line 2671: If useDotdot = True Then
Line 2672: Dim lefturl As Integer = Len(url) - 1
Line 2673: url = Left(url, lefturl - 1)
Line 2674: url = Left(url, (InStrRev(url, "/") - 1))
Line 2675: End If
Line 2676:
Line 2677: url = Left(url, InStrRev(url, "/"))
Line 2678:
Line 2679: If getxmlval("giftcertlogoimage") <> "" Then
Line 2680: giftCertLogo = "<img src='" & url & getxmlval("giftcertlogoimage") & "' />"
Line 2681: Else
Line 2682: giftCertLogo = String.Empty
Line 2683: End If
Line 2684:
Line 2685: Dim sendfrom As String = ""
Line 2686: Dim sendfromname As String = getxmlval("emailfromname")
Line 2687: If getxmlval("gcemailfrom") = "Loggedin" Then
Line 2688: If Session("bemail") <> String.Empty Then
Line 2689: sendfrom = Session("bemail")
Line 2690: ElseIf Session("email") <> String.Empty Then
Line 2691: sendfrom = Session("email")
Line 2692: ElseIf getxmlval("emailfrom") <> String.Empty Then
Line 2693: sendfrom = getxmlval("emailfrom")
Line 2694: End If
Line 2695: Else
Line 2696: If getxmlval("emailfrom") <> String.Empty Then
Line 2697: sendfrom = getxmlval("emailfrom")
Line 2698: ElseIf Session("bemail") <> String.Empty Then
Line 2699: sendfrom = Session("bemail")
Line 2700: ElseIf Session("email") <> String.Empty Then
Line 2701: sendfrom = Session("email")
Line 2702: End If
Line 2703: End If
Line 2704: Dim gcloginreceive As String = getxmlval("gcloginreceive")
Line 2705: Dim currencyformat As String = getxmlval("currencyformat")
Line 2706:
Line 2707: If getxmlval("giftcertalturl") <> String.Empty Then
Line 2708: url = getxmlval("giftcertalturl")
Line 2709: End If
Line 2710:
Line 2711: emailfrom = "<a href=""mailto:" & sendfrom & """>" & sendfrom & "</a>"
Line 2712:
Line 2713: If LCase(Trim(sendfrom)) <> LCase(Trim(sendto)) And (gcloginreceive = "Y") Then
Line 2714: bcc = sendfrom & ","
Line 2715: End If
Line 2716:
Line 2717: If gcloginreceive = "Y" And Session("email") <> String.Empty Then
Line 2718: 'if does not already exist in bcc, then add
Line 2719: If bcc.Contains(Session("email")) = False Then
Line 2720: bcc += Session("email") & ","
Line 2721: End If
Line 2722: End If
Line 2723:
Line 2724: If gcloginreceive = "Y" And Session("bemail") <> String.Empty Then
Line 2725: 'if does not already exist in bcc, then add
Line 2726: If bcc.Contains(Session("bemail")) = False Then
Line 2727: bcc += Session("bemail") & ","
Line 2728: End If
Line 2729: End If
Line 2730:
Line 2731: For i = 1 To UBound(getgcemails)
Line 2732: Session("emaillength") = Len(getgcemails(i, 1))
Line 2733: Session("getgcemailsi1") = getgcemails(i, 1)
Line 2734: If Len(getgcemails(i, 1)) = 10 Then
Line 2735:
Line 2736: sendto = getgcemails(i, 13)
Line 2737: gcmessage = getgcemails(i, 14)
Line 2738: gcno = getgcemails(i, 1)
Line 2739: gcexpire = getgcemails(i, 3)
Line 2740: gcamount = reformatcurrency(FormatCurrency(getgcemails(i, 11), currencyformat))
Line 2741:
Line 2742: body = giftCertLogo & "<br /><br />" & gcmessage & "<br /><br />" & "Gift Certificate Code: " & gcno & "<br />Amount: " & gcamount & "<br />Expiration Date: " & gcexpire & "<br />Purchased By: " & emailfrom & "<br /><br />Redeem this gift certificate at: <a href=""" & url & """>" & url & "</a><br /><br />" & giftCertMessage
Line 2743:
Line 2744: Dim ems As Object = emailsend(sendto, subject, sendfrom, sendfromname, body, cc, bcc, mailserver, authenticate, usr, pwd, Nothing)
Line 2745:
Line 2746: 'BACKUP EMAIL SENDING - IF FIRST EMAILSEND FAILS
Line 2747: If ems <> "ok" Then
Line 2748: If sendfrom <> getxmlval("emailfrom") Then
Line 2749: sendfrom = getxmlval("emailfrom")
Line 2750: ElseIf sendfrom = getxmlval("emailfrom") And Session("bemail") <> String.Empty Then
Line 2751: sendfrom = Session("bemail")
Line 2752: ElseIf sendfrom = getxmlval("emailfrom") And Session("email") <> String.Empty Then
Line 2753: sendfrom = Session("email")
Line 2754: End If
Line 2755: ems = emailsend(sendto, subject, sendfrom, sendfromname, body, cc, bcc, mailserver, authenticate, usr, pwd, Nothing)
Line 2756: End If
Line 2757:
Line 2758: End If
Line 2759:
Line 2760: Next
Line 2761: End Sub
Line 2762:
Line 2763: Function AttachLoginToGiftCert(ByVal loginid As String, ByVal giftcert As String) As String
Line 2764: Dim retval As String = String.Empty
Line 2765: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2766: Dim gcnotfound As String = "Gift Certificate not found."
Line 2767: Dim gcexpired As String = "The Gift Certificate has expired."
Line 2768:
Line 2769: If getxmlval("gcnotfound") <> String.Empty Then
Line 2770: gcnotfound = getxmlval("gcnotfound")
Line 2771: End If
Line 2772:
Line 2773: If getxmlval("gcexpired") <> String.Empty Then
Line 2774: gcexpired = getxmlval("gcexpired")
Line 2775: End If
Line 2776: Dim getgcinfo As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GCAdmin", "view", giftcert)
Line 2777: Try
Line 2778:
Line 2779: Dim MaxGCAmount As Double = 1000000000
Line 2780: If IsNumeric(getxmlval("attachloginsmaxamount")) Then
Line 2781: MaxGCAmount = CDbl(getxmlval("attachloginsmaxamount"))
Line 2782: End If
Line 2783: Dim GCAmount As Double = getgcinfo(1, 12)
Line 2784:
Line 2785: If getgcinfo(1, 1) = "Gift certificate does not exist" Then
Line 2786: retval = getgcinfo(1, 1)
Line 2787: ElseIf DateDiff("d", getgcinfo(1, 3), Now()) >= 1 Then
Line 2788: retval = "EXPIRED"
Line 2789: ElseIf CDbl(GCAmount) + CDbl(Session("GiftCertsByLoginTotal")) > MaxGCAmount Then
Line 2790: retval = "EXCEEDS MAX"
Line 2791: ElseIf CDbl(GCAmount) = 0 Then
Line 2792: retval = "DEPLETED"
Line 2793: ElseIf getgcinfo(1, 17) <> String.Empty Then
Line 2794: retval = "ALREADYASSIGNED"
Line 2795: Else
Line 2796: Dim processit As Object
Line 2797:
Line 2798: processit = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "updategcloginid", giftcert, loginid)
Line 2799: retval = processit
Line 2800: End If
Line 2801: Catch ex As Exception
Line 2802: retval = "Gift certificate does not exist"
Line 2803: End Try
Line 2804:
Line 2805: dbservermanager = Nothing
Line 2806: GetGiftCertsbyLogin(loginid)
Line 2807:
Line 2808: Return retval
Line 2809: End Function
Line 2810:
Line 2811: Sub GetGiftCertsbyLogin(ByVal loginid As String)
Line 2812:
Line 2813: For i As Integer = 1 To Session("QuantityGiftCertsByLogin")
Line 2814: Session.Remove("giftcertno" & i)
Line 2815: Session.Remove("giftcertamt" & i)
Line 2816: Next
Line 2817: Session.Remove("GiftCertsByLoginTotal")
Line 2818: Session.Remove("GiftCertsByLoginTotalwLabel")
Line 2819:
Line 2820: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2821:
Line 2822: Dim getgcs As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetGCertificatesByLogin", loginid) 'TODO
Line 2823:
Line 2824: 'Dim getgcs(,) As String = New String(,) {{"7338801977", 10}, {"9930485546", 10}, {"9851650255", 10}, {"9828868678", 15}, {"45", "n"}} 'TODO
Line 2825: 'Dim getgcs(,) As String = New String(,) {{"00111500BO", 120}, {"120", "n"}} 'TODO
Line 2826: Session("GiftCertsByLogin") = getgcs
Line 2827: dbservermanager = Nothing
Line 2828: For GC As Integer = LBound(getgcs) To UBound(getgcs) - 1
Line 2829:
Line 2830: Session("giftcertno" & GC) = getgcs(GC, 1)
Line 2831: Session("giftcertamt" & GC) = getgcs(GC, 2)
Line 2832: If Session("AttachedGiftStart " & getgcs(GC, 1)) = String.Empty Then
Line 2833: Session("AttachedGiftStart " & getgcs(GC, 1)) = getgcs(GC, 2)
Line 2834: End If
Line 2835: Session("giftcertnoisattached" & GC) = "Y"
Line 2836:
Line 2837: Next
Line 2838: Dim numericPart As Double = 0
Line 2839: Try
Line 2840: numericPart = CDbl(getgcs(UBound(getgcs), 2))
Line 2841: Session("GiftCertsByLoginTotal") = numericPart
Line 2842: Session("GiftCertsByLoginTotalwLabel") = showValues(numericPart)
Line 2843: Session("paymentmethod") = "GiftCert"
Line 2844: Session("QuantityGiftCertsByLogin") = UBound(getgcs) - 1
Line 2845: Catch ex As Exception
Line 2846: Session("GiftCertsByLoginTotal") = showValues(0)
Line 2847: End Try
Line 2848:
Line 2849:
Line 2850: End Sub
Line 2851:
Line 2852: Function GetGCBalance(ByVal giftcert As String) As String
Line 2853: Dim gcbalance As String = String.Empty
Line 2854: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 2855: Dim getgcinfo As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GCAdmin", "view", giftcert)
Line 2856: dbservermanager = Nothing
Line 2857: Try
Line 2858: If getgcinfo(1, 1) <> "Gift certificate does not exist" Then
Line 2859: gcbalance = getgcinfo(1, 12)
Line 2860: End If
Line 2861: Catch ex As Exception
Line 2862: gcbalance = "Gift certificate does not exist"
Line 2863: End Try
Line 2864: Return gcbalance
Line 2865: End Function
Line 2866: Function GivexAction(ByVal TMF As String, ByVal givexnum As String, ByVal whichgivex As String) As String
Line 2867:
Line 2868: Dim givexsuccess As String
Line 2869: Session("testfail") = True
Line 2870: 'Begin commenting
Line 2871: Dim givexTMF As String = TMF
Line 2872: Dim givexlanguage As String = getxmlval("givexlanguage")
Line 2873: Dim transactioncode As String = Session("transactioncode")
Line 2874: Dim givexuserid As String = getxmlval("givexuserid")
Line 2875: Dim givexuserpwd As String = getxmlval("givexuserpwd")
Line 2876: Dim givexnumber As String = givexnum
Line 2877: Dim givexcurrency As String = getxmlval("givexcurrency")
Line 2878: Dim securitycode As String = Session("givexsecur" & whichgivex)
Line 2879: Dim totalgivexamount As String = Session("givexchg" & whichgivex)
Line 2880: Dim givextoken As String = getxmlval("givextoken")
Line 2881:
Line 2882: Dim GivexAPI
Line 2883: Dim ident
Line 2884:
Line 2885:
Line 2886: Dim teststatus As String = "live"
Line 2887: If teststatus = "live" Then
Line 2888:
Line 2889: Try
Line 2890:
Line 2891: GivexAPI = New com.givex.gapi_us1.gapiTrans()
Line 2892: ident = New com.givex.gapi_us1.Identification()
Line 2893: Catch ex As Exception
Line 2894: Session("givexfailover") = True
Line 2895: GivexAPI = New com.givex.gapi_us2.gapiTrans()
Line 2896: ident = New com.givex.gapi_us2.Identification()
Line 2897: End Try
Line 2898:
Line 2899: Else
Line 2900:
Line 2901: GivexAPI = New com.givex.dev_gapi.gapiTrans()
Line 2902: ident = New com.givex.dev_gapi.Identification()
Line 2903:
Line 2904: End If
Line 2905: With ident
Line 2906: .token = givextoken
Line 2907: .user = givexuserid
Line 2908: .userPasswd = givexuserpwd
Line 2909: .language = givexlanguage
Line 2910: End With
Line 2911:
Line 2912: If givexTMF = "getBalance" Then
Line 2913: Dim getRequest
Line 2914: Dim resBalance
Line 2915:
Line 2916: If teststatus = "live" Then
Line 2917:
Line 2918: If Session("givexfailover") <> True Then
Line 2919: getRequest = New com.givex.gapi_us1.GetBalance()
Line 2920: resBalance = New com.givex.gapi_us1.Balance
Line 2921: Else
Line 2922: 'try a second time
Line 2923: getRequest = New com.givex.gapi_us2.GetBalance()
Line 2924: resBalance = New com.givex.gapi_us2.Balance
Line 2925: End If
Line 2926:
Line 2927: Else
Line 2928: getRequest = New com.givex.dev_gapi.GetBalance()
Line 2929: resBalance = New com.givex.dev_gapi.Balance
Line 2930: End If
Line 2931:
Line 2932: With getRequest
Line 2933: .id = ident
Line 2934: .givexNumber = givexnumber
Line 2935: .currency = givexcurrency
Line 2936: End With
Line 2937:
Line 2938: Try
Line 2939: resBalance = GivexAPI.GetBalance(getRequest)
Line 2940:
Line 2941: Catch ex As System.Web.Services.Protocols.SoapException
Line 2942: Dim soapdetail As XmlNode = ex.Detail
Line 2943: Dim node As XmlNode
Line 2944: For Each node In soapdetail.ChildNodes
Line 2945: If InStr(node.OuterXml, "The user account does not exist or the supplied password is incorrect") > 0 Then
Line 2946: Session("nodeerror") += "The user account does not exist or the supplied password is incorrect <br />"
Line 2947: ElseIf InStr(node.OuterXml, "Cert not exist") > 0 Then
Line 2948: Session("nodeerror") += "Certificate does not exist<br />"
Line 2949: ElseIf InStr(node.OuterXml, "9 - ERR bal=$0.00") > 0 Then
Line 2950: Session("nodeerror") += "Improper Givex Number format<br />"
Line 2951: End If
Line 2952: Session("nodeanalyze") += node.OuterXml
Line 2953:
Line 2954: Next
Line 2955: Catch exelse As Exception
Line 2956: Session("exelse") += exelse.GetType.ToString
Line 2957: End Try
Line 2958:
Line 2959: Dim result As String = ""
Line 2960:
Line 2961: Try
Line 2962: result = resBalance.certBalance.ToString()
Line 2963: 'Session("balanceexpirycode") = resBalance.expiryDate.ToString()
Line 2964:
Line 2965: givexsuccess = result
Line 2966: Catch ex As System.NullReferenceException
Line 2967: Session("balanceerror") = "\r\nNULL value returned"
Line 2968: givexsuccess = result
Line 2969: Catch soapex As System.Web.Services.Protocols.SoapException
Line 2970: Dim soapdetail As XmlNode = soapex.Detail
Line 2971: Dim node As XmlNode
Line 2972:
Line 2973: For Each node In soapdetail.ChildNodes
Line 2974: If InStr(node.OuterXml, "The user account does not exist or the supplied password is incorrect") > 0 Then
Line 2975: Session("nodeerror") += "The user account does not exist or the supplied password is incorrect <br />"
Line 2976: ElseIf InStr(node.OuterXml, "Cert not exist") > 0 Then
Line 2977: Session("nodeerror") += "Certificate does not exist<br />"
Line 2978: ElseIf InStr(node.OuterXml, "9 - ERR bal=$0.00") > 0 Then
Line 2979: Session("nodeerror") += "Improper Givex Number format<br />"
Line 2980: End If
Line 2981: Session("nodeanalyze") += node.OuterXml
Line 2982:
Line 2983: Next
Line 2984: Catch exelse As Exception
Line 2985: Session("exelse") += exelse.GetType.ToString
Line 2986: End Try
Line 2987:
Line 2988: getRequest = Nothing
Line 2989: resBalance = Nothing
Line 2990:
Line 2991: ElseIf givexTMF = "RedeemForced" Then
Line 2992: 'If Session("testfail") = True Then
Line 2993: ' GivexAPI.Timeout = 15
Line 2994: 'Else
Line 2995: GivexAPI.Timeout = 20000
Line 2996: 'End If
Line 2997: Dim redeemf
Line 2998: Dim resredeemf
Line 2999:
Line 3000: If teststatus = "live" Then
Line 3001: If Session("givexfailover") <> True Then
Line 3002: redeemf = New com.givex.gapi_us1.RedeemForced()
Line 3003: resredeemf = New com.givex.gapi_us1.RedeemForcedResponse
Line 3004: Else
Line 3005: redeemf = New com.givex.gapi_us2.RedeemForced()
Line 3006: resredeemf = New com.givex.gapi_us2.RedeemForcedResponse
Line 3007: End If
Line 3008: Else
Line 3009: redeemf = New com.givex.dev_gapi.RedeemForced()
Line 3010: resredeemf = New com.givex.dev_gapi.RedeemForcedResponse
Line 3011: End If
Line 3012:
Line 3013: With redeemf
Line 3014: .id = ident
Line 3015: .reference = transactioncode
Line 3016: .givexNumber = givexnumber
Line 3017: .amount = totalgivexamount
Line 3018: If securitycode <> String.Empty Then
Line 3019: .securityCode = securitycode
Line 3020: End If
Line 3021: End With
Line 3022:
Line 3023: Try
Line 3024: resredeemf = GivexAPI.RedeemForced(redeemf)
Line 3025:
Line 3026: Catch timeex As System.Net.WebException
Line 3027: givexsuccess = "timeout"
Line 3028: redeemf = Nothing
Line 3029: resredeemf = Nothing
Line 3030: Return givexsuccess
Line 3031: Exit Function
Line 3032: Catch socketex As System.Net.Sockets.SocketException
Line 3033: formerror(socketex.Message)
Line 3034: Catch soapex As System.Web.Services.Protocols.SoapException
Line 3035: Dim soapdetail As XmlNode = soapex.Detail
Line 3036: Dim node As XmlNode
Line 3037:
Line 3038: For Each node In soapdetail.ChildNodes
Line 3039: If InStr(node.OuterXml, "The user account does not exist or the supplied password is incorrect") > 0 Then
Line 3040: Session("nodeerror") += "The user account does not exist or the supplied password is incorrect <br />"
Line 3041: ElseIf InStr(node.OuterXml, "Cert not exist") > 0 Then
Line 3042: Session("nodeerror") += "Certificate does not exist<br />"
Line 3043: ElseIf InStr(node.OuterXml, "9 - ERR bal=$0.00") > 0 Then
Line 3044: Session("nodeerror") += "Improper Givex Number format<br />"
Line 3045: Else
Line 3046: Session("nodeanalyze") += node.OuterXml
Line 3047: End If
Line 3048: Session("nodeanalyze") += node.OuterXml
Line 3049: Next
Line 3050:
Line 3051: Catch otherex As Exception
Line 3052:
Line 3053: Session("nodeerror") += "Givex transaction was not processed due to the following error: " & otherex.Message & otherex.GetType.ToString & " <br />"
Line 3054:
Line 3055: End Try
Line 3056:
Line 3057: Try
Line 3058: Dim resultAmt As String = resredeemf.amount.ToString()
Line 3059: Dim resultAuthCode = resredeemf.authCode.ToString()
Line 3060: 'If resRedeemf.expiryDate.ToString <> String.Empty Then
Line 3061: 'Session("expirydate") = resRedeemf.expiryDate
Line 3062: 'End If
Line 3063: Dim resultCertBalance = resredeemf.certBalance.ToString()
Line 3064: 'Dim resultexpiryDate = resRedeemf.expiryDate.ToString()
Line 3065: If securitycode <> String.Empty Then
Line 3066: Dim resultSecurityCode = resredeemf.securityCode.ToString()
Line 3067: End If
Line 3068: Session("GivexAuthCode" & whichgivex) = resultAuthCode
Line 3069: givexsuccess = resultAmt
Line 3070:
Line 3071: 'Catch ex As System.NullReferenceException
Line 3072: ' Session("givexerror") += "2741: wrong user id "
Line 3073: ' Session("balanceerror") = "\r\nNULL value returned"
Line 3074: ' givexsuccess = "fail"
Line 3075: Catch otherex As Exception
Line 3076: 'Session("givexerror") +=
Line 3077: 'Session("givexerror") +=
Line 3078: 'Session("givexerror") +=
Line 3079: Session("nodeerror") += "Givex transaction was not processed due to the following error: " & otherex.Message & " <br />"
Line 3080:
Line 3081: End Try
Line 3082: redeemf = Nothing
Line 3083: resredeemf = Nothing
Line 3084: Return givexsuccess
Line 3085:
Line 3086: ElseIf givexTMF = "Reversal" Then
Line 3087: Dim GivexReversal
Line 3088: Dim resReversal
Line 3089: GivexAPI.Timeout = 20000
Line 3090: If teststatus = "live" Then
Line 3091:
Line 3092: If Session("givexfailover") <> True Then
Line 3093: GivexReversal = New com.givex.gapi_us1.Reversal
Line 3094: resReversal = New com.givex.gapi_us1.ReversalResponse
Line 3095: Else
Line 3096: GivexReversal = New com.givex.gapi_us2.Reversal
Line 3097: resReversal = New com.givex.gapi_us2.ReversalResponse
Line 3098: End If
Line 3099: Else
Line 3100: GivexReversal = New com.givex.dev_gapi.Reversal
Line 3101: resReversal = New com.givex.dev_gapi.ReversalResponse
Line 3102: End If
Line 3103:
Line 3104: With GivexReversal
Line 3105: .id = ident
Line 3106: .reference = transactioncode
Line 3107: .givexNumber = givexnumber
Line 3108: .amount = totalgivexamount
Line 3109: End With
Line 3110:
Line 3111: Try
Line 3112: resReversal = GivexAPI.Reversal(GivexReversal)
Line 3113: Catch ex As Exception
Line 3114: givexsuccess = "reversal failed"
Line 3115: Return givexsuccess
Line 3116: Exit Function
Line 3117: End Try
Line 3118:
Line 3119:
Line 3120: Try
Line 3121: Dim resultAuthCode = resReversal.authCode.ToString()
Line 3122: Dim resultCertBalance = resReversal.certBalance.ToString()
Line 3123: 'Dim resultexpiryDate = resCancel.expiryDate.ToString()
Line 3124: If securitycode <> String.Empty Then
Line 3125: Dim resultSecurityCode = resReversal.securityCode.ToString()
Line 3126: End If
Line 3127: Session("GivexRevAuthCode" & whichgivex) = resultAuthCode
Line 3128: givexsuccess = resultAuthCode
Line 3129: Catch ex As System.NullReferenceException
Line 3130:
Line 3131: Session("balanceerror") = "\r\nNULL value returned"
Line 3132: givexsuccess = "fail"
Line 3133: Catch otherex As Exception
Line 3134: Session("nodeerror") += "Givex transaction was not processed due to the following error: " & otherex.Message & " <br />"
Line 3135:
Line 3136: End Try
Line 3137: GivexReversal = Nothing
Line 3138: resReversal = Nothing
Line 3139: End If
Line 3140:
Line 3141: GivexAPI = Nothing
Line 3142: ident = Nothing
Line 3143: Session.Remove("givexfailover")
Line 3144: ' End commenting
Line 3145:
Line 3146: Return givexsuccess
Line 3147:
Line 3148: End Function
Line 3149:
Line 3150: Public Function GetPayloadID(startDateTime As DateTime) As String
Line 3151: Dim payloadID As String
Line 3152: Dim f1 As New functions
Line 3153: Dim domainName As String = f1.getxmlval("aribadomainname")
Line 3154:
Line 3155: payloadID = startDateTime.ToString("yyyyMMddHHmmss") & "@" & domainName
Line 3156:
Line 3157: Return payloadID
Line 3158: End Function
Line 3159:
Line 3160: Public Function GetPayloadIDForPunchOut(startDateTime As DateTime, punchoutType As String) As String
Line 3161: Dim payloadID As String
Line 3162: Dim f1 As New functions
Line 3163: Dim domainName As String = ""
Line 3164:
Line 3165: If punchoutType = "Coupa" Then
Line 3166: domainName = f1.getxmlval("coupadomainname")
Line 3167: End If
Line 3168:
Line 3169: payloadID = startDateTime.ToString("yyyyMMddHHmmss") & "@" & domainName
Line 3170:
Line 3171: Return payloadID
Line 3172: End Function
Line 3173:
Line 3174: Function createAribaOrder() As String
Line 3175:
Line 3176: Try
Line 3177: Dim responseString As String
Line 3178: Dim dotdot As String = ""
Line 3179: Dim orderid As String = Session("orderid")
Line 3180:
Line 3181: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 3182:
Line 3183: Dim eord As Object = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_createaribaorder", Server.MapPath(dotdot), "getorderinfo", "EORDER", orderid, getxmlval("boxlimit"))
Line 3184:
Line 3185: Dim elines As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getorderiteminfo", "ELINITM", orderid)
Line 3186:
Line 3187: If eord(3) <> orderid Then
Line 3188: formerror("Order was not found.")
Line 3189: r1.Response.End()
Line 3190: End If
Line 3191:
Line 3192: Dim startDateTime As DateTime = Now()
Line 3193: Dim response As XmlDocument
Line 3194: Dim Doc As New XmlDocument()
Line 3195: Dim Doc2 As New XmlDocument()
Line 3196: Dim nodeAttribute As XmlAttribute
Line 3197: Dim Child As XmlElement
Line 3198: Dim Child2 As XmlElement
Line 3199: Dim Child3 As XmlElement
Line 3200: Dim Child4 As XmlElement
Line 3201: Dim Child5 As XmlElement
Line 3202: Dim Child6 As XmlElement
Line 3203: Dim doctype As XmlDocumentType
Line 3204: doctype = Doc.CreateDocumentType("cXML", "SYSTEM", "http://xml.cxml.org/schemas/cXML/1.2.021/cXML.dtd", Nothing)
Line 3205: Doc.AppendChild(doctype)
Line 3206:
Line 3207: ' Create the root node.
Line 3208: Dim Root As XmlElement
Line 3209: Root = Doc.CreateElement("cXML")
Line 3210:
Line 3211: ' Add an attribute to the root node.
Line 3212: Dim payloadID As String = GetPayloadID(startDateTime)
Line 3213: Dim Attr As XmlAttribute
Line 3214: Attr = Doc.CreateAttribute("payloadID")
Line 3215: Attr.Value = payloadID
Line 3216: Root.Attributes.Append(Attr)
Line 3217:
Line 3218: nodeAttribute = Doc.CreateAttribute("payloadID")
Line 3219: nodeAttribute.Value = payloadID
Line 3220: Root.Attributes.Append(nodeAttribute)
Line 3221:
Line 3222: ' Add an attribute to the root node.
Line 3223: Dim timeStamp As String = startDateTime.ToString("yyyy-MM-ddTHH:mm:sszzz")
Line 3224: nodeAttribute = Doc.CreateAttribute("timestamp")
Line 3225: nodeAttribute.Value = timeStamp
Line 3226: Root.Attributes.Append(nodeAttribute)
Line 3227:
Line 3228: 'bring in the holdback "Header" file
Line 3229: Doc2.Load(Server.MapPath("Ariba/punchOutOrderMessageHeaderTemplate.xml"))
Line 3230: Dim doc2ChildNode As XmlNode
Line 3231: For Each doc2ChildNode In Doc2.DocumentElement.ChildNodes
Line 3232: Dim doc2MergeNode As XmlNode = Doc.ImportNode(doc2ChildNode, True)
Line 3233: Root.AppendChild(doc2MergeNode)
Line 3234: Next
Line 3235:
Line 3236: Child = Doc.CreateElement("Message")
Line 3237: Child.InnerText = ""
Line 3238:
Line 3239: Child2 = Doc.CreateElement("PunchOutOrderMessage")
Line 3240: Child2.InnerText = ""
Line 3241:
Line 3242: Child3 = Doc.CreateElement("BuyerCookie")
Line 3243: Child3.InnerText = Session("aribabuyercookie")
Line 3244: Child2.AppendChild(Child3)
Line 3245:
Line 3246: Child3 = Doc.CreateElement("PunchOutOrderMessageHeader")
Line 3247: Child3.InnerText = ""
Line 3248: nodeAttribute = Doc.CreateAttribute("operationAllowed")
Line 3249: nodeAttribute.Value = "create"
Line 3250: Child3.Attributes.Append(nodeAttribute)
Line 3251: Child2.AppendChild(Child3)
Line 3252:
Line 3253: Child4 = Doc.CreateElement("Total")
Line 3254: Child4.InnerText = ""
Line 3255:
Line 3256: Child5 = Doc.CreateElement("Money")
Line 3257: Child5.InnerText = eord(21)
Line 3258: nodeAttribute = Doc.CreateAttribute("currency")
Line 3259: nodeAttribute.Value = "USD"
Line 3260: Child5.Attributes.Append(nodeAttribute)
Line 3261: Child4.AppendChild(Child5)
Line 3262: 'close out money
Line 3263:
Line 3264: 'close out Total
Line 3265: Child3.AppendChild(Child4)
Line 3266:
Line 3267: 'close out PunchOutOrderMessage>PunchOutOrderMessageHeader nodes
Line 3268: Child2.AppendChild(Child3)
Line 3269:
Line 3270: 'Bring in items
Line 3271: Dim lineItemCount As Integer
Line 3272: Dim icount As Integer
Line 3273: Dim supplierPartAuxiliaryIDStringBuilder As String = ""
Line 3274: Dim logoPersonalization As String = ""
Line 3275: Dim splitorderlineitemcode As String = ""
Line 3276:
Line 3277: lineItemCount = UBound(elines)
Line 3278: If lineItemCount > 0 Then
Line 3279:
Line 3280: For icount = 1 To lineItemCount - 1
Line 3281:
Line 3282: Child3 = Doc.CreateElement("ItemIn")
Line 3283: Child3.InnerText = ""
Line 3284: nodeAttribute = Doc.CreateAttribute("quantity")
Line 3285: nodeAttribute.Value = elines(icount, 9)
Line 3286: Child3.Attributes.Append(nodeAttribute)
Line 3287:
Line 3288: Child4 = Doc.CreateElement("ItemID")
Line 3289: Child4.InnerText = ""
Line 3290:
Line 3291: Child5 = Doc.CreateElement("SupplierPartID")
Line 3292: Dim subNo As String = Trim(elines(icount, 4))
Line 3293: Dim itemSubNo As String = elines(icount, 3) + IIf(subNo <> "", "~" + subNo, "")
Line 3294: Child5.InnerText = itemSubNo
Line 3295: Child4.AppendChild(Child5)
Line 3296:
Line 3297: supplierPartAuxiliaryIDStringBuilder = ""
Line 3298: logoPersonalization = ""
Line 3299: splitorderlineitemcode = ""
Line 3300:
Line 3301: If getxmlval("aribapasssplitorderlineitemcode") = "Y" Then
Line 3302: splitorderlineitemcode = Trim(elines(icount, 30))
Line 3303: If splitorderlineitemcode <> String.Empty Then
Line 3304: supplierPartAuxiliaryIDStringBuilder = "~lnitm: " + splitorderlineitemcode
Line 3305: End If
Line 3306: End If
Line 3307:
Line 3308: If getxmlval("aribapasslogos") = "Y" Then
Line 3309: logoPersonalization = Trim(elines(icount, 13))
Line 3310: If logoPersonalization <> String.Empty Then
Line 3311: supplierPartAuxiliaryIDStringBuilder += "~" + logoPersonalization
Line 3312: End If
Line 3313: End If
Line 3314:
Line 3315: If supplierPartAuxiliaryIDStringBuilder <> String.Empty Then
Line 3316: Child5 = Doc.CreateElement("SupplierPartAuxiliaryID")
Line 3317: Child5.InnerText = supplierPartAuxiliaryIDStringBuilder
Line 3318: Child4.AppendChild(Child5)
Line 3319: End If
Line 3320:
Line 3321: 'Closeout itemid
Line 3322: Child3.AppendChild(Child4)
Line 3323:
Line 3324: Child4 = Doc.CreateElement("ItemDetail")
Line 3325: Child4.InnerText = ""
Line 3326:
Line 3327: Child5 = Doc.CreateElement("UnitPrice")
Line 3328: Child5.InnerText = ""
Line 3329:
Line 3330: Child6 = Doc.CreateElement("Money")
Line 3331: Child6.InnerText = elines(icount, 10)
Line 3332: nodeAttribute = Doc.CreateAttribute("currency")
Line 3333: nodeAttribute.Value = "USD"
Line 3334: Child6.Attributes.Append(nodeAttribute)
Line 3335: Child5.AppendChild(Child6)
Line 3336:
Line 3337: 'Closeout UnitPrice
Line 3338: Child4.AppendChild(Child5)
Line 3339:
Line 3340: Child5 = Doc.CreateElement("Description")
Line 3341: Child5.InnerText = elines(icount, 6)
Line 3342: nodeAttribute = Doc.CreateAttribute("xml:lang")
Line 3343: nodeAttribute.Value = "en"
Line 3344: Child5.Attributes.Append(nodeAttribute)
Line 3345: Child4.AppendChild(Child5)
Line 3346: 'Closeout Description
Line 3347:
Line 3348: Dim per As Integer = elines(icount, 12)
Line 3349: Child5 = Doc.CreateElement("UnitOfMeasure")
Line 3350: Child5.InnerText = IIf(per = 1, "EA", IIf(per = 12, "DZN", per))
Line 3351: Child4.AppendChild(Child5)
Line 3352: 'Closeout UOM
Line 3353:
Line 3354: Child5 = Doc.CreateElement("Classification")
Line 3355: If getxmlval("useclassificationdefault") = "N" Then
Line 3356: Child5.InnerText = getxmlval("classificationvalue")
Line 3357: nodeAttribute = Doc.CreateAttribute("domain")
Line 3358: nodeAttribute.Value = getxmlval("classificationdomain")
Line 3359: Else
Line 3360: Child5.InnerText = "80141605"
Line 3361: nodeAttribute = Doc.CreateAttribute("domain")
Line 3362: nodeAttribute.Value = "UNSPSC"
Line 3363: End If
Line 3364:
Line 3365: Child5.Attributes.Append(nodeAttribute)
Line 3366: Child4.AppendChild(Child5)
Line 3367: 'Closeout Classification
Line 3368:
Line 3369: Child3.AppendChild(Child4)
Line 3370: 'Closeout ItemDetail
Line 3371:
Line 3372: Child2.AppendChild(Child3)
Line 3373: 'Closeout ItemIn
Line 3374: Next
Line 3375: End If
Line 3376:
Line 3377: If eord(22) > 0 Then 'if order has freight, then add as a Line Item
Line 3378: Child3 = Doc.CreateElement("ItemIn")
Line 3379: Child3.InnerText = ""
Line 3380: nodeAttribute = Doc.CreateAttribute("quantity")
Line 3381: nodeAttribute.Value = 1
Line 3382: Child3.Attributes.Append(nodeAttribute)
Line 3383:
Line 3384: Child4 = Doc.CreateElement("ItemID")
Line 3385: Child4.InnerText = ""
Line 3386:
Line 3387: Child5 = Doc.CreateElement("SupplierPartID")
Line 3388: Child5.InnerText = "SH"
Line 3389: Child4.AppendChild(Child5)
Line 3390: 'Closeout SupplierPartID
Line 3391:
Line 3392: Child3.AppendChild(Child4)
Line 3393: 'Closeout ItemID
Line 3394:
Line 3395: Child4 = Doc.CreateElement("ItemDetail")
Line 3396: Child4.InnerText = ""
Line 3397:
Line 3398: Child5 = Doc.CreateElement("UnitPrice")
Line 3399: Child5.InnerText = ""
Line 3400:
Line 3401: Child6 = Doc.CreateElement("Money")
Line 3402: Child6.InnerText = eord(22)
Line 3403: nodeAttribute = Doc.CreateAttribute("currency")
Line 3404: nodeAttribute.Value = "USD"
Line 3405: Child6.Attributes.Append(nodeAttribute)
Line 3406: Child5.AppendChild(Child6)
Line 3407: ''Closeout Money
Line 3408:
Line 3409: Child4.AppendChild(Child5)
Line 3410: 'Closeout UnitPrice
Line 3411:
Line 3412: Child5 = Doc.CreateElement("Description")
Line 3413: Child5.InnerText = eord(24) 'ship type
Line 3414: nodeAttribute = Doc.CreateAttribute("xml:lang")
Line 3415: nodeAttribute.Value = "en"
Line 3416: Child5.Attributes.Append(nodeAttribute)
Line 3417: Child4.AppendChild(Child5)
Line 3418: 'Closeout Description
Line 3419:
Line 3420: Child5 = Doc.CreateElement("UnitOfMeasure")
Line 3421: Child5.InnerText = "EA"
Line 3422: Child4.AppendChild(Child5)
Line 3423: 'Closeout UOM
Line 3424:
Line 3425: Child5 = Doc.CreateElement("Classification")
Line 3426: If getxmlval("useclassificationdefault") = "N" Then
Line 3427: Child5.InnerText = getxmlval("classificationvalue")
Line 3428: nodeAttribute = Doc.CreateAttribute("domain")
Line 3429: nodeAttribute.Value = getxmlval("classificationdomain")
Line 3430: Else
Line 3431: Child5.InnerText = "80141605"
Line 3432: nodeAttribute = Doc.CreateAttribute("domain")
Line 3433: nodeAttribute.Value = "UNSPSC"
Line 3434: End If
Line 3435:
Line 3436: Child5.Attributes.Append(nodeAttribute)
Line 3437: Child4.AppendChild(Child5)
Line 3438: 'Closeout Classification
Line 3439:
Line 3440: Child3.AppendChild(Child4)
Line 3441: 'Closeout ItemDetail
Line 3442:
Line 3443: Child2.AppendChild(Child3)
Line 3444: 'Closeout ItemIn
Line 3445: End If
Line 3446:
Line 3447: Child.AppendChild(Child2)
Line 3448: 'Closeout PunchOutOrderMessage node
Line 3449:
Line 3450: Root.AppendChild(Child)
Line 3451: 'Closeout Message nodes
Line 3452:
Line 3453: Doc.AppendChild(Root)
Line 3454: response = Doc
Line 3455:
Line 3456: responseString = response.OuterXml
Line 3457: Dim browserformposturl As String = Session("browserformpost")
Line 3458:
Line 3459: ''TODO BOF Temp DEBUG write this Back To Ariba file out
Line 3460: 'Dim testStartDateTime As String = startDateTime.ToString("yyyyMMddHHmmss")
Line 3461: 'Context.Trace.Write(responseString)
Line 3462: 'Dim tempMapPath As String = Server.MapPath("Ariba/Templates/Response_mssgs_BackTo_Ariba/")
Line 3463: 'My.Computer.FileSystem.WriteAllText(tempMapPath + "PunchOutOrderMessageResponse" + testStartDateTime + ".xml", responseString, True)
Line 3464: ''TODO EOF Temp DEBUG write this Back To Ariba file out
Line 3465:
Line 3466: Return responseString
Line 3467:
Line 3468: Catch ex As Exception
Line 3469: ' context.trace.write("Threw Punchout Exception - " + ex.message)
Line 3470: Session("DWException") = "dwexception=" + ex.Message
Line 3471: Return "error"
Line 3472: End Try
Line 3473:
Line 3474: End Function
Line 3475:
Line 3476: Function createCoupaOrder() As String
Line 3477:
Line 3478: Try
Line 3479: Dim responseString As String
Line 3480: Dim dotdot As String = ""
Line 3481: Dim orderid As String = Session("orderid")
Line 3482:
Line 3483: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 3484:
Line 3485: Dim eord As Object = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_createCoupaOrder", Server.MapPath(dotdot), "getorderinfo", "EORDER", orderid, getxmlval("boxlimit"))
Line 3486:
Line 3487: Dim elines As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getorderiteminfo", "ELINITM", orderid)
Line 3488:
Line 3489: If eord(3) <> orderid Then
Line 3490: formerror("Order was not found.")
Line 3491: r1.Response.End()
Line 3492: End If
Line 3493:
Line 3494: Dim startDateTime As DateTime = Now()
Line 3495: Dim response As XmlDocument
Line 3496: Dim Doc As New XmlDocument()
Line 3497: Dim Doc2 As New XmlDocument()
Line 3498: Dim nodeAttribute As XmlAttribute
Line 3499: Dim Child As XmlElement
Line 3500: Dim Child2 As XmlElement
Line 3501: Dim Child3 As XmlElement
Line 3502: Dim Child4 As XmlElement
Line 3503: Dim Child5 As XmlElement
Line 3504: Dim Child6 As XmlElement
Line 3505: Dim doctype As XmlDocumentType
Line 3506: doctype = Doc.CreateDocumentType("cXML", "SYSTEM", "http://xml.cxml.org/schemas/cXML/1.2.021/cXML.dtd", Nothing)
Line 3507: Doc.AppendChild(doctype)
Line 3508:
Line 3509: ' Create the root node.
Line 3510: Dim Root As XmlElement
Line 3511: Root = Doc.CreateElement("cXML")
Line 3512:
Line 3513: ' Add an attribute to the root node.
Line 3514: Dim payloadID As String = GetPayloadID(startDateTime)
Line 3515: Dim Attr As XmlAttribute
Line 3516: Attr = Doc.CreateAttribute("payloadID")
Line 3517: Attr.Value = payloadID
Line 3518: Root.Attributes.Append(Attr)
Line 3519:
Line 3520: nodeAttribute = Doc.CreateAttribute("payloadID")
Line 3521: nodeAttribute.Value = payloadID
Line 3522: Root.Attributes.Append(nodeAttribute)
Line 3523:
Line 3524: ' Add an attribute to the root node.
Line 3525: Dim timeStamp As String = startDateTime.ToString("yyyy-MM-ddTHH:mm:sszzz")
Line 3526: nodeAttribute = Doc.CreateAttribute("timestamp")
Line 3527: nodeAttribute.Value = timeStamp
Line 3528: Root.Attributes.Append(nodeAttribute)
Line 3529:
Line 3530: 'bring in the holdback "Header" file
Line 3531: Doc2.Load(Server.MapPath("Coupa/punchOutOrderMessageHeaderTemplate.xml"))
Line 3532: Dim doc2ChildNode As XmlNode
Line 3533: For Each doc2ChildNode In Doc2.DocumentElement.ChildNodes
Line 3534: Dim doc2MergeNode As XmlNode = Doc.ImportNode(doc2ChildNode, True)
Line 3535: Root.AppendChild(doc2MergeNode)
Line 3536: Next
Line 3537:
Line 3538: Child = Doc.CreateElement("Message")
Line 3539: Child.InnerText = ""
Line 3540:
Line 3541: Child2 = Doc.CreateElement("PunchOutOrderMessage")
Line 3542: Child2.InnerText = ""
Line 3543:
Line 3544: Child3 = Doc.CreateElement("BuyerCookie")
Line 3545: Child3.InnerText = Session("coupabuyercookie")
Line 3546: Child2.AppendChild(Child3)
Line 3547:
Line 3548: Child3 = Doc.CreateElement("PunchOutOrderMessageHeader")
Line 3549: Child3.InnerText = ""
Line 3550: nodeAttribute = Doc.CreateAttribute("operationAllowed")
Line 3551: nodeAttribute.Value = "create"
Line 3552: Child3.Attributes.Append(nodeAttribute)
Line 3553: Child2.AppendChild(Child3)
Line 3554:
Line 3555: Child4 = Doc.CreateElement("Total")
Line 3556: Child4.InnerText = ""
Line 3557: Child5 = Doc.CreateElement("Money")
Line 3558: Child5.InnerText = eord(33) 'Per their example, send Grand Total vs SubTotal (21)
Line 3559: nodeAttribute = Doc.CreateAttribute("currency")
Line 3560: nodeAttribute.Value = "USD"
Line 3561: Child5.Attributes.Append(nodeAttribute)
Line 3562: Child4.AppendChild(Child5) 'close out money
Line 3563: Child3.AppendChild(Child4)
Line 3564: 'Close out Total
Line 3565:
Line 3566: 'Shipping Amount
Line 3567: Child4 = Doc.CreateElement("Shipping")
Line 3568: Child4.InnerText = ""
Line 3569: Child5 = Doc.CreateElement("Money")
Line 3570: Child5.InnerText = eord(22)
Line 3571: nodeAttribute = Doc.CreateAttribute("currency")
Line 3572: nodeAttribute.Value = "USD"
Line 3573: Child5.Attributes.Append(nodeAttribute)
Line 3574: Child4.AppendChild(Child5) 'Close out Money
Line 3575: Child3.AppendChild(Child4)
Line 3576: 'Close out Shipping
Line 3577:
Line 3578: 'Tax Amount
Line 3579: Child4 = Doc.CreateElement("Tax")
Line 3580: Child4.InnerText = ""
Line 3581: Child5 = Doc.CreateElement("Money")
Line 3582: Child5.InnerText = eord(23)
Line 3583: nodeAttribute = Doc.CreateAttribute("currency")
Line 3584: nodeAttribute.Value = "USD"
Line 3585: Child5.Attributes.Append(nodeAttribute)
Line 3586: Child4.AppendChild(Child5) 'Close out Money
Line 3587: Child3.AppendChild(Child4)
Line 3588: 'Close out Tax
Line 3589:
Line 3590: Child2.AppendChild(Child3)
Line 3591: 'close out PunchOutOrderMessage>PunchOutOrderMessageHeader nodes
Line 3592:
Line 3593: 'Bring in items
Line 3594: Dim productDescription As String = ""
Line 3595: Dim logoPersonalization As String = ""
Line 3596: Dim itemMatrixRow As String = ""
Line 3597: Dim itemMatrixColumn As String = ""
Line 3598: Dim lineItemCount As Integer
Line 3599: Dim icount As Integer
Line 3600: lineItemCount = UBound(elines)
Line 3601:
Line 3602: If lineItemCount > 0 Then
Line 3603:
Line 3604: For icount = 1 To lineItemCount - 1
Line 3605: logoPersonalization = ""
Line 3606: itemMatrixRow = ""
Line 3607: itemMatrixColumn = ""
Line 3608:
Line 3609: Child3 = Doc.CreateElement("ItemIn")
Line 3610: Child3.InnerText = ""
Line 3611: nodeAttribute = Doc.CreateAttribute("quantity")
Line 3612: nodeAttribute.Value = elines(icount, 9)
Line 3613: Child3.Attributes.Append(nodeAttribute)
Line 3614:
Line 3615: Child4 = Doc.CreateElement("ItemID")
Line 3616: Child4.InnerText = ""
Line 3617:
Line 3618: Child5 = Doc.CreateElement("SupplierPartID")
Line 3619: Dim subNo As String = Trim(elines(icount, 4))
Line 3620: Dim itemSubNo As String = elines(icount, 3) + IIf(subNo <> "", "~" + subNo, "")
Line 3621: Child5.InnerText = itemSubNo
Line 3622: Child4.AppendChild(Child5)
Line 3623:
Line 3624: Child3.AppendChild(Child4)
Line 3625: 'Close out itemid
Line 3626:
Line 3627: Child4 = Doc.CreateElement("ItemDetail")
Line 3628: Child4.InnerText = ""
Line 3629:
Line 3630: Child5 = Doc.CreateElement("UnitPrice")
Line 3631: Child5.InnerText = ""
Line 3632: Child6 = Doc.CreateElement("Money")
Line 3633: Child6.InnerText = elines(icount, 10)
Line 3634: nodeAttribute = Doc.CreateAttribute("currency")
Line 3635: nodeAttribute.Value = "USD"
Line 3636: Child6.Attributes.Append(nodeAttribute)
Line 3637: Child5.AppendChild(Child6)
Line 3638: Child4.AppendChild(Child5)
Line 3639: 'Close out UnitPrice
Line 3640:
Line 3641: 'Includes any Logo and/or Matrix Size Color
Line 3642: productDescription = elines(icount, 6)
Line 3643: logoPersonalization = Trim(elines(icount, 13))
Line 3644: If logoPersonalization <> String.Empty Then
Line 3645: productDescription += "~" + logoPersonalization
Line 3646: End If
Line 3647: itemMatrixColumn = Trim(elines(icount, 27)) 'will probably be matrix size
Line 3648: If itemMatrixColumn <> String.Empty Then
Line 3649: productDescription += "~c: " + itemMatrixColumn
Line 3650: End If
Line 3651: itemMatrixRow = Trim(elines(icount, 26)) ' will probably be matrix color
Line 3652: If itemMatrixRow <> String.Empty Then
Line 3653: productDescription += "~r: " + itemMatrixRow
Line 3654: End If
Line 3655:
Line 3656: Child5 = Doc.CreateElement("Description")
Line 3657: Child5.InnerText = productDescription
Line 3658: nodeAttribute = Doc.CreateAttribute("xml:lang")
Line 3659: nodeAttribute.Value = "en"
Line 3660: Child5.Attributes.Append(nodeAttribute)
Line 3661: Child4.AppendChild(Child5)
Line 3662: 'Close out Description
Line 3663:
Line 3664: Dim per As Integer = elines(icount, 12)
Line 3665: Child5 = Doc.CreateElement("UnitOfMeasure")
Line 3666: Child5.InnerText = IIf(per = 1, "EA", IIf(per = 12, "DZN", per))
Line 3667: Child4.AppendChild(Child5)
Line 3668: 'Close out UOM
Line 3669:
Line 3670: Child5 = Doc.CreateElement("Classification")
Line 3671: Child5.InnerText = "" 'for now, send empty
Line 3672: nodeAttribute = Doc.CreateAttribute("domain")
Line 3673: nodeAttribute.Value = "UNSPSC"
Line 3674: Child5.Attributes.Append(nodeAttribute)
Line 3675: Child4.AppendChild(Child5)
Line 3676: 'Close out Classification
Line 3677:
Line 3678: Child3.AppendChild(Child4)
Line 3679: 'Close out ItemDetail
Line 3680:
Line 3681: Child2.AppendChild(Child3)
Line 3682: 'Close out ItemIn
Line 3683: Next
Line 3684: End If
Line 3685:
Line 3686: If eord(22) > 0 Then 'if order has freight, then add as a Line Item
Line 3687: Child3 = Doc.CreateElement("ItemIn")
Line 3688: Child3.InnerText = ""
Line 3689: nodeAttribute = Doc.CreateAttribute("quantity")
Line 3690: nodeAttribute.Value = 1
Line 3691: Child3.Attributes.Append(nodeAttribute)
Line 3692:
Line 3693: Child4 = Doc.CreateElement("ItemID")
Line 3694: Child4.InnerText = ""
Line 3695:
Line 3696: Child5 = Doc.CreateElement("SupplierPartID")
Line 3697: Child5.InnerText = "SH"
Line 3698: Child4.AppendChild(Child5)
Line 3699: 'Close out SupplierPartID
Line 3700:
Line 3701: Child3.AppendChild(Child4)
Line 3702: 'Close out ItemID
Line 3703:
Line 3704: Child4 = Doc.CreateElement("ItemDetail")
Line 3705: Child4.InnerText = ""
Line 3706:
Line 3707: Child5 = Doc.CreateElement("UnitPrice")
Line 3708: Child5.InnerText = ""
Line 3709:
Line 3710: Child6 = Doc.CreateElement("Money")
Line 3711: Child6.InnerText = eord(22)
Line 3712: nodeAttribute = Doc.CreateAttribute("currency")
Line 3713: nodeAttribute.Value = "USD"
Line 3714: Child6.Attributes.Append(nodeAttribute)
Line 3715: Child5.AppendChild(Child6)
Line 3716: 'Close out Money
Line 3717:
Line 3718: Child4.AppendChild(Child5)
Line 3719: 'Close out UnitPrice
Line 3720:
Line 3721: Child5 = Doc.CreateElement("Description")
Line 3722: Child5.InnerText = eord(24) 'ship type
Line 3723: nodeAttribute = Doc.CreateAttribute("xml:lang")
Line 3724: nodeAttribute.Value = "en"
Line 3725: Child5.Attributes.Append(nodeAttribute)
Line 3726: Child4.AppendChild(Child5)
Line 3727: 'Close out Description
Line 3728:
Line 3729: Child5 = Doc.CreateElement("UnitOfMeasure")
Line 3730: Child5.InnerText = "EA"
Line 3731: Child4.AppendChild(Child5)
Line 3732: 'Close out UOM
Line 3733:
Line 3734: Child5 = Doc.CreateElement("Classification")
Line 3735: Child5.InnerText = "" 'for now, send empty
Line 3736: nodeAttribute = Doc.CreateAttribute("domain")
Line 3737: nodeAttribute.Value = "UNSPSC"
Line 3738: Child5.Attributes.Append(nodeAttribute)
Line 3739: Child4.AppendChild(Child5)
Line 3740: 'Close out Classification
Line 3741:
Line 3742: Child3.AppendChild(Child4)
Line 3743: 'Close out ItemDetail
Line 3744:
Line 3745: Child2.AppendChild(Child3)
Line 3746: 'Close out ItemIn
Line 3747: End If
Line 3748:
Line 3749: Child.AppendChild(Child2)
Line 3750: 'Close out PunchOutOrderMessage node
Line 3751:
Line 3752: Root.AppendChild(Child)
Line 3753: 'Close out Message nodes
Line 3754:
Line 3755: Doc.AppendChild(Root)
Line 3756: response = Doc
Line 3757:
Line 3758: responseString = response.OuterXml
Line 3759: Dim browserformposturl As String = Session("browserformpost")
Line 3760:
Line 3761: ''TODO BOF Temp DEBUG write this Back To Coupa file out
Line 3762: Dim testStartDateTime As String = startDateTime.ToString("yyyyMMddHHmmss")
Line 3763: Context.Trace.Write(responseString)
Line 3764: Dim tempMapPath As String = Server.MapPath("Coupa/Templates/Response_mssgs_BackTo_Coupa/")
Line 3765: My.Computer.FileSystem.WriteAllText(tempMapPath + "PunchOutOrderMessageResponse" + testStartDateTime + ".xml", responseString, True)
Line 3766: ''TODO EOF Temp DEBUG write this Back To Coupa file out
Line 3767:
Line 3768: Return responseString
Line 3769:
Line 3770: Catch ex As Exception
Line 3771: ' context.trace.write("Threw Punchout Exception - " + ex.message)
Line 3772: Session("DWException") = "dwexception=" + ex.Message
Line 3773: Return "error"
Line 3774: End Try
Line 3775:
Line 3776: End Function
Line 3777:
Line 3778: Sub createxmlorder(ByVal orderid, ByVal system)
Line 3779: ' NOTE - there is also a createxmlorder() function in _Functions.ascx in main directory
Line 3780: ' - Not sure when that one gets used if ever. Changing this one for SmartBooks (12/4/2013)
Line 3781: '
Line 3782: Dim f1 As New functions
Line 3783: Dim addUrgentCreditCardNote As Boolean = False
Line 3784: Dim cGiftCertMC As String = getxmlval("giftcertmc")
Line 3785: Dim softwareProductType As String = f1.getSoftwareProductType()
Line 3786: Dim dotdot As String = ""
Line 3787: Dim isGiftCertLineItem As Boolean = False
Line 3788: Dim orderType As String = getxmlval("ordertype")
Line 3789: Dim processLine As Boolean
Line 3790: Dim splitOrderLineItemType As String = ""
Line 3791: Dim splitOrderFFLineItemCode As String = ""
Line 3792: Dim splitOrderOELineItemCode As String = ""
Line 3793:
Line 3794: If orderType = "splitorderxmls" Then
Line 3795: splitOrderFFLineItemCode = Trim(getxmlval("splitorderfflineitemcode"))
Line 3796: splitOrderOELineItemCode = Trim(getxmlval("splitorderoelineitemcode"))
Line 3797: End If
Line 3798:
Line 3799: If Trim(orderid) = "" Then
Line 3800: orderid = Session("orderid")
Line 3801: Else
Line 3802: dotdot = ".."
Line 3803: End If
Line 3804:
Line 3805: Try
Line 3806: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 3807:
Line 3808: Dim eord As Object = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_createxmlorder", Server.MapPath(dotdot), "getorderinfo", "EORDER", orderid, getxmlval("boxlimit"))
Line 3809:
Line 3810: Dim elines As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getorderiteminfo", "ELINITM", orderid)
Line 3811:
Line 3812: If eord(3) <> orderid Then
Line 3813: formerror("Order was not found.")
Line 3814: r1.Response.End()
Line 3815: End If
Line 3816:
Line 3817: Dim webtrack As String = eord(1)
Line 3818: Dim ordno As String
Line 3819:
Line 3820: Dim xmlpath As String = ""
Line 3821: Dim xmlpathOriginal As String = ""
Line 3822: Dim xmlfilename As String = Trim(getxmlval("sprogram")) & CStr(Year(Now)) & CStr(Month(Now)) & CStr(Day(Now)) & CStr(Hour(Now)) & CStr(Minute(Now)) & CStr(Second(Now)) & ".xml"
Line 3823: Dim xmlwriter As XmlTextWriter
Line 3824: Dim xmlstream As System.IO.Stream = Stream.Null
Line 3825: Dim netusername As String
Line 3826: Dim netpwd As String
Line 3827:
Line 3828: If orderType = "splitorderxmls" And system = "REG" Then
Line 3829: xmlpath = addwack(Trim(getxmlval("splitorderregordpath")))
Line 3830: netusername = getxmlval("splitorderordpathusr")
Line 3831: netpwd = getxmlval("splitorderordpathpwd")
Line 3832: Else
Line 3833: xmlpath = addwack(Trim(getxmlval("regordpath")))
Line 3834: netusername = getxmlval("ordpathusr")
Line 3835: netpwd = getxmlval("ordpathpwd")
Line 3836:
Line 3837: If softwareProductType = "ProfitMaker" And system = "FF" Then
Line 3838: xmlpathOriginal = xmlpath
Line 3839: xmlpath = xmlpath & "Temp\"
Line 3840: End If
Line 3841:
Line 3842: End If
Line 3843:
Line 3844: If Left(xmlpath, 2) = "\\" And netusername <> String.Empty And netpwd <> String.Empty Then
Line 3845: Dim xmlfilecreated As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dotdot), "CreateTextFile", xmlpath, netusername, netpwd, xmlfilename, String.Empty)
Line 3846: End If
Line 3847:
Line 3848: 'Tax info
Line 3849: Dim tcount As Integer
Line 3850: Dim taxlines As Object
Line 3851: Dim stringwriter1 As StringWriter = New StringWriter()
Line 3852:
Line 3853: If softwareProductType = "ASISB" Then
Line 3854: 'SMARTBOOKS
Line 3855: If f1.getASISBXMLOrderImportIPAddress() <> "" Then
Line 3856: xmlwriter = New XmlTextWriter(stringwriter1)
Line 3857: Else
Line 3858: xmlwriter = New XmlTextWriter(xmlpath & xmlfilename, Nothing)
Line 3859: End If
Line 3860:
Line 3861: Else
Line 3862: Try
Line 3863: xmlwriter = New XmlTextWriter(xmlpath & xmlfilename, Nothing)
Line 3864:
Line 3865: Catch ex As Exception
Line 3866: Dim filesys As Object = Server.CreateObject("Scripting.FileSystemObject")
Line 3867:
Line 3868: If filesys.FolderExists(xmlpath) = False Then
Line 3869: filesys.CreateFolder(xmlpath)
Line 3870: End If
Line 3871:
Line 3872: filesys = Nothing
Line 3873:
Line 3874: xmlwriter = New XmlTextWriter(xmlpath & xmlfilename, Nothing)
Line 3875:
Line 3876: End Try
Line 3877:
Line 3878: End If
Line 3879:
Line 3880: xmlwriter.Formatting = Formatting.Indented
Line 3881:
Line 3882: xmlwriter.WriteStartDocument()
Line 3883:
Line 3884: If softwareProductType = "ASISB" Then
Line 3885: 'SMARTBOOKS
Line 3886: xmlwriter.WriteStartElement("Order")
Line 3887:
Line 3888: xmlwriter.WriteElementString("Version", "0.0.0.1")
Line 3889: xmlwriter.WriteElementString("FileName", xmlfilename)
Line 3890: xmlwriter.WriteElementString("CustomerCode", eord(34))
Line 3891: 'xmlwriter.WriteElementString("ordtype", checkprogram())
Line 3892: xmlwriter.WriteElementString("WebTrackingNumber", eord(1))
Line 3893: xmlwriter.WriteElementString("EcommerceOrder", eord(3))
Line 3894: xmlwriter.WriteElementString("EcommerceLogin", eord(4))
Line 3895: xmlwriter.WriteElementString("EcommerceEmployeeCode", Session("empid"))
Line 3896:
Line 3897: 'Order date - SB does now write the date to eOrder so just use todays date
Line 3898: Dim orderdate As String
Line 3899: orderdate = Now().ToString("MM/dd/yyyy")
Line 3900:
Line 3901: xmlwriter.WriteElementString("OrderDateMonth", Mid(orderdate, 1, 2))
Line 3902: xmlwriter.WriteElementString("OrderDateDay", Mid(orderdate, 4, 2))
Line 3903: xmlwriter.WriteElementString("OrderDateYear", Mid(orderdate, 7, 4))
Line 3904:
Line 3905: 'Customer PO#
Line 3906: xmlwriter.WriteElementString("POReference", eord(27))
Line 3907:
Line 3908: Dim inhanddate As String
Line 3909: inhanddate = eord(52)
Line 3910: Dim ihdate As Date
Line 3911: If Date.TryParse(inhanddate, ihdate) Then
Line 3912: inhanddate = ihdate.ToString("MM/dd/yyyy")
Line 3913: xmlwriter.WriteElementString("InHandDateMonth", Mid(inhanddate, 1, 2))
Line 3914: xmlwriter.WriteElementString("InHandDateDay", Mid(inhanddate, 4, 2))
Line 3915: xmlwriter.WriteElementString("InHandDateYear", Mid(inhanddate, 7, 4))
Line 3916: Else
Line 3917: xmlwriter.WriteElementString("InHandDateMonth", "")
Line 3918: xmlwriter.WriteElementString("InHandDateDay", "")
Line 3919: xmlwriter.WriteElementString("InHandDateYear", "")
Line 3920: End If
Line 3921:
Line 3922: xmlwriter.WriteElementString("ShipVia", eord(24))
Line 3923: xmlwriter.WriteElementString("Program", eord(5))
Line 3924:
Line 3925: 'Bill to info
Line 3926: xmlwriter.WriteElementString("BillCompany", eord(6))
Line 3927: xmlwriter.WriteElementString("BillAttention", eord(7))
Line 3928: xmlwriter.WriteElementString("BillAddress1", eord(8))
Line 3929: xmlwriter.WriteElementString("BillAddress2", eord(9))
Line 3930: xmlwriter.WriteElementString("BillCity", eord(10))
Line 3931: xmlwriter.WriteElementString("BillState", eord(11))
Line 3932: xmlwriter.WriteElementString("BillZip", eord(12))
Line 3933: xmlwriter.WriteElementString("BillCountry", eord(63))
Line 3934: xmlwriter.WriteElementString("BillPhone", eord(20).replace("-", ""))
Line 3935: xmlwriter.WriteElementString("BillEmail", eord(41))
Line 3936: 'Ack to info
Line 3937: xmlwriter.WriteElementString("AckCompany", eord(6))
Line 3938: xmlwriter.WriteElementString("AckAttention", eord(7))
Line 3939: xmlwriter.WriteElementString("AckAddress1", eord(8))
Line 3940: xmlwriter.WriteElementString("AckAddress2", eord(9))
Line 3941: xmlwriter.WriteElementString("AckCity", eord(10))
Line 3942: xmlwriter.WriteElementString("AckState", eord(11))
Line 3943: xmlwriter.WriteElementString("AckZip", eord(12))
Line 3944: xmlwriter.WriteElementString("AckCountry", eord(63))
Line 3945: xmlwriter.WriteElementString("AckPhone", eord(20).replace("-", ""))
Line 3946: 'Ship to info
Line 3947: xmlwriter.WriteElementString("ShipCompany", eord(13))
Line 3948: xmlwriter.WriteElementString("ShipAttention", eord(14))
Line 3949: xmlwriter.WriteElementString("ShipAddress1", eord(15))
Line 3950: xmlwriter.WriteElementString("ShipAddress2", eord(16))
Line 3951: xmlwriter.WriteElementString("ShipCity", eord(17))
Line 3952: xmlwriter.WriteElementString("ShipState", eord(18))
Line 3953: xmlwriter.WriteElementString("ShipZip", eord(19))
Line 3954: xmlwriter.WriteElementString("ShipCountry", eord(64))
Line 3955: xmlwriter.WriteElementString("ShipEmail", eord(41))
Line 3956: Dim sPhone As String
Line 3957: If getxmlval("sphonepm") = "Y" And Session("sphone") <> String.Empty Then
Line 3958: sPhone = Session("sphone")
Line 3959: ElseIf getxmlval("sphonepm") = "Y" And Session("s_phone") <> String.Empty Then
Line 3960: sPhone = Session("s_phone")
Line 3961: Else
Line 3962: sPhone = eord(20)
Line 3963: End If
Line 3964:
Line 3965: xmlwriter.WriteElementString("ShipPhone", sPhone.Replace("-", ""))
Line 3966: xmlwriter.WriteElementString("shipamt", eord(22))
Line 3967: xmlwriter.WriteElementString("shipdesc", eord(24))
Line 3968: xmlwriter.WriteElementString("taxamt", eord(23))
Line 3969: xmlwriter.WriteElementString("grdtotal", eord(33))
Line 3970:
Line 3971: 'User defined fields
Line 3972:
Line 3973: xmlwriter.WriteStartElement("UserDefinedFields")
Line 3974: Dim tempdate As Date
Line 3975:
Line 3976: xmlwriter.WriteStartElement("Field")
Line 3977: xmlwriter.WriteElementString("Label", "alpha1")
Line 3978: xmlwriter.WriteElementString("DisplaySequence", "1")
Line 3979: xmlwriter.WriteElementString("Value", eord(35))
Line 3980: xmlwriter.WriteEndElement()
Line 3981:
Line 3982: xmlwriter.WriteStartElement("Field")
Line 3983: xmlwriter.WriteElementString("Label", "alpha2")
Line 3984: xmlwriter.WriteElementString("DisplaySequence", "2")
Line 3985: xmlwriter.WriteElementString("Value", eord(36))
Line 3986: xmlwriter.WriteEndElement()
Line 3987:
Line 3988: xmlwriter.WriteStartElement("Field")
Line 3989: xmlwriter.WriteElementString("Label", "alpha3")
Line 3990: xmlwriter.WriteElementString("DisplaySequence", "3")
Line 3991: xmlwriter.WriteElementString("Value", eord(37))
Line 3992: xmlwriter.WriteEndElement()
Line 3993:
Line 3994: xmlwriter.WriteStartElement("Field")
Line 3995: xmlwriter.WriteElementString("Label", "num1")
Line 3996: xmlwriter.WriteElementString("DisplaySequence", "4")
Line 3997: xmlwriter.WriteElementString("Value", eord(38))
Line 3998: xmlwriter.WriteEndElement()
Line 3999:
Line 4000: xmlwriter.WriteStartElement("Field")
Line 4001: xmlwriter.WriteElementString("Label", "num2")
Line 4002: xmlwriter.WriteElementString("DisplaySequence", "5")
Line 4003: xmlwriter.WriteElementString("Value", eord(39))
Line 4004: xmlwriter.WriteEndElement()
Line 4005:
Line 4006: xmlwriter.WriteStartElement("Field")
Line 4007: xmlwriter.WriteElementString("Label", "num3")
Line 4008: xmlwriter.WriteElementString("DisplaySequence", "6")
Line 4009: xmlwriter.WriteElementString("Value", eord(40))
Line 4010: xmlwriter.WriteEndElement()
Line 4011:
Line 4012: xmlwriter.WriteStartElement("Field")
Line 4013: xmlwriter.WriteElementString("Label", "date1")
Line 4014: xmlwriter.WriteElementString("DisplaySequence", "7")
Line 4015: If Date.TryParse(eord(68), tempdate) Then
Line 4016: xmlwriter.WriteElementString("Value", tempdate)
Line 4017: Else
Line 4018: xmlwriter.WriteElementString("Value", "")
Line 4019: End If
Line 4020: xmlwriter.WriteEndElement()
Line 4021:
Line 4022: xmlwriter.WriteStartElement("Field")
Line 4023: xmlwriter.WriteElementString("Label", "date2")
Line 4024: xmlwriter.WriteElementString("DisplaySequence", "8")
Line 4025: If Date.TryParse(eord(69), tempdate) Then
Line 4026: xmlwriter.WriteElementString("Value", tempdate)
Line 4027: Else
Line 4028: xmlwriter.WriteElementString("Value", "")
Line 4029: End If
Line 4030: xmlwriter.WriteEndElement()
Line 4031:
Line 4032: xmlwriter.WriteStartElement("Field")
Line 4033: xmlwriter.WriteElementString("Label", "date3")
Line 4034: xmlwriter.WriteElementString("DisplaySequence", "9")
Line 4035: If Date.TryParse(eord(70), tempdate) Then
Line 4036: xmlwriter.WriteElementString("Value", tempdate)
Line 4037: Else
Line 4038: xmlwriter.WriteElementString("Value", "")
Line 4039: End If
Line 4040: xmlwriter.WriteEndElement()
Line 4041:
Line 4042: xmlwriter.WriteEndElement()
Line 4043:
Line 4044:
Line 4045: 'Credit card info
Line 4046: If eord(33) > 0 Then
Line 4047: xmlwriter.WriteElementString("cctype", eord(30))
Line 4048:
Line 4049: Dim testst As String
Line 4050: testst = eord(74)
Line 4051: If testst.IndexOf("~~~") > -1 Then
Line 4052: Dim pid As String
Line 4053: pid = testst.Substring(0, testst.IndexOf("~~~"))
Line 4054: Dim payid As String
Line 4055: payid = (testst.Substring(testst.IndexOf("~~~") + 3))
Line 4056: xmlwriter.WriteElementString("CustomerProfileID", pid)
Line 4057: xmlwriter.WriteElementString("PaymentProfileID", payid)
Line 4058: Else
Line 4059: xmlwriter.WriteElementString("vaultid", eord(74))
Line 4060: xmlwriter.WriteElementString("CustomerProfileID", "")
Line 4061: xmlwriter.WriteElementString("PaymentProfileID", "")
Line 4062: End If
Line 4063:
Line 4064: xmlwriter.WriteElementString("maskedccno", eord(75))
Line 4065: xmlwriter.WriteElementString("ccmembname", eord(32))
Line 4066: xmlwriter.WriteElementString("ccnum", eord(66))
Line 4067: xmlwriter.WriteElementString("ccexpire", eord(28) & eord(29))
Line 4068: xmlwriter.WriteElementString("ccauthzano", eord(59))
Line 4069:
Line 4070:
Line 4071: 'xmlwriter.WriteElementString("ccauthrefer", eord(60))
Line 4072: Dim transtest As String
Line 4073: transtest = eord(60)
Line 4074: If transtest.IndexOf("~~~") > -1 Then
Line 4075: Dim tr As String
Line 4076: tr = transtest.Substring(0, transtest.IndexOf("~~~"))
Line 4077: Dim trcd As String
Line 4078: trcd = (transtest.Substring(transtest.IndexOf("~~~") + 3))
Line 4079: xmlwriter.WriteElementString("ccauthrefer", tr)
Line 4080: xmlwriter.WriteElementString("authorizeresponse", trcd.Substring(0, 1))
Line 4081: xmlwriter.WriteElementString("authorizeAVS", trcd.Substring(2, 1))
Line 4082: xmlwriter.WriteElementString("authorizereason", trcd.Substring(4))
Line 4083: Else
Line 4084: xmlwriter.WriteElementString("ccauthrefer", eord(60))
Line 4085: xmlwriter.WriteElementString("authorizeresponse", "")
Line 4086: xmlwriter.WriteElementString("authorizeAVS", "")
Line 4087: xmlwriter.WriteElementString("authorizereason", "")
Line 4088: End If
Line 4089:
Line 4090: xmlwriter.WriteElementString("ccsettled", eord(67))
Line 4091: xmlwriter.WriteElementString("cccsc", String.Empty)
Line 4092: xmlwriter.WriteElementString("paymenttype", eord(76))
Line 4093: End If
Line 4094:
Line 4095: Dim aIcount, icount, subno, itemno, row, rowdesc, rowseq, column, coldesc, colseq, acols, arows
Line 4096: Dim subnostrings() As String
Line 4097: aIcount = UBound(elines)
Line 4098:
Line 4099: If aIcount > 0 Then
Line 4100:
Line 4101: Dim multloc As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dotdot), "CheckSpecial", "0104")
Line 4102: 'Item info
Line 4103: xmlwriter.WriteStartElement("Products")
Line 4104:
Line 4105: For icount = 1 To aIcount - 1
Line 4106:
Line 4107: Dim isMatrix As Boolean = False
Line 4108: If Trim(elines(icount, 24)) <> "" Then
Line 4109: isMatrix = True
Line 4110: End If
Line 4111: itemno = elines(icount, 3)
Line 4112: subno = elines(icount, 4)
Line 4113:
Line 4114: Dim freightitem As Boolean
Line 4115: freightitem = False
Line 4116:
Line 4117: xmlwriter.WriteStartElement("Product")
Line 4118: 'xmlwriter.WriteElementString("lineno", CStr(icount))
Line 4119:
Line 4120: If itemno = "SH" Then
Line 4121: freightitem = True
Line 4122: If Session("SBFRTITEM") <> "SH" And Session("SBFRTITEM") <> "" Then
Line 4123: itemno = Session("SBFRTITEM")
Line 4124: End If
Line 4125: End If
Line 4126:
Line 4127: xmlwriter.WriteElementString("Code", itemno)
Line 4128:
Line 4129: If freightitem = True Then
Line 4130: xmlwriter.WriteElementString("FreightItem", "true")
Line 4131: End If
Line 4132: 'xmlwriter.WriteElementString("itemcustno", elines(icount, 5))
Line 4133: xmlwriter.WriteElementString("Description", elines(icount, 6))
Line 4134: 'If elines(icount, 7) <> String.Empty Then
Line 4135: ' xmlwriter.WriteElementString("twodesc", elines(icount, 7))
Line 4136: 'End If
Line 4137: xmlwriter.WriteElementString("Ordered", elines(icount, 9))
Line 4138: xmlwriter.WriteElementString("Price", elines(icount, 10))
Line 4139: xmlwriter.WriteElementString("PricePer", elines(icount, 12))
Line 4140: xmlwriter.WriteElementString("CostPer", "1")
Line 4141: xmlwriter.WriteElementString("Cost", "")
Line 4142: xmlwriter.WriteElementString("UnitOfMeasure", "Each")
Line 4143: xmlwriter.WriteElementString("Points", IIf(getxmlval("pointson") = "points", elines(icount, 15), String.Empty))
Line 4144: xmlwriter.WriteElementString("Taxable", elines(icount, 25))
Line 4145:
Line 4146: inhanddate = eord(52)
Line 4147: If Date.TryParse(inhanddate, ihdate) Then
Line 4148: inhanddate = ihdate.ToString("MM/dd/yyyy")
Line 4149: xmlwriter.WriteElementString("ProductInHandDateMonth", Mid(inhanddate, 1, 2))
Line 4150: xmlwriter.WriteElementString("ProductInHandDateDay", Mid(inhanddate, 4, 2))
Line 4151: xmlwriter.WriteElementString("ProductInHandDateYear", Mid(inhanddate, 7, 4))
Line 4152: Else
Line 4153: xmlwriter.WriteElementString("ProductInHandDateMonth", "")
Line 4154: xmlwriter.WriteElementString("ProductInHandDateDay", "")
Line 4155: xmlwriter.WriteElementString("ProductInHandDateYear", "")
Line 4156: End If
Line 4157:
Line 4158:
Line 4159: Dim shipdate As String
Line 4160: shipdate = eord(42)
Line 4161: Dim shdate As Date
Line 4162: If Date.TryParse(shipdate, shdate) Then
Line 4163: shipdate = shdate.ToString("MM/dd/yyyy")
Line 4164: xmlwriter.WriteElementString("ProductShipDateMonth", Mid(shipdate, 1, 2))
Line 4165: xmlwriter.WriteElementString("ProductShipDateDay", Mid(shipdate, 4, 2))
Line 4166: xmlwriter.WriteElementString("ProductShipDateYear", Mid(shipdate, 7, 4))
Line 4167: Else
Line 4168: xmlwriter.WriteElementString("ProductShipDateMonth", "")
Line 4169: xmlwriter.WriteElementString("ProductShipDateDay", "")
Line 4170: xmlwriter.WriteElementString("ProductShipDateYear", "")
Line 4171: End If
Line 4172:
Line 4173: Dim prstr As String
Line 4174: prstr = elines(icount, 13).ToString()
Line 4175: If prstr <> "" Then
Line 4176: xmlwriter.WriteStartElement("ProductInstructions")
Line 4177: xmlwriter.WriteElementString("Personalization", elines(icount, 13))
Line 4178: xmlwriter.WriteEndElement()
Line 4179: End If
Line 4180:
Line 4181: Dim methinv As String = ""
Line 4182: If elines(icount, 22) = "1" Then
Line 4183: methinv = "Drop Ship"
Line 4184: End If
Line 4185: If elines(icount, 22) = "3" Then
Line 4186: methinv = "Release Stock"
Line 4187: End If
Line 4188: If elines(icount, 22) = "4" Then
Line 4189: methinv = "Release Customer Stock"
Line 4190: End If
Line 4191: If methinv <> "" Then
Line 4192: xmlwriter.WriteElementString("Method", methinv)
Line 4193: End If
Line 4194:
Line 4195: If Not subno.trim() = "" Then
Line 4196:
Line 4197: If subno.substring(0, 1) <> "." Then
Line 4198: ' subno should start with "." with format of .columnattribute.rowattribute
Line 4199: xmlwriter.WriteElementString("MatrixError", "(" + subno + ") subno does not start with . char")
Line 4200: Else ' 'subno.substring(0, 1) <> "."
Line 4201: subnostrings = subno.split(New [Char]() {"."c})
Line 4202: If subnostrings.Count <> 3 Then
Line 4203: xmlwriter.WriteElementString("MatrixError", "(" + subno + ") subno.split() does not contain 3 elements")
Line 4204: Else 'subnostrings.Count <> 3
Line 4205:
Line 4206: column = subnostrings(1).Trim()
Line 4207: row = subnostrings(2).Trim()
Line 4208:
Line 4209: arows = f1.ecomwrapperGetMatrixRowColumn(itemno, "Column")
Line 4210: acols = f1.ecomwrapperGetMatrixRowColumn(itemno, "Row")
Line 4211: rowseq = ""
Line 4212: colseq = ""
Line 4213: rowdesc = ""
Line 4214: coldesc = ""
Line 4215: For i1 As Integer = 1 To UBound(arows)
Line 4216: If row = arows(i1, 1) Then
Line 4217: 'rowseq = i1.ToString()
Line 4218: rowseq = "1"
Line 4219: rowdesc = arows(i1, 2)
Line 4220: Exit For
Line 4221: End If
Line 4222: Next
Line 4223: For i1 As Integer = 1 To UBound(acols)
Line 4224: If column = acols(i1, 1) Then
Line 4225: 'colseq = i1.ToString()
Line 4226: colseq = "1"
Line 4227: coldesc = acols(i1, 2)
Line 4228: Exit For
Line 4229: End If
Line 4230: Next
Line 4231:
Line 4232: xmlwriter.WriteStartElement("Matrix")
Line 4233: xmlwriter.WriteStartElement("MatrixValue")
Line 4234:
Line 4235: xmlwriter.WriteElementString("RowDescription", rowdesc)
Line 4236: xmlwriter.WriteElementString("RowSequence", rowseq)
Line 4237: xmlwriter.WriteElementString("ColumnDescription", coldesc)
Line 4238: xmlwriter.WriteElementString("ColumnSequence", colseq)
Line 4239:
Line 4240: xmlwriter.WriteElementString("Quantity", elines(icount, 9))
Line 4241:
Line 4242: xmlwriter.WriteEndElement()
Line 4243: xmlwriter.WriteEndElement()
Line 4244: End If ' subnostrings.Count <> 3
Line 4245: End If 'subno.substring(0, 1) <> "."
Line 4246: End If ' Not subno = ""
Line 4247:
Line 4248: xmlwriter.WriteEndElement()
Line 4249:
Line 4250: Next
Line 4251:
Line 4252: xmlwriter.WriteEndElement() ' end Products
Line 4253:
Line 4254: 'Order notes
Line 4255: ' xmlwriter.WriteElementString("Notes", eord(43).replace("#", ""))
Line 4256: xmlwriter.WriteStartElement("OrderInstructions")
Line 4257: xmlwriter.WriteElementString("Acknowledgement", eord(43).replace("#", ""))
Line 4258: xmlwriter.WriteElementString("PackingList", eord(43).replace("#", ""))
Line 4259: xmlwriter.WriteEndElement()
Line 4260:
Line 4261: taxlines = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getordertaxinfo", orderid, "")
Line 4262:
Line 4263: tcount = UBound(taxlines)
Line 4264:
Line 4265: xmlwriter.WriteStartElement("taxes")
Line 4266:
Line 4267: For icount = 1 To tcount
Line 4268:
Line 4269: xmlwriter.WriteStartElement("tax")
Line 4270: xmlwriter.WriteElementString("rectype", "T")
Line 4271: xmlwriter.WriteElementString("ordno", eord(1))
Line 4272: xmlwriter.WriteElementString("seqno", "1")
Line 4273: xmlwriter.WriteElementString("webtrack", eord(1))
Line 4274: xmlwriter.WriteElementString("taxcode", taxlines(icount, 1))
Line 4275: xmlwriter.WriteElementString("taxrate", taxlines(icount, 2))
Line 4276: xmlwriter.WriteEndElement()
Line 4277:
Line 4278: Next
Line 4279:
Line 4280: xmlwriter.WriteEndElement()
Line 4281:
Line 4282: End If ' aIcount > 0
Line 4283:
Line 4284: Else ' EOF softwareproducttype = "ASISB"
Line 4285:
Line 4286: xmlwriter.WriteStartElement("order")
Line 4287: xmlwriter.WriteStartElement("version")
Line 4288: xmlwriter.WriteEndElement()
Line 4289:
Line 4290: 'BOF "FF" type orders
Line 4291: If system = "FF" Then
Line 4292:
Line 4293: xmlwriter.WriteElementString("rectype", "B")
Line 4294: xmlwriter.WriteElementString("seqno", "1")
Line 4295:
Line 4296: If eord(27) <> "" Then
Line 4297: ordno = eord(27)
Line 4298: Else
Line 4299: ordno = eord(1)
Line 4300: End If
Line 4301:
Line 4302: xmlwriter.WriteElementString("ordno", ordno)
Line 4303: xmlwriter.WriteElementString("webtrack", webtrack)
Line 4304: xmlwriter.WriteElementString("orddate", eord(2))
Line 4305: xmlwriter.WriteElementString("loginid", eord(4))
Line 4306: xmlwriter.WriteElementString("email", eord(41))
Line 4307: xmlwriter.WriteElementString("ordcust", eord(34))
Line 4308: xmlwriter.WriteElementString("ordtype", "FF")
Line 4309:
Line 4310: 'Bill to address info
Line 4311: xmlwriter.WriteElementString("bcompany", eord(6))
Line 4312: xmlwriter.WriteElementString("battn", eord(7))
Line 4313: xmlwriter.WriteElementString("baddr1", eord(8))
Line 4314: xmlwriter.WriteElementString("baddr2", eord(9))
Line 4315: xmlwriter.WriteElementString("bcity", eord(10))
Line 4316: xmlwriter.WriteElementString("bstate", eord(11))
Line 4317: xmlwriter.WriteElementString("bzip", eord(12))
Line 4318: xmlwriter.WriteElementString("bcountry", eord(63))
Line 4319: xmlwriter.WriteElementString("bphone", eord(20))
Line 4320:
Line 4321: If orderType = "splitorderxmls" And Session("ccinfotooexml") = True Then
Line 4322: xmlwriter.WriteElementString("vaultid", "")
Line 4323: xmlwriter.WriteElementString("maskedccno", "")
Line 4324: Else
Line 4325: xmlwriter.WriteElementString("vaultid", eord(74))
Line 4326: xmlwriter.WriteElementString("maskedccno", eord(75))
Line 4327: End If
Line 4328:
Line 4329: 'Credit card info
Line 4330: If (eord(33) > 0 And orderType <> "splitorderxmls") Or (eord(33) > 0 And orderType = "splitorderxmls" And Session("ccinfotooexml") = False) Then
Line 4331: xmlwriter.WriteElementString("cctype", eord(30))
Line 4332: xmlwriter.WriteElementString("ccmembname", eord(32))
Line 4333: xmlwriter.WriteElementString("ccnum", eord(66))
Line 4334: xmlwriter.WriteElementString("ccexpire", eord(28) & eord(29))
Line 4335: xmlwriter.WriteElementString("ccauthzano", eord(59))
Line 4336: xmlwriter.WriteElementString("ccauthrefer", eord(60))
Line 4337: xmlwriter.WriteElementString("ccsettled", eord(67))
Line 4338: xmlwriter.WriteElementString("cccsc", String.Empty)
Line 4339: End If
Line 4340:
Line 4341: xmlwriter.WriteElementString("program", eord(5))
Line 4342: xmlwriter.WriteElementString("shipamt", eord(22))
Line 4343: xmlwriter.WriteElementString("shipdesc", eord(24))
Line 4344:
Line 4345: If orderType <> "splitorderxmls" Then
Line 4346: xmlwriter.WriteElementString("taxamt", eord(23))
Line 4347: xmlwriter.WriteElementString("grdtotal", eord(33))
Line 4348: End If
Line 4349:
Line 4350: 'User defined fields
Line 4351: xmlwriter.WriteElementString("alpha1", eord(35))
Line 4352: xmlwriter.WriteElementString("alpha2", eord(36))
Line 4353: xmlwriter.WriteElementString("alpha3", eord(37))
Line 4354: xmlwriter.WriteElementString("num1", eord(38))
Line 4355: xmlwriter.WriteElementString("num2", eord(39))
Line 4356: xmlwriter.WriteElementString("num3", eord(40))
Line 4357: xmlwriter.WriteElementString("date1", eord(68))
Line 4358: xmlwriter.WriteElementString("date2", eord(69))
Line 4359: xmlwriter.WriteElementString("date3", eord(70))
Line 4360:
Line 4361: 'Shipto info
Line 4362: xmlwriter.WriteStartElement("shiptos")
Line 4363:
Line 4364: xmlwriter.WriteStartElement("shipto")
Line 4365:
Line 4366: xmlwriter.WriteElementString("rectype", "S")
Line 4367: xmlwriter.WriteElementString("ordno", ordno)
Line 4368: xmlwriter.WriteElementString("webtrack", eord(1))
Line 4369: xmlwriter.WriteElementString("seqno", "1")
Line 4370: xmlwriter.WriteElementString("shipdate", eord(42))
Line 4371:
Line 4372: 'Ship to address info
Line 4373: xmlwriter.WriteElementString("scompany", eord(13))
Line 4374: xmlwriter.WriteElementString("sname", eord(14))
Line 4375: xmlwriter.WriteElementString("saddr1", eord(15))
Line 4376: xmlwriter.WriteElementString("saddr2", eord(16))
Line 4377: xmlwriter.WriteElementString("scity", eord(17))
Line 4378: xmlwriter.WriteElementString("sstate", eord(18))
Line 4379: xmlwriter.WriteElementString("szip", eord(19))
Line 4380: xmlwriter.WriteElementString("scountry", eord(64))
Line 4381: Dim sPhone As String
Line 4382: If getxmlval("sphonepm") = "Y" And Session("sphone") <> String.Empty Then
Line 4383: sPhone = Session("sphone")
Line 4384: ElseIf getxmlval("sphonepm") = "Y" And Session("s_phone") <> String.Empty Then
Line 4385: sPhone = Session("s_phone")
Line 4386: Else
Line 4387: sPhone = eord(20)
Line 4388: End If
Line 4389: xmlwriter.WriteElementString("sphone", sPhone)
Line 4390: xmlwriter.WriteElementString("shipcode", Session("shipviacode"))
Line 4391: xmlwriter.WriteElementString("shipdesc", eord(24))
Line 4392: xmlwriter.WriteElementString("comres", eord(71))
Line 4393: xmlwriter.WriteElementString("shipamt", eord(22))
Line 4394: xmlwriter.WriteElementString("taxcode1", eord(56))
Line 4395: xmlwriter.WriteElementString("taxcode2", eord(57))
Line 4396: xmlwriter.WriteElementString("shiptocode", eord(72))
Line 4397:
Line 4398: xmlwriter.WriteEndElement()
Line 4399:
Line 4400: xmlwriter.WriteEndElement()
Line 4401:
Line 4402: 'Item info
Line 4403: Dim aIcount, icount, subno, itemno
Line 4404:
Line 4405: aIcount = UBound(elines)
Line 4406:
Line 4407: If aIcount > 0 Then
Line 4408: xmlwriter.WriteStartElement("items")
Line 4409:
Line 4410: For icount = 1 To aIcount - 1
Line 4411: processLine = True
Line 4412: isGiftCertLineItem = False
Line 4413:
Line 4414: If orderType = "splitorderxmls" Then
Line 4415: splitOrderLineItemType = Trim(elines(icount, 30))
Line 4416:
Line 4417: If elines(icount, 3) = cGiftCertMC Then
Line 4418: isGiftCertLineItem = True
Line 4419: ElseIf splitOrderLineItemType <> splitOrderFFLineItemCode Then
Line 4420: processLine = False
Line 4421: End If
Line 4422: End If
Line 4423:
Line 4424: If processLine Then
Line 4425: subno = elines(icount, 4)
Line 4426:
Line 4427: xmlwriter.WriteStartElement("item")
Line 4428:
Line 4429: xmlwriter.WriteElementString("rectype", "I")
Line 4430: xmlwriter.WriteElementString("ordno", ordno)
Line 4431: xmlwriter.WriteElementString("webtrack", eord(1))
Line 4432: xmlwriter.WriteElementString("seqno", "1")
Line 4433: xmlwriter.WriteElementString("itemno", elines(icount, 3))
Line 4434: xmlwriter.WriteElementString("subno", elines(icount, 4))
Line 4435: xmlwriter.WriteElementString("itemcustno", elines(icount, 5))
Line 4436: xmlwriter.WriteElementString("qtyord", elines(icount, 9))
Line 4437: xmlwriter.WriteElementString("taxable", elines(icount, 25))
Line 4438:
Line 4439: If isGiftCertLineItem Then
Line 4440: xmlwriter.WriteElementString("itemprice", Session("splitorderffgcamt"))
Line 4441: Else
Line 4442: xmlwriter.WriteElementString("itemprice", elines(icount, 10))
Line 4443: End If
Line 4444:
Line 4445: xmlwriter.WriteElementString("pointqty", elines(icount, 15))
Line 4446: xmlwriter.WriteElementString("personalization", elines(icount, 13))
Line 4447:
Line 4448: xmlwriter.WriteEndElement()
Line 4449: End If
Line 4450:
Line 4451: Next
Line 4452:
Line 4453: xmlwriter.WriteEndElement()
Line 4454:
Line 4455: End If
Line 4456:
Line 4457: 'Order special instructions info
Line 4458: xmlwriter.WriteStartElement("instructions")
Line 4459:
Line 4460: xmlwriter.WriteElementString("rectype", "C")
Line 4461: xmlwriter.WriteElementString("ordno", ordno)
Line 4462: xmlwriter.WriteElementString("webtrack", eord(1))
Line 4463: xmlwriter.WriteElementString("impinst", eord(43))
Line 4464: xmlwriter.WriteElementString("spclinst", eord(73))
Line 4465:
Line 4466: xmlwriter.WriteEndElement()
Line 4467:
Line 4468: Dim shipto As String = String.Empty
Line 4469: If eord(72) <> Nothing Then
Line 4470: shipto = eord(72)
Line 4471: End If
Line 4472:
Line 4473: taxlines = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getordertaxinfo", orderid, shipto)
Line 4474:
Line 4475: tcount = UBound(taxlines)
Line 4476:
Line 4477: xmlwriter.WriteStartElement("taxes")
Line 4478:
Line 4479: For icount = 1 To tcount
Line 4480: xmlwriter.WriteStartElement("tax")
Line 4481: xmlwriter.WriteElementString("rectype", "T")
Line 4482: xmlwriter.WriteElementString("ordno", ordno)
Line 4483: xmlwriter.WriteElementString("seqno", "1")
Line 4484: xmlwriter.WriteElementString("webtrack", eord(1))
Line 4485: xmlwriter.WriteElementString("taxcode", taxlines(icount, 1))
Line 4486: xmlwriter.WriteElementString("taxrate", taxlines(icount, 2))
Line 4487: xmlwriter.WriteEndElement()
Line 4488: Next
Line 4489:
Line 4490: xmlwriter.WriteEndElement()
Line 4491:
Line 4492: Else ' EOF system = "FF"
Line 4493:
Line 4494: 'BOF REGULAR ORDERS
Line 4495: Dim vaultid As String = eord(74)
Line 4496: Dim loginid As String = eord(4)
Line 4497: Dim MaskedccNumber As String = eord(75)
Line 4498:
Line 4499: xmlwriter.WriteElementString("custno", eord(34))
Line 4500:
Line 4501: If orderType = "splitorderxmls" And getxmlval("splitorderexcludeprogram") = "Y" Then
Line 4502: ' do not pass
Line 4503: Else
Line 4504: xmlwriter.WriteElementString("ordtype", checkProgram())
Line 4505: End If
Line 4506:
Line 4507: xmlwriter.WriteElementString("webtrack", webtrack)
Line 4508: xmlwriter.WriteElementString("loginid", loginid)
Line 4509:
Line 4510: 'Bill to info
Line 4511: xmlwriter.WriteElementString("company", eord(6))
Line 4512: xmlwriter.WriteElementString("attn", eord(7))
Line 4513: xmlwriter.WriteElementString("addr1", eord(8))
Line 4514: xmlwriter.WriteElementString("addr2", eord(9))
Line 4515: xmlwriter.WriteElementString("city", eord(10))
Line 4516: xmlwriter.WriteElementString("state", eord(11))
Line 4517: xmlwriter.WriteElementString("zip", eord(12))
Line 4518: xmlwriter.WriteElementString("country", eord(63))
Line 4519: xmlwriter.WriteElementString("phone", eord(20))
Line 4520:
Line 4521: If orderType = "splitorderxmls" And Session("HaveSplitOrderFFLineItems") = "Y" And Session("ccinfotooexml") = False Then
Line 4522: 'if Split Order has FF Line Items, then the CC info will be tied to the FF Order and not the REG order
Line 4523: xmlwriter.WriteElementString("vaultid", "")
Line 4524: xmlwriter.WriteElementString("maskedccno", "")
Line 4525: xmlwriter.WriteElementString("ccsettled", "")
Line 4526: Else
Line 4527: xmlwriter.WriteElementString("vaultid", vaultid)
Line 4528: xmlwriter.WriteElementString("maskedccno", MaskedccNumber)
Line 4529: xmlwriter.WriteElementString("ccsettled", eord(67))
Line 4530: End If
Line 4531:
Line 4532: 'Ship to info
Line 4533: xmlwriter.WriteElementString("sls_company", eord(13))
Line 4534: xmlwriter.WriteElementString("sls_name", eord(14))
Line 4535: xmlwriter.WriteElementString("sls_addr1", eord(15))
Line 4536: xmlwriter.WriteElementString("sls_addr2", eord(16))
Line 4537: xmlwriter.WriteElementString("sls_city", eord(17))
Line 4538: xmlwriter.WriteElementString("sls_state", eord(18))
Line 4539: xmlwriter.WriteElementString("sls_zip", eord(19))
Line 4540: xmlwriter.WriteElementString("sls_country", eord(64))
Line 4541: xmlwriter.WriteElementString("sls_url", eord(41))
Line 4542: xmlwriter.WriteElementString("sls_shipto_code", eord(72))
Line 4543:
Line 4544: 'Order date
Line 4545: xmlwriter.WriteStartElement("dategroup")
Line 4546: xmlwriter.WriteElementString("month", Mid(eord(2), 1, 2))
Line 4547: xmlwriter.WriteElementString("day", Mid(eord(2), 4, 2))
Line 4548: xmlwriter.WriteElementString("year", Mid(eord(2), 7, 2))
Line 4549: xmlwriter.WriteEndElement()
Line 4550:
Line 4551: 'Ship date
Line 4552: xmlwriter.WriteStartElement("expiregroup")
Line 4553: xmlwriter.WriteElementString("month", Mid(eord(42), 1, 2))
Line 4554: xmlwriter.WriteElementString("day", Mid(eord(42), 4, 2))
Line 4555: xmlwriter.WriteElementString("year", Mid(eord(42), 7, 2))
Line 4556: xmlwriter.WriteEndElement()
Line 4557:
Line 4558: 'Shipping/Handling instructions
Line 4559: xmlwriter.WriteElementString("custshipno", Trim(eord(53)) & " " & Trim(eord(54)))
Line 4560:
Line 4561: 'In-Hand date
Line 4562: xmlwriter.WriteStartElement("ecinhand")
Line 4563: xmlwriter.WriteElementString("month", Mid(eord(52), 1, 2))
Line 4564: xmlwriter.WriteElementString("day", Mid(eord(52), 4, 2))
Line 4565: xmlwriter.WriteElementString("year", Mid(eord(52), 7, 2))
Line 4566: xmlwriter.WriteEndElement()
Line 4567:
Line 4568: Dim aIcount, icount, subno, itemno
Line 4569: aIcount = UBound(elines)
Line 4570:
Line 4571: If aIcount > 0 Then
Line 4572:
Line 4573: Dim multloc As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dotdot), "CheckSpecial", "0104")
Line 4574: 'Item info
Line 4575: xmlwriter.WriteStartElement("items")
Line 4576:
Line 4577: For icount = 1 To aIcount - 1
Line 4578: Dim isMatrix As Boolean = False
Line 4579: processLine = True
Line 4580: isGiftCertLineItem = False
Line 4581:
Line 4582: If orderType = "splitorderxmls" Then
Line 4583: splitOrderLineItemType = Trim(elines(icount, 30))
Line 4584:
Line 4585: If elines(icount, 3) = cGiftCertMC And CDbl(Session("splitorderoegcamt")) > 0 Then
Line 4586: isGiftCertLineItem = True
Line 4587: ElseIf splitOrderLineItemType <> splitOrderOELineItemCode Then
Line 4588: processLine = False
Line 4589: End If
Line 4590: End If
Line 4591:
Line 4592: If processLine Then
Line 4593:
Line 4594: If Trim(elines(icount, 24)) <> "" Then
Line 4595: isMatrix = True
Line 4596: End If
Line 4597:
Line 4598: subno = elines(icount, 4)
Line 4599:
Line 4600: xmlwriter.WriteStartElement("item")
Line 4601: xmlwriter.WriteElementString("lineno", CStr(icount))
Line 4602: If multloc = "off" And isMatrix Then
Line 4603: xmlwriter.WriteElementString("itemno", elines(icount, 3).padright(10))
Line 4604: Else
Line 4605: xmlwriter.WriteElementString("itemno", elines(icount, 3).padright(10) & subno)
Line 4606: End If
Line 4607:
Line 4608: xmlwriter.WriteElementString("itemcustno", elines(icount, 5))
Line 4609: xmlwriter.WriteElementString("desc", elines(icount, 6))
Line 4610: If elines(icount, 7) <> String.Empty Then
Line 4611: xmlwriter.WriteElementString("twodesc", elines(icount, 7))
Line 4612: End If
Line 4613: xmlwriter.WriteElementString("litotitems", elines(icount, 9))
Line 4614:
Line 4615: If isGiftCertLineItem Then
Line 4616: Dim splitorderoegcamtValue As Double = Double.Parse(Session("splitorderoegcamt"), NumberStyles.Any)
Line 4617: xmlwriter.WriteElementString("item_price", splitorderoegcamtValue)
Line 4618: Else
Line 4619: xmlwriter.WriteElementString("item_price", elines(icount, 10))
Line 4620: End If
Line 4621:
Line 4622: If multloc = "off" And isMatrix Then
Line 4623: xmlwriter.WriteElementString("li_color", Mid(subno, 3, 3))
Line 4624: xmlwriter.WriteStartElement("XS")
Line 4625: xmlwriter.WriteStartAttribute("", "sizecode", "")
Line 4626: xmlwriter.WriteString(Mid(subno, 1, 2))
Line 4627: xmlwriter.WriteEndAttribute()
Line 4628: xmlwriter.WriteString(elines(icount, 9))
Line 4629: xmlwriter.WriteEndElement()
Line 4630: Else
Line 4631: xmlwriter.WriteElementString("li_color", "")
Line 4632: xmlwriter.WriteElementString("XS", "")
Line 4633: End If
Line 4634:
Line 4635: xmlwriter.WriteElementString("personalization", elines(icount, 13))
Line 4636: xmlwriter.WriteElementString("taxable", elines(icount, 25))
Line 4637: xmlwriter.WriteEndElement()
Line 4638: End If
Line 4639: Next
Line 4640:
Line 4641: xmlwriter.WriteEndElement()
Line 4642:
Line 4643: End If
Line 4644:
Line 4645: 'Customer PO#
Line 4646: xmlwriter.WriteElementString("pono", eord(27))
Line 4647:
Line 4648: 'Credit card info
Line 4649: If orderType = "splitorderxmls" And Session("HaveSplitOrderFFLineItems") = "Y" And Session("ccinfotooexml") = False Then
Line 4650: 'if Split Order has FF Line Items, then the CC info will be tied to the FF Order and not the REG order
Line 4651: xmlwriter.WriteElementString("eccctype", "")
Line 4652: xmlwriter.WriteElementString("ecccname", "")
Line 4653: xmlwriter.WriteElementString("ecccnum", "")
Line 4654: xmlwriter.WriteElementString("ecccexpire", " / ")
Line 4655: xmlwriter.WriteElementString("ecccauthzano", "")
Line 4656: xmlwriter.WriteElementString("ecccauthrefer", "")
Line 4657:
Line 4658: If eord(33) > 0 And Session("paymentmethod") = "creditcard" Then
Line 4659: addUrgentCreditCardNote = True
Line 4660: End If
Line 4661:
Line 4662: ElseIf eord(33) > 0 Then
Line 4663: 'Credit card info
Line 4664: xmlwriter.WriteElementString("eccctype", eord(30))
Line 4665:
Line 4666: If getxmlval("onlineprocessing") = "PromoPayment" And Session("ccNickNameForDisplayOnly") <> String.Empty Then
Line 4667: xmlwriter.WriteElementString("ecccname", Session("ccNickNameForDisplayOnly"))
Line 4668: ElseIf getxmlval("onlineprocessing") = "PromoPayment" Then
Line 4669: Dim GetVaultDetails As Object = dbservermanager.ecomcall_single(Me.ToString(), r1.Server.MapPath(dotdot), "UpdateVaultDetail", "view", vaultid, loginid, MaskedccNumber)
Line 4670: If GetVaultDetails.rank = 1 And GetVaultDetails.length > 5 Then
Line 4671: xmlwriter.WriteElementString("ecccname", GetVaultDetails(5))
Line 4672: Else
Line 4673: xmlwriter.WriteElementString("ecccname", eord(32))
Line 4674: End If
Line 4675:
Line 4676: Else
Line 4677: xmlwriter.WriteElementString("ecccname", eord(32))
Line 4678: End If
Line 4679:
Line 4680: Dim ccnum As String = eord(31)
Line 4681: If eord(61) = "Y" Then
Line 4682: ccnum = eord(66)
Line 4683: End If
Line 4684:
Line 4685: xmlwriter.WriteElementString("ecccnum", ccnum)
Line 4686: xmlwriter.WriteElementString("ecccexpire", eord(28) & "/" & eord(29))
Line 4687: xmlwriter.WriteElementString("ecccauthzano", eord(59))
Line 4688: xmlwriter.WriteElementString("ecccauthrefer", eord(60))
Line 4689: End If
Line 4690:
Line 4691: 'Tax info
Line 4692: If eord(61) = "N" Then
Line 4693: 'Previous to version 8.20.00
Line 4694: xmlwriter.WriteElementString("taxcd", eord(56))
Line 4695: xmlwriter.WriteElementString("taxoth", eord(57))
Line 4696: Else
Line 4697:
Line 4698: 'Version 8.20.00 or higher
Line 4699: Dim shipto As String = String.Empty
Line 4700: If eord(72) <> Nothing Then
Line 4701: shipto = eord(72)
Line 4702: End If
Line 4703:
Line 4704: taxlines = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getordertaxinfo", orderid, shipto)
Line 4705:
Line 4706: tcount = UBound(taxlines)
Line 4707:
Line 4708: xmlwriter.WriteStartElement("taxes")
Line 4709:
Line 4710: For icount = 1 To tcount
Line 4711: xmlwriter.WriteStartElement("tax")
Line 4712: xmlwriter.WriteElementString("taxcode", taxlines(icount, 1))
Line 4713: xmlwriter.WriteElementString("taxrate", taxlines(icount, 2))
Line 4714: xmlwriter.WriteEndElement()
Line 4715: Next
Line 4716:
Line 4717: xmlwriter.WriteEndElement()
Line 4718:
Line 4719: End If
Line 4720:
Line 4721: 'Shipping info
Line 4722: xmlwriter.WriteElementString("ship_method", eord(24))
Line 4723:
Line 4724: If orderType = "splitorderxmls" Then
Line 4725: xmlwriter.WriteElementString("ship_amt", "")
Line 4726: Else
Line 4727: xmlwriter.WriteElementString("ship_amt", eord(22))
Line 4728: End If
Line 4729:
Line 4730: 'Order notes
Line 4731: If addUrgentCreditCardNote Then
Line 4732: xmlwriter.WriteElementString("ordernotes", "Urgent - Credit Card order!" & vbCrLf & vbCrLf & eord(43))
Line 4733: Else
Line 4734: xmlwriter.WriteElementString("ordernotes", eord(43))
Line 4735: End If
Line 4736:
Line 4737: End If ' system = "FF" (else)
Line 4738: End If ' softwareproducttype = "ASISB" (else)
Line 4739:
Line 4740: xmlwriter.WriteEndElement()
Line 4741: xmlwriter.WriteEndDocument()
Line 4742:
Line 4743: xmlwriter.Flush()
Line 4744: xmlwriter.Close()
Line 4745:
Line 4746: If softwareProductType = "ProfitMaker" And system = "FF" Then
Line 4747: My.Computer.FileSystem.MoveFile(xmlpath & xmlfilename, xmlpathOriginal & xmlfilename)
Line 4748: End If
Line 4749:
Line 4750: If softwareProductType = "ASISB" Then
Line 4751: 'SMARTBOOKS
Line 4752: Dim asisbstr As String = stringwriter1.ToString()
Line 4753: If f1.getASISBXMLOrderImportIPAddress() <> "" Then
Line 4754: Dim sreturnvalue As String = ecomwrapperExportXMLOrder(f1.getASISBXMLOrderImportIPAddress(), f1.getASISBXMLOrderImportIPPort(), asisbstr)
Line 4755:
Line 4756: ' NOTE - remove for production (this writes the XML where it would have without the POST to the service
Line 4757:
Line 4758: asisbstr = asisbstr.Replace(" encoding=""utf-16""", "")
Line 4759:
Line 4760: Dim streamfile As StreamWriter = New StreamWriter(xmlpath & xmlfilename, True)
Line 4761: streamfile.Write(asisbstr)
Line 4762: streamfile.Flush()
Line 4763: streamfile.Close()
Line 4764: End If
Line 4765: End If
Line 4766:
Line 4767: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dotdot), "ClearCreditCardInfo", orderid)
Line 4768:
Line 4769: 'Since we don't call TransferOrder, we need to call UpdateEorderField.
Line 4770: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dotdot), "UpdateEorderField", orderid, "IsComplete", "True")
Line 4771:
Line 4772: dbservermanager = Nothing
Line 4773:
Line 4774: Catch err As Exception
Line 4775:
Line 4776: formerror("XML Order could not be created. Please contact website administrator with following details:<br /><br />" & err.ToString)
Line 4777:
Line 4778: r1.Response.End()
Line 4779:
Line 4780: End Try
Line 4781:
Line 4782: End Sub
Line 4783:
Line 4784: Function checkProgram() As String
Line 4785:
Line 4786: Dim proglen As String
Line 4787:
Line 4788: If getxmlval("itempricebyprog") = "Y" And Session("progno") <> "" Then
Line 4789:
Line 4790: proglen = InStr(Session("progno"), ",")
Line 4791:
Line 4792: If proglen > 0 Then
Line 4793: Return Left(Session("progno"), proglen - 1)
Line 4794: Else
Line 4795: Return Session("progno")
Line 4796: End If
Line 4797:
Line 4798: Else
Line 4799:
Line 4800: Return getxmlval("sprogram")
Line 4801:
Line 4802: End If
Line 4803:
Line 4804: End Function
Line 4805: Function getdescription(ByVal desc As String, ByVal desc2 As String) As String
Line 4806:
Line 4807: If getxmlval("descripreplace") = "Y" Then
Line 4808: desc = desc.Replace("?", "<li>")
Line 4809: desc2 = desc2.Replace("?", "<li>")
Line 4810: End If
Line 4811:
Line 4812: If Trim(desc2) <> "" Then
Line 4813: desc &= "<br />" & desc2
Line 4814: End If
Line 4815:
Line 4816: Return desc
Line 4817: End Function
Line 4818: Function ReplaceTokens(ByVal myVal As String) As String
Line 4819:
Line 4820: If Session("ordno") <> String.Empty Then
Line 4821: myVal = ReplaceSingleToken(myVal, "[orderno]", Session("ordno"))
Line 4822: End If
Line 4823: If getxmlval("viewitemcloseoutconfirmmsg") <> String.Empty Or getxmlval("showcartcloseoutconfirmmsg") <> String.Empty Then
Line 4824: myVal = ReplaceSingleToken(myVal, "[onhand]", """+onhand+""")
Line 4825: myVal = ReplaceSingleToken(myVal, "[itemno]", """+itemno+""")
Line 4826: myVal = ReplaceSingleToken(myVal, "[subno]", """+subnodescription+""")
Line 4827: myVal = ReplaceSingleToken(myVal, "[newqty]", """+newqty+""")
Line 4828: myVal = ReplaceSingleToken(myVal, "[grandtotal]", """+grandtotal+""")
Line 4829: myVal = ReplaceSingleToken(myVal, "[addtotal]", """+addtotal+""")
Line 4830: myVal = ReplaceSingleToken(myVal, "[incarttotal]", """+incarttotal+""")
Line 4831: End If
Line 4832:
Line 4833: Return myVal
Line 4834: End Function
Line 4835:
Line 4836: Function ReplaceSingleToken(ByVal origtext As String, ByVal token As String, ByVal ReplacementText As String) As String
Line 4837: If InStr(origtext, token) > 0 Then
Line 4838: origtext = origtext.Replace(token, ReplacementText)
Line 4839: End If
Line 4840: Return origtext
Line 4841: End Function
Line 4842:
Line 4843: Function ReplacePointsWelcomeMessageTokens(ByVal welcomeMessage As String) As String
Line 4844: welcomeMessage = ReplaceSingleToken(welcomeMessage, "[ContactName]", Session("b_name"))
Line 4845: welcomeMessage = ReplaceSingleToken(welcomeMessage, "[PointsValue]", GetPointsValue())
Line 4846: welcomeMessage = ReplaceSingleToken(welcomeMessage, "[PointsLabel]", getxmlval("pointlabel"))
Line 4847:
Line 4848: Return welcomeMessage
Line 4849: End Function
Line 4850:
Line 4851: Function ReplaceTokensTextForSpecialInstruction(ByVal textForSpecialInstruction As String) As String
Line 4852: Dim thisPhone As String = ""
Line 4853:
Line 4854: If getxmlval("sphonepm") = "Y" And Session("sphone") <> String.Empty Then ' Shipping Phone Number Imports into ProfitMaker:
Line 4855: thisPhone = Session("sphone") 'Shipping phone number as changed
Line 4856: ElseIf getxmlval("sphonepm") = "Y" And Session("s_phone") <> String.Empty Then
Line 4857: thisPhone = Session("s_phone") 'Shipping phone number as orig displayed
Line 4858: ElseIf Session("bphone") <> String.Empty Then
Line 4859: thisPhone = Session("bphone") 'Billing phone number as changed
Line 4860: ElseIf Session("b_phone") <> String.Empty Then
Line 4861: thisPhone = Session("b_phone") 'Billing phone number as orig displayed
Line 4862: Else
Line 4863: thisPhone = "UNKNOWN"
Line 4864: End If
Line 4865:
Line 4866: textForSpecialInstruction = ReplaceSingleToken(textForSpecialInstruction, "[PHONENUMBER]", thisPhone)
Line 4867:
Line 4868: Return textForSpecialInstruction
Line 4869: End Function
Line 4870:
Line 4871: Function GetPointsValue() As String
Line 4872: Dim pointsvalue As String = Session("availpoints")
Line 4873:
Line 4874: If pointsvalue <= 0 Then
Line 4875: pointsvalue = 0
Line 4876: End If
Line 4877:
Line 4878: If getxmlval("pointson") = "points" Or getxmlval("pointson") = "pointsallowpaydiff" Then
Line 4879: If pointsvalue > 0 Then
Line 4880: pointsvalue = String.Format("{0:#,###}", CInt(pointsvalue))
Line 4881: End If
Line 4882: Else
Line 4883: pointsvalue = reformatcurrency(FormatCurrency(pointsvalue, getxmlval("currencyformat"))) & " of "
Line 4884: End If
Line 4885:
Line 4886: Return pointsvalue
Line 4887: End Function
Line 4888:
Line 4889: Sub DiscountHasUsesLeft()
Line 4890: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 4891:
Line 4892: If Session("DealerDiscountOn") = "Admin" AndAlso Not Session("discountgood") Is Nothing And Session("discountremaininguses") <> "1000000000" Then
Line 4893: Dim DiscountRemainingUses As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateDiscountRemainingUses", Session("siteid"), Session("bdiscount"), Session("orderid"))
Line 4894: If DiscountRemainingUses = "ERROR Discount Code does not have any remaining uses" Then
Line 4895: Session("discountjustusedup") = "T"
Line 4896: Session("errors") += 1
Line 4897:
Line 4898: r1.Response.Redirect("default.aspx?p=checkout1")
Line 4899: End If
Line 4900: End If
Line 4901: dbservermanager = Nothing
Line 4902:
Line 4903: End Sub
Line 4904:
Line 4905: Sub processit()
Line 4906: Dim orderid As String = Session("orderid")
Line 4907: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 4908: 'DiscountHasUsesLeft()
Line 4909:
Line 4910: ' PROCESS ORDER
Line 4911: Session("orderIsProcessing") = True
Line 4912:
Line 4913: If Session("CCProcessed") Or Session("ccUpdated") Or Session("OrderTransferred") Or Session("GCProcessed") Or Session("GCEmailsSent") Or Session("GivexRedeemed") Or Session("SVProcessed") Or Session("XMLProcessed") Then
Line 4914: r1.Response.Redirect("default.aspx?p=verifyorder")
Line 4915: End If
Line 4916:
Line 4917:
Line 4918: If (Session("paymentmethod") = "creditcard" And Session("passgrandtotal") > 0) And getxmlval("onlineprocessing") <> String.Empty And getxmlval("onlineprocessing") <> "paypalwps" And getxmlval("onlineprocessing") <> "PromoPayment" And getxmlval("onlineprocessing") <> "authorizenetpunchout" And getxmlval("pcicson") <> "Y" And Session("NPCSecureUsed") <> True Then
Line 4919: wt(True, "going to ProcessCard")
Line 4920: ProcessCard(orderid)
Line 4921: wt(True, "coming from ProcessCard")
Line 4922: 'ProcessCard sets the value of session("ccprocessed") to true if card goes through
Line 4923: ElseIf ((getxmlval("onlineprocessing") = "paypalwps" Or getxmlval("onlineprocessing") = "PromoPayment") And Session("txn_id") <> String.Empty) Or Session("NPCSecureUsed") = True Then
Line 4924: 'If getxmlval("paypaltrxtype") = "A" Or Session("PayPalWPSSaleValid") = True Then
Line 4925:
Line 4926: If Session("PayPalWPSValid") = True Or Session("NPCSecureUsed") = True Then
Line 4927: Session("refnumber") = Session("txn_id")
Line 4928: Session("goyo") = True
Line 4929: ElseIf Session("PromoPaymentValid") = True Then
Line 4930:
Line 4931: Session("refnumber") = Session("txn_id")
Line 4932: 'Session("authcode") = Session("txn_id")
Line 4933: Dim pp As New PromoPayment
Line 4934:
Line 4935: Dim ppResult As Boolean = True
Line 4936: 'TEMPORARILY NOT CHECKING TO SEE IF WE ARE USING A VAULTED CARD
Line 4937: 'If Not Session("UsingVaultedCard") Then
Line 4938: ppResult = pp.PromoPaymentStepThree("https://secure.nmi.com/api/v2/three-step")
Line 4939: Dim arURLs As Array = Split(r1.Session("urls"), ",")
Line 4940: Session("erase100") &= ".3047 in functions(step 3)."
Line 4941: 'End If
Line 4942:
Line 4943: If ppResult Then
Line 4944: Session("goyo") = True
Line 4945: Else
Line 4946: r1.Response.Redirect("paymentnotify.aspx")
Line 4947: End If
Line 4948:
Line 4949: End If
Line 4950:
Line 4951: ElseIf getxmlval("pcicson") = "Y" And Session("paymentmethod") = "creditcard" Then
Line 4952: If r1.Request("action") = "success" Then
Line 4953: 'UPDATE THE LAST ORDER NUMBER
Line 4954: Session("authcode") = String.Empty
Line 4955:
Line 4956: 'I think we won't need to call UpdateLastOrderNo if we are here, we'll just set the refnumber to the value bcauthzano, and let it call updatecreditcardinfo below
Line 4957: Dim bcauthzano As String = "BC-"
Line 4958:
Line 4959: Dim d As String = CStr(Day(Now())).PadLeft(2, "0")
Line 4960: Dim m As String = CStr(Month(Now())).PadLeft(2, "0")
Line 4961: Dim thedate As String = m & d & Right(Year(Now()), 2)
Line 4962: bcauthzano += thedate
Line 4963: Session("refnumber") = bcauthzano
Line 4964: Session("goyo") = True
Line 4965: Session("CCProcessed") = True
Line 4966: Else
Line 4967: r1.Response.Redirect("default.aspx?p=showcart&action=error")
Line 4968: End If
Line 4969: Else
Line 4970: Session("goyo") = True
Line 4971: End If
Line 4972:
Line 4973: If Session("goyo") Then
Line 4974:
Line 4975: If Not (getxmlval("onlineprocessing") = "authorizenetpunchout" And (Session("paymentmethod") = "creditcardonetime" Or Session("paymentmethod") = "creditcardvault")) Then
Line 4976: wt(True, "UpdateCreditCardInfo")
Line 4977: 'Add the vaultid and masked card number
Line 4978:
Line 4979: Dim CustomerVaultID As String = String.Empty
Line 4980: Dim MaskedCCNumber As String = String.Empty
Line 4981: If getxmlval("onlineprocessing") = "PromoPayment" Then
Line 4982: Session("erase3084") = CustomerVaultID
Line 4983: 'If Session("UsingVaultedCard") = True And Session("custVaultID") <> String.Empty Then
Line 4984: If Session("UsingVaultedCard") = False And Session("custVaultID") <> String.Empty Then
Line 4985: CustomerVaultID = Session("custVaultID")
Line 4986: ElseIf Session("PromoPaymentValid") = True And Session("VaultedCardId") <> String.Empty Then
Line 4987: CustomerVaultID = Session("VaultedCardId")
Line 4988: End If
Line 4989: If Session("MaskedCCNumber") <> String.Empty Then
Line 4990: MaskedCCNumber = Session("MaskedCCNumber")
Line 4991: ElseIf Session("MaskedCCFor" & CustomerVaultID) <> String.Empty Then
Line 4992: MaskedCCNumber = Session("MaskedCCFor" & CustomerVaultID)
Line 4993: End If
Line 4994: End If
Line 4995: Session("erase3097") = CustomerVaultID
Line 4996:
Line 4997: Dim updatecc As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateCreditCardInfo", orderid, Session("authcode"), Session("refnumber"), getxmlval("paypaltrxtype"), CustomerVaultID, MaskedCCNumber)
Line 4998: Session("UpdateCreditCardInfoStatus") = updatecc
Line 4999: wt(False, "UpdateCreditCardInfo")
Line 5000:
Line 5001:
Line 5002:
Line 5003: If updatecc = "success" Then
Line 5004: Session("CCUpdated") = True
Line 5005: End If
Line 5006: End If
Line 5007: Dim ordno As String = Session("getno")
Line 5008: Session("theordno") = ordno
Line 5009: wt(True, "getorderinfo")
Line 5010: Dim aItem As Object = dbservermanager.ecomcall_array(Me.ToString() + " / sub_is_processit", Server.MapPath(""), "getorderinfo", "EORDER", orderid)
Line 5011: wt(False, "getorderinfo")
Line 5012: wt(True, "ChangeThePersonalization")
Line 5013: ChangeThePersonalization(aItem(1))
Line 5014: wt(False, "ChangeThePersonalization")
Line 5015: If Session("specialdatabase") <> String.Empty AndAlso getxmlval("specialdatabase") <> String.Empty Then
Line 5016: Dim specdb As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateOrderType", ordno, Session("specialdatabase"))
Line 5017: If specdb <> "success" Then
Line 5018: Session("specialdatabaseerror") = "Aecfford.dbf was not updated. Please ensure it is located in the ProfitMaker Data Directory."
Line 5019: End If
Line 5020: End If
Line 5021:
Line 5022: If getxmlval("gcspecialon") = "Y" Then
Line 5023: DeductGiftCerts(orderid)
Line 5024: Session("GCProcessed") = True
Line 5025: End If
Line 5026:
Line 5027: If getxmlval("includetextforspecialinstruction") = "Y" Then
Line 5028: Dim newPersonalization As String = GetTextForSpecialInstruction(aItem(73)) 'get current Personaliz field
Line 5029: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateEorderField", orderid, "Personaliz", newPersonalization) 'update back to Personaliz field
Line 5030: End If
Line 5031:
Line 5032: 'MOVED FROM PROCESSORDER, LINE 314
Line 5033: Dim findgt As Object = getcarttotals()
Line 5034: Dim belowsvminlev As Boolean = False
Line 5035: Dim svminlev As String = getxmlval("svminlev")
Line 5036:
Line 5037: If getxmlval("svspecialon") = "Y" And svminlev <> String.Empty AndAlso IsNumeric(svminlev) AndAlso findgt(0) < svminlev Then
Line 5038: belowsvminlev = True
Line 5039: End If
Line 5040: If getxmlval("gcspecialon") = "Y" AndAlso (getxmlval("svspecialon") <> "Y" Or belowsvminlev) Then
Line 5041: wt(True, "sendgcemails")
Line 5042: SendGCEmails(orderid, False)
Line 5043: wt(False, "sendgcemails")
Line 5044: Session("GCEmailsSent") = True
Line 5045: End If
Line 5046:
Line 5047: If getxmlval("downloadablesfolder") <> String.Empty And getxmlval("downloadableitemnumberprefix") <> String.Empty Then
Line 5048:
Line 5049: SendDownloadablesEmails(orderid, Session("email"))
Line 5050: Session("DownloadablesEmailsSent") = True
Line 5051: End If
Line 5052:
Line 5053: If getxmlval("givexspecon") = "Y" AndAlso Session("givexverify") = True Then
Line 5054: wt(True, "RedeemGivex")
Line 5055: RedeemGivex()
Line 5056: wt(False, "RedeemGivex")
Line 5057: Session("GivexRedeemed") = True
Line 5058: End If
Line 5059:
Line 5060: Dim isTypeOfCreditCardPmt As Boolean = False
Line 5061: If Session("paymentmethod") IsNot Nothing Then
Line 5062: isTypeOfCreditCardPmt = Session("paymentmethod").StartsWith("creditcard")
Line 5063: End If
Line 5064:
Line 5065: If (getxmlval("svspecialon") = "Y") AndAlso ((isTypeOfCreditCardPmt = False) Or (getxmlval("svccbypass") <> "Y")) And belowsvminlev = False Then
Line 5066: wt(True, "processsupervisor")
Line 5067: ProcessSupervisor(orderid, ordno)
Line 5068: wt(False, "processsupervisor")
Line 5069: Session("SVProcessed") = True
Line 5070: Else
Line 5071: If getxmlval("ordertype") = "reg" Then
Line 5072: wt(True, "createxmlorder, reg")
Line 5073: createxmlorder("", "REG")
Line 5074: wt(False, "createxmlorder, reg")
Line 5075: Session("XMLProcessed") = True
Line 5076: ElseIf getxmlval("ordertype") = "ffxml" Then
Line 5077: wt(True, "createxmlorder, ffxml")
Line 5078: createxmlorder("", "FF")
Line 5079: wt(False, "createxmlorder, ffxml")
Line 5080: Session("XMLProcessed") = True
Line 5081: ElseIf getxmlval("ordertype") = "splitorderxmls" Then
Line 5082: Dim aLineItemTypes As Object = dbservermanager.ecomcall_array(Me.ToString() + " / sub_is_processit", Server.MapPath(""), "GetSplitOrderLineItemTypes", orderid, Trim(getxmlval("splitorderfflineitemcode")), Trim(getxmlval("splitorderoelineitemcode")))
Line 5083: Session("HaveSplitOrderFFLineItems") = aLineItemTypes(1)
Line 5084: Session("HaveSplitOrderOELineItems") = aLineItemTypes(2)
Line 5085:
Line 5086: If Session("HaveSplitOrderFFLineItems") = "Y" Then
Line 5087: wt(True, "createxmlorder, ffxml")
Line 5088: createxmlorder("", "FF")
Line 5089: wt(False, "createxmlorder, ffxml")
Line 5090: Session("XMLProcessed") = True
Line 5091: End If
Line 5092:
Line 5093: If Session("HaveSplitOrderOELineItems") = "Y" Then
Line 5094: wt(True, "createxmlorder, reg")
Line 5095: createxmlorder("", "REG")
Line 5096: wt(False, "createxmlorder, reg")
Line 5097: Session("XMLProcessed") = True
Line 5098: End If
Line 5099:
Line 5100: ElseIf getxmlval("ordertype") = "ariba" Then
Line 5101: 'NOTE - Ariba processing should not be calling this method but left ElseIf here just in case
Line 5102: Session("XMLProcessed") = True
Line 5103: ElseIf getxmlval("ordertype") = "aribasplitorderxmls" Then
Line 5104: 'NOTE - Ariba/Split Order" processing should not be calling this method but left ElseIf here just in case
Line 5105: Session("XMLProcessed") = True
Line 5106: ElseIf getxmlval("ordertype") = "coupa" Then
Line 5107: 'NOTE - Coupa processing should not be calling this method but left ElseIf here just in case
Line 5108: Session("XMLProcessed") = True
Line 5109: Else
Line 5110: wt(True, "Transferorder")
Line 5111: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "Transferorder", orderid, Session("shiptocode"), getxmlval("sphonepm"))
Line 5112: wt(False, "Transferorder")
Line 5113: wt(True, "ClearCreditCardInfo")
Line 5114: Dim clear546 = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "ClearCreditCardInfo", orderid)
Line 5115: wt(False, "ClearCreditCardInfo")
Line 5116: Session("OrderTransferred") = True
Line 5117: End If
Line 5118: End If
Line 5119:
Line 5120: If getxmlval("createcontact") <> "" Then
Line 5121: wt(True, "CreateContact")
Line 5122: CreateContact()
Line 5123: wt(False, "CreateContact")
Line 5124: Session("ContactCreated") = True
Line 5125: End If
Line 5126:
Line 5127: Session("refnumber") = ""
Line 5128: Session("authcode") = ""
Line 5129:
Line 5130: dbservermanager = Nothing
Line 5131:
Line 5132: Session("oktoprocess") = True
Line 5133:
Line 5134: Session("orderIsProcessing") = False
Line 5135:
Line 5136: If getxmlval("ipnon") = "Y" And (Session("paymentmethod") = "creditcard" And Session("passgrandtotal") > 0) And getxmlval("onlineprocessing") = "paypalwps" Or Session("NPCSecureUsed") = True Then
Line 5137: 'PAGE WILL NOT BE DISPLAYED, SINCE NO ONE IS VIEWING
Line 5138: ElseIf getxmlval("supplieroe") = "Y" And Session("okfrompmsubmit") <> True Then
Line 5139: r1.Response.Redirect("default.aspx?p=pmsubmit")
Line 5140: Else
Line 5141: r1.Response.Redirect("default.aspx?p=processorder")
Line 5142: End If
Line 5143:
Line 5144: End If
Line 5145: dbservermanager = Nothing
Line 5146:
Line 5147: End Sub
Line 5148:
Line 5149: Function GetTextForSpecialInstruction(currPersonalization As String) As String
Line 5150: Dim newPersonalization As String = ""
Line 5151: Dim textForSpecialInstruction As String = getxmlval("textforspecialinstruction")
Line 5152:
Line 5153: textForSpecialInstruction = ReplaceTokensTextForSpecialInstruction(textForSpecialInstruction)
Line 5154:
Line 5155: If Trim(currPersonalization) <> String.Empty Then
Line 5156: newPersonalization = currPersonalization + " ~ " + textForSpecialInstruction
Line 5157: Else
Line 5158: newPersonalization = textForSpecialInstruction
Line 5159: End If
Line 5160:
Line 5161: Return newPersonalization
Line 5162: End Function
Line 5163:
Line 5164: Sub ProcessEmails()
Line 5165:
Line 5166: If getxmlval("emailconfirm") = "Y" Then
Line 5167: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5168: Dim orderid As String = Session("orderid")
Line 5169: Dim sendto As String = Session("bemail")
Line 5170: Dim subject As String = ReplaceTokens(getxmlval("emailsubject"))
Line 5171: Dim PDFsubject As String = ReplaceTokens(getxmlval("pdfemailsubject"))
Line 5172: Dim prodPDFsubject As String = ReplaceTokens(getxmlval("prodpdfsubject"))
Line 5173:
Line 5174: 'If InStr(subject, "[orderno]") > 0 Then
Line 5175: ' subject = subject.Replace("[orderno]", Session("ordno"))
Line 5176: 'End If
Line 5177: 'If InStr(PDFsubject, "[orderno]") > 0 Then
Line 5178: ' PDFsubject = PDFsubject.Replace("[orderno]", Session("ordno"))
Line 5179: 'End If
Line 5180: 'If InStr(prodPDFsubject, "[orderno]") > 0 Then
Line 5181: ' prodPDFsubject = prodPDFsubject.Replace("[orderno]", Session("ordno"))
Line 5182: 'End If
Line 5183:
Line 5184: Dim sendfrom As String = getxmlval("emailfrom")
Line 5185: Dim sendfromname As String = getxmlval("emailfromname")
Line 5186: Dim finalpdflist As Array = getfinalpdflist()
Line 5187:
Line 5188: Dim body As String = orderinfo("email", "")
Line 5189: 'check if site uses points, send points balance in email if it does
Line 5190: If getxmlval("pointson") <> "no" Then
Line 5191: body = "<font class='amountavailable'>After this order is completed, you will have " & Session("pointsval2") & " " & getxmlval("pointlabel") & " available.</font><br /><br />" & body
Line 5192:
Line 5193: End If
Line 5194: Dim cc As String = getxmlval("emailcc")
Line 5195: Dim multishipbcc As String
Line 5196: Dim bcc As String
Line 5197:
Line 5198: Dim url As String = "http://" & r1.Request.ServerVariables("SERVER_NAME") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 5199: Dim externalurl As String = "http://" & getxmlval("externalurl") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 5200:
Line 5201: url = Left(url, InStrRev(url, "/"))
Line 5202:
Line 5203: If getxmlval("multishipto") = "Y" And getxmlval("multishipcorpemail") = "Y" Then
Line 5204: If Session("corpemail") <> "" Then
Line 5205: multishipbcc = "," & Session("corpemail")
Line 5206: End If
Line 5207:
Line 5208: bcc = getxmlval("emailbcc") & multishipbcc
Line 5209: Else
Line 5210: bcc = getxmlval("emailbcc")
Line 5211: End If
Line 5212:
Line 5213: Dim mailserver As String = getxmlval("emailserver")
Line 5214: Dim authenticate As String = getxmlval("authenticateon")
Line 5215: Dim usr As String = getxmlval("emailusr")
Line 5216: Dim pwd As String = getxmlval("emailpwd")
Line 5217: Dim superviz As String
Line 5218: Dim body_sv As String
Line 5219: Dim attachpdf As List(Of String) = New List(Of String)
Line 5220: Dim attachprod As List(Of String) = New List(Of String)
Line 5221:
Line 5222: Dim findgt = getcarttotals()
Line 5223:
Line 5224: Dim svminlev As String = getxmlval("svminlev")
Line 5225: Dim belowsvminlev As Boolean = False
Line 5226: If getxmlval("svspecialon") = "Y" And svminlev <> String.Empty AndAlso IsNumeric(svminlev) AndAlso findgt(0) < svminlev Then
Line 5227: belowsvminlev = True
Line 5228: End If
Line 5229:
Line 5230: 'dim finalpdflist as array = getfinalpdflist()
Line 5231:
Line 5232: ' Dealing with PDFs
Line 5233: If getxmlval("pdfspecialon") = "Y" And Session("nopersonalization") = "false" Then
Line 5234:
Line 5235: Dim allpdfs As Integer
Line 5236:
Line 5237: For allpdfs = LBound(finalpdflist) To UBound(finalpdflist)
Line 5238: If Session("ordno") <> String.Empty And Session("webno") <> String.Empty Then
Line 5239: Dim newfilename As String = Replace(finalpdflist(allpdfs).ToString, Session("webno"), Session("ordno"))
Line 5240:
Line 5241: Dim newprodfilename As String = "p$" & newfilename
Line 5242:
Line 5243: Try
Line 5244:
Line 5245: Rename(Session("pdfpath") & "\proofs\soft\" & finalpdflist(allpdfs).ToString, Session("pdfpath") & "\proofs\soft\" & newfilename)
Line 5246: Catch e As Exception
Line 5247:
Line 5248: If System.IO.File.Exists(Session("pdfpath") & "\proofs\soft\" & finalpdflist(allpdfs).ToString) Then
Line 5249: formerror("The file " & finalpdflist(allpdfs).ToString & " was found, but could not be renamed.")
Line 5250: End If
Line 5251:
Line 5252: End Try
Line 5253:
Line 5254: If getxmlval("productionpdf") = "Y" Then
Line 5255:
Line 5256: Try
Line 5257: Rename(Session("pdfpath") & "\proofs\production\p$" & finalpdflist(allpdfs).ToString, Session("pdfpath") & "\proofs\production\" & newprodfilename)
Line 5258:
Line 5259: Catch e As Exception
Line 5260:
Line 5261: If System.IO.File.Exists(removespaces(Session("pdfpath") & "\proofs\production\p$" & finalpdflist(allpdfs).ToString)) Then
Line 5262: formerror("The file " & finalpdflist(allpdfs).ToString & " was found, but could not be renamed.")
Line 5263: End If
Line 5264:
Line 5265: End Try
Line 5266:
Line 5267: Dim addprod = Session("pdfpath") & "\proofs\production\p$" & newfilename
Line 5268: attachprod.Add(addprod)
Line 5269: End If
Line 5270: Dim addpath = Session("pdfpath") & "\proofs\soft\" & newfilename
Line 5271: attachpdf.Add(addpath)
Line 5272:
Line 5273: End If
Line 5274:
Line 5275: Next
Line 5276: 'if the files which were originally created were not renamed, that means they were not in the cart at the end of the order. Erase them if that option is set
Line 5277:
Line 5278: If getxmlval("pdferaseincomplete") = "Y" Then
Line 5279: eraseincomplete()
Line 5280: End If
Line 5281:
Line 5282: End If
Line 5283:
Line 5284: If getxmlval("pdferaseincomplete") = "Y" And Session("createdpdfs") <> String.Empty Then
Line 5285: eraseincomplete()
Line 5286: End If
Line 5287:
Line 5288: If getxmlval("pdfspecialon") = "Y" And getxmlval("pdfemailseparate") = "Y" And Session("nopersonalization") = "false" Then
Line 5289: emailsend(sendto, PDFsubject, getxmlval("pdfemailfrom"), getxmlval("pdfemailfromname"), getxmlval("pdfemailbody"), getxmlval("pdfemailcc"), getxmlval("pdfemailbcc"), mailserver, authenticate, usr, pwd, attachpdf)
Line 5290: End If
Line 5291:
Line 5292: If getxmlval("productionpdf") = "Y" And Session("nopersonalization") = "false" Then
Line 5293: Dim prodpdfbody As String = getxmlval("prodpdfbody")
Line 5294: If getxmlval("productionpdfconfirmation") = "Y" Then
Line 5295: prodpdfbody &= "<br />" & orderinfo("email", "")
Line 5296: End If
Line 5297: emailsend(getxmlval("prodpdfto"), prodPDFsubject, getxmlval("prodpdffrom"), getxmlval("pdfemailfromname"), prodpdfbody, getxmlval("prodpdfcc"), getxmlval("prodpdfbcc"), mailserver, authenticate, usr, pwd, attachprod)
Line 5298: End If
Line 5299:
Line 5300: If getxmlval("svspecialon") = "Y" And Session("finallev") > 0 Then
Line 5301: Dim aOutp As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetDepartmentInfo", Session("dept"))
Line 5302:
Line 5303: If Session("svemail") <> String.Empty Then
Line 5304: superviz = Session("svemail")
Line 5305: ElseIf Session("svxmlsup") <> String.Empty Then
Line 5306: superviz = Session("svxmlsup")
Line 5307: Else
Line 5308: superviz = Trim(aOutp(1, 3))
Line 5309: If getxmlval("svnummessageloc") = "T" And getxmlval("svnummessagetxt") <> String.Empty And getxmlval("svxmlform") = "N" Then
Line 5310: body_sv = SvNumMessageTxt(String.Empty)
Line 5311: End If
Line 5312: body_sv &= "The order below is pending supervisor approval. Please go to the site below to process.<br /><br /><a href=""" & url & "svspec/"">" & url & "svspec/" & "</a><br /><br />" & orderinfo("appemail", "")
Line 5313: body_sv = getxmlval("svemailbegintxt") & "<br/>" & body_sv & "<br/>" & getxmlval("svemailendtxt")
Line 5314: End If
Line 5315:
Line 5316: subject = subject & " - Pending Approval"
Line 5317: body = "This order is pending supervisor approval. You will be notified when it is processed.<br /><br />" & body
Line 5318:
Line 5319: End If
Line 5320:
Line 5321: If getxmlval("svnummessageloc") = "T" And getxmlval("svnummessagetxt") <> String.Empty And getxmlval("svxmlform") = "N" Then
Line 5322: body = SvNumMessageTxt(String.Empty) & body
Line 5323: End If
Line 5324:
Line 5325: ' SEND EMAIL
Line 5326: If getxmlval("svsendemail") <> "N" Or getxmlval("svspecialon") <> "Y" Then
Line 5327: Dim cc_reg = cc
Line 5328:
Line 5329: 'Note - when sending a "second order email confirmation", do it as a cc vs. a SendTo
Line 5330: If getxmlval("secondemailsemicolon") = "Y" Then
Line 5331: cc_reg += "; " & Session("bemail2")
Line 5332: Else
Line 5333: cc_reg += ", " & Session("bemail2")
Line 5334: End If
Line 5335:
Line 5336: Dim svxmlnumbody As String
Line 5337: Dim requiresapp As String = "It is pending supervisor approval."
Line 5338:
Line 5339: If belowsvminlev = True Then
Line 5340: requiresapp = "It will not require supervisor approval."
Line 5341: End If
Line 5342:
Line 5343: If getxmlval("svnummessageloc") = "T" And getxmlval("svnummessagetxt") <> String.Empty And getxmlval("svxmlform") = "N" Then
Line 5344: svxmlnumbody = SvNumMessageTxt(String.Empty)
Line 5345: End If
Line 5346:
Line 5347: If getxmlval("svxmlspecialon") <> "Y" Or getxmlval("svxmlform") <> "N" Then
Line 5348: svxmlnumbody &= "This order was placed by " & Session("login") & " on the " & url & " site. " & requiresapp & " <br /><br />"
Line 5349: End If
Line 5350:
Line 5351: If (getxmlval("svnummessageloc") = "T") Or (getxmlval("svnummessageloc") = "B") Or (getxmlval("svnummessageloc") = "P") Then
Line 5352: svxmlnumbody += orderinfo("appemail", "")
Line 5353: Else
Line 5354: svxmlnumbody += orderinfo("email", "")
Line 5355: End If
Line 5356:
Line 5357: Dim startingemail As Integer = 2
Line 5358: If belowsvminlev = True Then
Line 5359: startingemail = 1
Line 5360: End If
Line 5361:
Line 5362: If getxmlval("pdfspecialon") = "Y" And getxmlval("pdfemailseparate") <> "Y" Then
Line 5363: emailsend(sendto, subject, sendfrom, sendfromname, body, cc_reg, bcc, mailserver, authenticate, usr, pwd, attachpdf)
Line 5364: 'SUPERVISOR NUMERIC EMAILS
Line 5365: 'For u As Integer = 1 To 3
Line 5366: For u As Integer = startingemail To 3
Line 5367: If Session("svxmlnumemail" & u) <> String.Empty Then
Line 5368: emailsend(Session("svxmlnumemail" & u), subject, sendfrom, sendfromname, svxmlnumbody, String.Empty, String.Empty, mailserver, authenticate, usr, pwd, attachpdf)
Line 5369: End If
Line 5370: Next
Line 5371: Else
Line 5372: emailsend(sendto, subject, sendfrom, sendfromname, body, cc_reg, bcc, mailserver, authenticate, usr, pwd, Nothing)
Line 5373: 'SUPERVISOR NUMERIC EMAILS
Line 5374: For u As Integer = startingemail To 3
Line 5375: If Session("svxmlnumemail" & u) <> String.Empty Then
Line 5376: emailsend(Session("svxmlnumemail" & u), subject, sendfrom, sendfromname, svxmlnumbody, String.Empty, String.Empty, mailserver, authenticate, usr, pwd, Nothing)
Line 5377: End If
Line 5378: Next
Line 5379: End If
Line 5380:
Line 5381: End If
Line 5382:
Line 5383:
Line 5384:
Line 5385: If getxmlval("svspecialon") = "Y" And Session("finallev") > 0 And (superviz <> "" Or Session("svemail") <> String.Empty) And belowsvminlev = False Then
Line 5386:
Line 5387: If Session("svemail") = String.Empty And (getxmlval("svdirectenter") = "Y" Or getxmlval("svxmlspecialon") = "Y") Then
Line 5388: Session("svemail") = superviz
Line 5389: End If
Line 5390:
Line 5391: Dim svapprovcc As String = IIf(getxmlval("svapprovcc") <> String.Empty, getxmlval("svapprovcc"), String.Empty)
Line 5392: Dim svapprovbcc As String = IIf(getxmlval("svapprovbcc") <> String.Empty, getxmlval("svapprovbcc"), String.Empty)
Line 5393:
Line 5394: If Session("svemail") <> String.Empty Then
Line 5395: Dim svEmailURL As String = r1.Request.ServerVariables("SERVER_NAME")
Line 5396: Dim externalurl2 As String = getxmlval("externalurl")
Line 5397: Dim svEmailSite As String = filterInput(r1.Request.ServerVariables("URL"), "url", "Url")
Line 5398: Dim svEmailSiteName As String()
Line 5399: svEmailSiteName = svEmailSite.Split("/")
Line 5400:
Line 5401: Dim fullUrl As String = String.Empty
Line 5402: For p As Integer = LBound(svEmailSiteName) To UBound(svEmailSiteName) - 1
Line 5403: fullUrl &= svEmailSiteName(p)
Line 5404: If p <> UBound(svEmailSiteName) - 1 Then
Line 5405: fullUrl &= "/"
Line 5406: End If
Line 5407: Next
Line 5408:
Line 5409: Dim svEmailURLFinal As String = "http://" & svEmailURL & "/" & fullUrl & "/svspec/Approval.aspx?"
Line 5410: Dim svEmailURLFinalExternal As String = String.Empty
Line 5411: If externalurl2 <> String.Empty Then
Line 5412: svEmailURLFinalExternal = "http://" & externalurl2 & "/" & svEmailSiteName(1) & "/svspec/Approval.aspx?"
Line 5413: End If
Line 5414: Dim approveLink, rejectLink As String
Line 5415: Dim approveLinkExternal, rejectLinkExternal As String
Line 5416: Dim emailresult As String = ""
Line 5417: approveLink = svEmailURLFinal & "approve=yes&orderid=" & Session("orderid") & "&email=" & superviz
Line 5418: rejectLink = svEmailURLFinal & "approve=no&orderid=" & Session("orderid") & "&email=" & superviz
Line 5419: If externalurl2 <> String.Empty Then
Line 5420: approveLinkExternal = svEmailURLFinalExternal & "approve=yes&orderid=" & Session("orderid") & "&email=" & superviz
Line 5421: rejectLinkExternal = svEmailURLFinalExternal & "approve=no&orderid=" & Session("orderid") & "&email=" & superviz
Line 5422: End If
Line 5423:
Line 5424: If getxmlval("svnummessageloc") = "T" And getxmlval("svnummessagetxt") <> String.Empty And getxmlval("svxmlform") = "N" Then
Line 5425: body_sv = SvNumMessageTxt(String.Empty)
Line 5426: End If
Line 5427:
Line 5428: body_sv &= "<b>Please approve or reject this order.</b><br /><br /><a href=" & approveLink & ">Approve</a> | <a href=" & rejectLink & ">Reject</a>"
Line 5429: 'body_sv += orderinfo(session("orderid"), "")
Line 5430:
Line 5431: If externalurl2 <> String.Empty Then
Line 5432: body_sv += "<br /><br /><b>If your approval or rejection did not work above, please click here.</b><br /><br /><a href=" & approveLinkExternal & ">Approve</a> | <a href=" & rejectLinkExternal & ">Reject</a>"
Line 5433: End If
Line 5434:
Line 5435: body_sv += orderinfo("svemail", "")
Line 5436: body_sv += "<table style='width:100%;text-align:center'><tr><td colspan='2'>Please approve or reject this order below.</td></tr><tr><td colspan='2'><a href=" & approveLink & ">"
Line 5437:
Line 5438: If getxmlval("svappemailimg") = "Y" Then
Line 5439: body_sv += "<img src=""http://" & svEmailURL & "/" & svEmailSiteName(1) & "/images/approve.gif"" border='0' style='border:solid 1px silver;' /></a><a href=" & rejectLink & "><img src=""http://" & svEmailURL & "/" & svEmailSiteName(1) & "/images/reject.gif"" border='0' style='border:solid 1px silver;' />"
Line 5440: Else
Line 5441: body_sv += "</a><a href=" & rejectLink & ">"
Line 5442: End If
Line 5443:
Line 5444: body_sv += "</a></td></tr><tr><td width='50%' style='text-align:right;'><a href=" & approveLink & ">Approve</a></td><td width='50%' style='text-align:left;border-left:solid thin black;'> <a href=" & rejectLink & ">Reject</a></td></tr></table>"
Line 5445:
Line 5446: If externalurl2 <> String.Empty Then
Line 5447: body_sv += "<table style='width:100%;text-align:center'><tr><td colspan='2'>If your approval or rejection did not work above, please click here.</td></tr><tr><td colspan='2'><a href=" & approveLinkExternal & ">"
Line 5448:
Line 5449: If getxmlval("svappemailimg") = "Y" Then
Line 5450: body_sv += "<img src=""http://" & externalurl2 & "/" & svEmailSiteName(1) & "/images/approve.gif"" border='0' style='border:solid 1px silver;' /></a><a href=" & rejectLinkExternal & "><img src=""http://" & externalurl2 & "/" & svEmailSiteName(1) & "/images/reject.gif"" border='0' style='border:solid 1px silver;' />"
Line 5451: Else
Line 5452: body_sv += "</a><a href=" & rejectLinkExternal & ">"
Line 5453: End If
Line 5454:
Line 5455: body_sv += "</a></td></tr><tr><td width='50%' style='text-align:right;'><a href=" & approveLinkExternal & ">Approve</a></td><td width='50%' style='text-align:left;border-left:solid thin black;'> <a href=" & rejectLinkExternal & ">Reject</a></td></tr></table>"
Line 5456: End If
Line 5457:
Line 5458: body_sv = getxmlval("svemailbegintxt") & "<br/>" & body_sv & "<br/>" & getxmlval("svemailendtxt")
Line 5459:
Line 5460: 'emailresult = emailsend(svEmail, "supervisor approval required", sendfrom, body_sv, nothing, nothing, mailserver, authenticate, usr, pwd)
Line 5461: If getxmlval("pdfspecialon") = "Y" And getxmlval("pdfemailseparate") <> "Y" Then
Line 5462: emailresult = emailsend(superviz, subject, sendfrom, sendfromname, body_sv, svapprovcc, svapprovbcc, mailserver, authenticate, usr, pwd, attachpdf)
Line 5463: Else
Line 5464: emailresult = emailsend(superviz, subject, sendfrom, sendfromname, body_sv, svapprovcc, svapprovbcc, mailserver, authenticate, usr, pwd, Nothing)
Line 5465: End If
Line 5466:
Line 5467: If emailresult <> "ok" Then
Line 5468: formerror("Final approval email was not sent due to the following mail server configuration problem:<br /><br />" & emailresult)
Line 5469: Response.End()
Line 5470: End If
Line 5471:
Line 5472: Session("SVemail") = ""
Line 5473:
Line 5474: ElseIf getxmlval("pdfspecialon") = "Y" And getxmlval("pdfemailseparate") <> "Y" Then
Line 5475: emailsend(superviz, subject, sendfrom, sendfromname, body_sv, svapprovcc, svapprovbcc, mailserver, authenticate, usr, pwd, attachpdf)
Line 5476: Else
Line 5477: emailsend(superviz, subject, sendfrom, sendfromname, body_sv, svapprovcc, svapprovbcc, mailserver, authenticate, usr, pwd, Nothing)
Line 5478: End If
Line 5479:
Line 5480:
Line 5481: End If
Line 5482: 'if getxmlval("gcspecialon") = "Y" and getxmlval("svspecialon") <> "Y" then
Line 5483:
Line 5484: 'SendGCEmails(orderId,false)
Line 5485: 'MOVED TO VERIFYORDER, LINE 714
Line 5486:
Line 5487: 'end if
Line 5488:
Line 5489: dbservermanager = Nothing
Line 5490:
Line 5491: End If
Line 5492: End Sub
Line 5493:
Line 5494: Function SvNumMessageTxt(ByVal OrderID As String) As String
Line 5495: Dim retval As String = String.Empty
Line 5496: Dim NumberLoc As Integer = 0
Line 5497: Dim OrigMsg As String = getxmlval("svnummessagetxt")
Line 5498: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5499:
Line 5500: Dim dotdot As String = String.Empty
Line 5501:
Line 5502: If OrderID <> String.Empty Then
Line 5503: dotdot = ".."
Line 5504: ElseIf Session("thisOrderID") <> String.Empty Then
Line 5505: OrderID = Session("thisOrderID")
Line 5506: End If
Line 5507:
Line 5508: Dim aOrder As Object = dbservermanager.ecomcall_array(Me.ToString() + " / Function_is_SvNumMessageTxt_1", Server.MapPath(dotdot), "getorderinfo", "EORDER", OrderID)
Line 5509:
Line 5510: If (aOrder(1) Is Nothing) Then
Line 5511: dotdot = ".."
Line 5512: aOrder = dbservermanager.ecomcall_array(Me.ToString() + " / Function_is_SvNumMessageTxt_1", Server.MapPath(dotdot), "getorderinfo", "EORDER", OrderID)
Line 5513: End If
Line 5514:
Line 5515: If Session("login") = String.Empty Then
Line 5516: Session("login") = aOrder(4)
Line 5517: End If
Line 5518:
Line 5519: For L As Integer = 1 To 3
Line 5520: Dim ThisNum As String = (FormatNumber(aOrder(37 + L), 2)).ToString()
Line 5521: ThisNum = ThisNum.Replace(",", "")
Line 5522: If OrderID = String.Empty And Session("numeric" & L) <> String.Empty And Session("svxmlnumemail" & L) <> String.Empty And Session("numericpercent" & L) <> String.Empty Then
Line 5523: NumberLoc = L
Line 5524: ElseIf OrderID <> String.Empty And ThisNum <> "0.00" Then
Line 5525: Dim arThisNum As Array = Split(ThisNum, ".")
Line 5526: Session("numeric" & L) = arThisNum(0)
Line 5527:
Line 5528: If arThisNum(1) = "00" Then
Line 5529: Session("numericpercent" & L) = "100"
Line 5530: Else
Line 5531: Session("numericpercent" & L) = CDec(arThisNum(1)).ToString()
Line 5532: End If
Line 5533: 'Dim dotLoc As Integer = InStr(ThisNum, ".")
Line 5534: 'Dim numLen As Integer = Len(ThisNum.ToString())
Line 5535: 'Session("numeric" & L) = Left(ThisNum, numLen - (dotLoc - 1))
Line 5536: 'Session("numericpercent" & L) = Right(ThisNum, numLen - dotLoc)
Line 5537: NumberLoc = L
Line 5538: Else
Line 5539: Exit For
Line 5540: End If
Line 5541: Next
Line 5542: Dim BeginRepeat As Integer = InStr(OrigMsg, "[repeat]")
Line 5543: Dim EndRepeat As Integer = InStr(OrigMsg, "[endrepeat]")
Line 5544: Dim RepeatLength As Integer
Line 5545: Dim FirstSection As String
Line 5546: Dim RepeatSection As String
Line 5547: Dim LastSection As String
Line 5548: Dim RepeatFinal As String = String.Empty
Line 5549: If BeginRepeat > 0 And EndRepeat > 0 Then
Line 5550: RepeatLength = EndRepeat - BeginRepeat - 8
Line 5551: FirstSection = Left(OrigMsg, BeginRepeat - 1)
Line 5552: RepeatSection = Mid(OrigMsg, BeginRepeat + 8, RepeatLength)
Line 5553: LastSection = Right(OrigMsg, OrigMsg.Length - EndRepeat - 10)
Line 5554: FirstSection = FirstSection.Replace("[loginname]", Session("login"))
Line 5555: RepeatSection = RepeatSection.Replace("[loginname]", Session("login"))
Line 5556: LastSection = LastSection.Replace("[loginname]", Session("login"))
Line 5557: For x As Integer = 1 To NumberLoc
Line 5558: Dim RepeatTemp As String = RepeatSection
Line 5559: RepeatTemp = RepeatTemp.Replace("[supnumx]", Session("numeric" & x))
Line 5560: RepeatTemp = RepeatTemp.Replace("[supnumxpercent]", Session("numericpercent" & x))
Line 5561: RepeatFinal &= RepeatTemp
Line 5562: Next
Line 5563:
Line 5564: retval = FirstSection & RepeatFinal & LastSection
Line 5565: Else
Line 5566: retval = OrigMsg.Replace("[loginname]", Session("login"))
Line 5567: End If
Line 5568:
Line 5569: Return retval
Line 5570: dbservermanager = Nothing
Line 5571: End Function
Line 5572:
Line 5573: Public Sub logtofile(ByVal filename As String, ByVal line As String, ByVal startover As Boolean)
Line 5574:
Line 5575: Dim filesys As Object = Server.CreateObject("Scripting.FileSystemObject")
Line 5576: Dim myFile As Object
Line 5577: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5578: Try
Line 5579: Dim getordersdir As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders\")
Line 5580: If startover = True Or Not File.Exists(getordersdir & filename & ".txt") Then
Line 5581: 'myFile = filesys.CreateTextFile("c:\ecommerce\orders\" & filename & ".txt", True)
Line 5582: myFile = filesys.CreateTextFile(getordersdir & filename & ".txt", True)
Line 5583: Else
Line 5584: 'myFile = filesys.OpenTextFile("c:\ecommerce\orders\" & filename & ".txt", 8)
Line 5585: myFile = filesys.OpenTextFile(getordersdir & filename & ".txt", 8)
Line 5586: End If
Line 5587: If InStr(line, "xml") > 0 Then
Line 5588: line = line.Replace("<", vbCrLf & "<")
Line 5589: End If
Line 5590:
Line 5591: myFile.WriteLine(line)
Line 5592:
Line 5593: Catch ex As Exception
Line 5594:
Line 5595: Finally
Line 5596: myFile.Close()
Line 5597: dbservermanager = Nothing
Line 5598: End Try
Line 5599: End Sub
Line 5600:
Line 5601: Public Sub logtofileWithTimes(ByVal filename As String, ByVal line As String, ByVal startover As Boolean, ByVal starttime As DateTime, ByVal endtime As DateTime)
Line 5602:
Line 5603: Dim filesys As Object = Server.CreateObject("Scripting.FileSystemObject")
Line 5604: Dim myFile As Object = Nothing
Line 5605: Dim elapsedTime As Integer = DateDiff("s", starttime, endtime)
Line 5606:
Line 5607: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5608: Try
Line 5609: Dim getordersdir As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders\")
Line 5610: If startover = True Or Not File.Exists(getordersdir & filename & ".txt") Then
Line 5611: myFile = filesys.CreateTextFile(getordersdir & filename & ".txt", True)
Line 5612: Else
Line 5613: myFile = filesys.OpenTextFile(getordersdir & filename & ".txt", 8)
Line 5614: End If
Line 5615: If InStr(line, "xml") > 0 Then
Line 5616: line = line.Replace("<", vbCrLf & "<")
Line 5617: End If
Line 5618:
Line 5619: myFile.WriteLine(line & " StartTime=" & starttime.ToString & " EndTime=" & endtime.ToString & " ElapsedTime=" & elapsedTime.ToString & " seconds")
Line 5620:
Line 5621: Catch ex As Exception
Line 5622:
Line 5623: Finally
Line 5624: myFile.Close()
Line 5625: dbservermanager = Nothing
Line 5626: End Try
Line 5627: End Sub
Line 5628:
Line 5629: Private Sub ProcessCard(ByVal orderid As String)
Line 5630: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5631:
Line 5632: If IsNumeric(getxmlval("scripttimeout")) Then
Line 5633: Server.ScriptTimeout = getxmlval("scripttimeout")
Line 5634: End If
Line 5635:
Line 5636: Dim ccmonth, ccyear, ccexp, parmList, Ctx1, curstring, varString, name, value, approved1, repsvalue, ref, authcode, orderamount, pono, street, city, state, zip, company, cardholder, country, phone, email
Line 5637: Dim aItem As Object
Line 5638: Try
Line 5639: aItem = dbservermanager.ecomcall_array(Me.ToString() + " / Sub_is_ProcessCard", Server.MapPath(""), "getorderinfo", "EORDER", orderid)
Line 5640: Finally
Line 5641: dbservermanager = Nothing
Line 5642: End Try
Line 5643:
Line 5644: ccmonth = aItem(28)
Line 5645: ccyear = aItem(29)
Line 5646: ccexp = ccmonth & ccyear
Line 5647:
Line 5648: If Session("diffamount") > 0 Then
Line 5649: orderamount = Math.Round(Session("diffamount"), 2)
Line 5650: Else
Line 5651: orderamount = Math.Round(aItem(33), 2)
Line 5652: End If
Line 5653:
Line 5654: cardholder = aItem(32)
Line 5655: pono = CStr(aItem(27))
Line 5656: street = CStr(aItem(8))
Line 5657: city = CStr(aItem(10))
Line 5658: state = CStr(aItem(11))
Line 5659: zip = CStr(aItem(12))
Line 5660: company = aItem(6)
Line 5661: country = Session("bcountry")
Line 5662:
Line 5663: If getxmlval("sphonepm") = "Y" And Session("sphone") <> String.Empty Then
Line 5664: phone = Session("sphone")
Line 5665: ElseIf getxmlval("sphonepm") = "Y" And Session("s_phone") <> String.Empty Then
Line 5666: phone = Session("s_phone")
Line 5667: Else
Line 5668: phone = aItem(20)
Line 5669: End If
Line 5670:
Line 5671: email = aItem(41)
Line 5672:
Line 5673: 'dim getno as string = dbservermanager.ecomcall_single(me.tostring(), server.mappath(""), "UpdateLastOrderNo", orderid, "N", session("authcode"), session("refnumber"), getxmlval("paypaltrxtype"))
Line 5674: If Session("readyforauthorize") = True Then
Line 5675: Session.Remove("readyforauthorize")
Line 5676:
Line 5677: Dim encryptionkey As String = "asics"
Line 5678: 'if getxmlval("ccencryptionkey") <> string.empty then
Line 5679: ' encryptionkey = getxmlval("ccencryptionkey")
Line 5680: 'end if
Line 5681:
Line 5682: Dim ccsec As String = IIf(getxmlval("ccshowsecurity") = "Y", DecryptString128Bit(Session("ccsecurity"), encryptionkey), String.Empty)
Line 5683: Session("ccvalid") = validatecc(DecryptString128Bit(Session("ccnumber"), encryptionkey), ccsec, Session("ccmonth"), Session("ccyear"), Session("ccname"))
Line 5684:
Line 5685: Session("goyo") = Session("ccvalid")
Line 5686:
Line 5687: ' IF ERRORS THEN REDIRECT AND LIST
Line 5688:
Line 5689: If Session("errors") > 0 Then
Line 5690: r1.Response.Redirect("default.aspx?p=" & Session("ccenteredpage"))
Line 5691: End If
Line 5692: End If
Line 5693:
Line 5694: End Sub
Line 5695: Private Sub ProcessSupervisor(ByVal orderid As String, ByVal ordno As String)
Line 5696: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5697: Dim loopy, iFinal As Integer
Line 5698: iFinal = 0
Line 5699:
Line 5700: Session("svlev1") = Trim(getxmlval("svlev1"))
Line 5701: Session("svlev2") = Trim(getxmlval("svlev2"))
Line 5702: Session("svlev3") = Trim(getxmlval("svlev3"))
Line 5703: Session("svlev4") = Trim(getxmlval("svlev4"))
Line 5704: Session("svlev5") = Trim(getxmlval("svlev5"))
Line 5705: Session("svlev6") = Trim(getxmlval("svlev6"))
Line 5706:
Line 5707: For loopy = 1 To 6
Line 5708: If Session("svlev" & loopy) = "" Then
Line 5709: Session("svlev" & loopy) = 0
Line 5710:
Line 5711: If iFinal = 0 Then
Line 5712: iFinal = loopy - 1
Line 5713: End If
Line 5714: End If
Line 5715: Next
Line 5716:
Line 5717: Dim svlev1, svlev2, svlev3, svlev4, svlev5, svlev6 As Double
Line 5718:
Line 5719: svlev1 = CDbl(Session("svlev1"))
Line 5720: svlev2 = CDbl(Session("svlev2"))
Line 5721: svlev3 = CDbl(Session("svlev3"))
Line 5722: svlev4 = CDbl(Session("svlev4"))
Line 5723: svlev5 = CDbl(Session("svlev5"))
Line 5724: svlev6 = CDbl(Session("svlev6"))
Line 5725:
Line 5726: Select Case Session("passgrandtotal")
Line 5727: Case Is <= svlev1
Line 5728: Session("finallev") = 0
Line 5729: Case Is <= svlev2
Line 5730: Session("finallev") = 1
Line 5731: Case Is <= svlev3
Line 5732: Session("finallev") = 2
Line 5733: Case Is <= svlev4
Line 5734: Session("finallev") = 3
Line 5735: Case Is <= svlev5
Line 5736: Session("finallev") = 4
Line 5737: Case Is <= svlev6
Line 5738: Session("finallev") = 5
Line 5739: Case Is > svlev6
Line 5740: If iFinal < 6 And iFinal <> 0 Then
Line 5741: Session("finallev") = iFinal
Line 5742: Else
Line 5743: Session("finallev") = 6
Line 5744: End If
Line 5745: End Select
Line 5746:
Line 5747: If Session("finallev") > 0 Then
Line 5748: Dim aOutp As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetSupervisorEmail", Session("dept"), "1")
Line 5749: Dim currentlev As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetSupervisorLevel", Session("dept"), aOutp)
Line 5750:
Line 5751: currentlev = currentlev - 1
Line 5752: If getxmlval("svxmlspecialon") = "Y" And Session("svxmldept") <> String.Empty Then
Line 5753: Session("dept") = Session("svxmldept")
Line 5754: End If
Line 5755: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateApprovalOrderInfo", "add", orderid, currentlev, Session("finallev"), "", Session("dept"), ordno)
Line 5756:
Line 5757: Else
Line 5758: If getxmlval("ordertype") = "reg" Then
Line 5759: createxmlorder("", "REG")
Line 5760:
Line 5761: ElseIf getxmlval("ordertype") = "ffxml" Then
Line 5762: createxmlorder("", "FF")
Line 5763:
Line 5764: ElseIf getxmlval("ordertype") = "splitorderxmls" Then
Line 5765: Dim aLineItemTypes As Object = dbservermanager.ecomcall_array(Me.ToString() + " / sub_is_ProcessSupervisor", Server.MapPath(""), "GetSplitOrderLineItemTypes", orderid, Trim(getxmlval("splitorderfflineitemcode")), Trim(getxmlval("splitorderoelineitemcode")))
Line 5766: Session("HaveSplitOrderFFLineItems") = aLineItemTypes(1)
Line 5767: Session("HaveSplitOrderOELineItems") = aLineItemTypes(2)
Line 5768:
Line 5769: If Session("HaveSplitOrderFFLineItems") = "Y" Then
Line 5770: createxmlorder("", "FF")
Line 5771: Session("XMLProcessed") = True
Line 5772: End If
Line 5773:
Line 5774: If Session("HaveSplitOrderOELineItems") = "Y" Then
Line 5775: createxmlorder("", "REG")
Line 5776: Session("XMLProcessed") = True
Line 5777: End If
Line 5778: Else
Line 5779: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "Transferorder", orderid, Session("shiptocode"), getxmlval("sphonepm"))
Line 5780: Dim clear530 = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "ClearCreditCardInfo", orderid)
Line 5781: End If
Line 5782:
Line 5783: End If
Line 5784: dbservermanager = Nothing
Line 5785: End Sub
Line 5786:
Line 5787: Public Sub CreateContact()
Line 5788: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5789: Dim conttype As String
Line 5790: If getxmlval("createcontact") = "attn" Then
Line 5791: conttype = getxmlval("conttypeid")
Line 5792: Else
Line 5793: conttype = Session("contacttype")
Line 5794: End If
Line 5795: Dim bfax As String = ""
Line 5796: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "CreateNewContact", Session("custno"), Session("sname"), Session("bemail"), Session("bphone"), bfax, conttype, getxmlval("createcontact"))
Line 5797: dbservermanager = Nothing
Line 5798:
Line 5799: End Sub
Line 5800:
Line 5801: Private Sub ChangeThePersonalization(ByVal ordernum As String)
Line 5802: 'IN THE PDF PROOF FILE NAME, CHANGES THE ORDERID TO THE ORDER NUMBER
Line 5803: If getxmlval("pdfspecialon") = "Y" Then
Line 5804: wt(True, "pdf")
Line 5805: changepersonalization(Session("orderid"), Session("properorderid"), Trim(ordernum))
Line 5806: wt(False, "pdf")
Line 5807: End If
Line 5808:
Line 5809: 'REMOVING "PERSONALIZATION:" INDICATOR FROM PERSONALIZATION FIELD
Line 5810: If getxmlval("removepers") = "Y" Then
Line 5811: wt(True, "removepers")
Line 5812: changepersonalization(Session("orderid"), "Personalization:", String.Empty)
Line 5813: wt(False, "removepers")
Line 5814: End If
Line 5815: End Sub
Line 5816: Private Sub RedeemGivex()
Line 5817: Dim givexremain As Double = Session("givexcharge")
Line 5818: Dim givexfieldqty As Integer
Line 5819:
Line 5820: If getxmlval("givexfieldqty") <> String.Empty And getxmlval("givexfieldqty") <= 18 Then
Line 5821: givexfieldqty = getxmlval("givexfieldqty")
Line 5822: ElseIf getxmlval("givexfieldqty") > 18 Then
Line 5823: givexfieldqty = 18
Line 5824: Else
Line 5825: givexfieldqty = 5
Line 5826: End If
Line 5827:
Line 5828: For t1 As Integer = 1 To givexfieldqty
Line 5829: If Session("givexcb" & t1) <> String.Empty Then
Line 5830: Dim givexrf As String = GivexAction("RedeemForced", Session("givexnumber" & t1), t1)
Line 5831: If givexrf = "timeout" Then
Line 5832: Dim timeoutresult As String = GivexAction("Reversal", Session("givexnumber" & t1), t1)
Line 5833: If timeoutresult = "reversal failed" Then
Line 5834: formerror("Timeout on Givex Connection. <br />" & Session("nodeerror"))
Line 5835: Session("nodeerror") = String.Empty
Line 5836: r1.Response.End()
Line 5837: Else
Line 5838: formerror("Timeout on Givex Connection. Reversal successful.<br />" & Session("nodeerror"))
Line 5839: Session("nodeerror") = String.Empty
Line 5840: r1.Response.End()
Line 5841: End If
Line 5842: ElseIf IsNumeric(givexrf) = False Then
Line 5843: formerror("Error on Givex Transaction: " & Session("nodeerror") & givexrf)
Line 5844: Session("nodeerror") = String.Empty
Line 5845: r1.Response.End()
Line 5846: End If
Line 5847: End If
Line 5848: Next
Line 5849: Session("nodeerror") = String.Empty
Line 5850: End Sub
Line 5851: Sub killordersessions()
Line 5852:
Line 5853: If Session("oktoprocess") Then
Line 5854: Session.Remove("giftcardTemp")
Line 5855: End If
Line 5856: Session.Remove("continueinfo")
Line 5857: Session.Remove("oktoverify")
Line 5858: Session.Remove("oktoprocess")
Line 5859: Session.Remove("shipmethod")
Line 5860: Session.Remove("inhandmonth")
Line 5861: Session.Remove("inhandday")
Line 5862: Session.Remove("inhandyear")
Line 5863: Session.Remove("inhanddate")
Line 5864: Session.Remove("paymentmethod")
Line 5865: Session.Remove("cctype")
Line 5866: Session.Remove("ccname")
Line 5867: Session.Remove("ccnumber")
Line 5868: Session.Remove("ccsecurity")
Line 5869: Session.Remove("ccmonth")
Line 5870: Session.Remove("ccyear")
Line 5871: Session.Remove("firstpaymethod")
Line 5872: Session.Remove("potext")
Line 5873: Session.Remove("formpmt1")
Line 5874: Session.Remove("formpmt2")
Line 5875: Session.Remove("formpmt3")
Line 5876: Session.Remove("compt1")
Line 5877: Session.Remove("compt2")
Line 5878: Session.Remove("alphavalue1")
Line 5879: Session.Remove("alphavalue2")
Line 5880: Session.Remove("alphavalue3")
Line 5881: Session.Remove("specinst")
Line 5882: Session.Remove("specinstsave")
Line 5883: Session.Remove("passgrandtotal")
Line 5884: Session.Remove("GetOrderItemInfo")
Line 5885: SessionRemoveSelected("GetItemMastInfo:")
Line 5886: Session.Remove("finallev")
Line 5887: Session.Remove("comdatatext")
Line 5888: Session.Remove("compmt1")
Line 5889: Session.Remove("compmt2")
Line 5890: Dim z, n
Line 5891:
Line 5892: If getxmlval("attachloginstogiftcerts") = "Y" Then
Line 5893: For i As Integer = 1 To Session("QuantityGiftCertsByLogin")
Line 5894: Session.Remove("giftcertno" & i)
Line 5895: Session.Remove("giftcertamt" & i)
Line 5896: Next
Line 5897: Else
Line 5898: For i As Integer = 1 To getxmlval("numofgiftcerts")
Line 5899: Session.Remove("giftcertno" & i)
Line 5900: Session.Remove("giftcertamt" & i)
Line 5901: Next
Line 5902: End If
Line 5903:
Line 5904: SessionRemoveSelected("GiftCertsByLogin")
Line 5905: For n = 0 To CInt(Session("numofgiftcerts") / 5)
Line 5906: Session.Remove("subtotal" & n)
Line 5907: Next
Line 5908: Session.Remove("subtotal")
Line 5909: Session.Remove("gcnotblank")
Line 5910: Session.Remove("gcnotblank2")
Line 5911: Session.Remove("gcnotblank3")
Line 5912: Session.Remove("zeroes")
Line 5913: Session.Remove("gcrunning")
Line 5914: Session.Remove("gcstart")
Line 5915: Session.Remove("acctexec1")
Line 5916: Session.Remove("acctexec2")
Line 5917: Session.Remove("acctexec3")
Line 5918: Session.Remove("acctexec4")
Line 5919: Session.Remove("acctexecspecinst")
Line 5920: Session.Remove("shipdatemonth")
Line 5921: Session.Remove("shipdateday")
Line 5922: Session.Remove("shipdateyear")
Line 5923: Session.Remove("shipdate")
Line 5924: Session.Remove("shipcomment1")
Line 5925: Session.Remove("shipcomment2")
Line 5926: Session.Remove("fedexnum")
Line 5927: Session.Remove("fedexservice")
Line 5928: Session.Remove("fedexinfo")
Line 5929: Session.Remove("dutymc")
Line 5930: Session.Remove("dutycty")
Line 5931: Session.Remove("dutymcamt")
Line 5932: Session.Remove("bcompany")
Line 5933: Session.Remove("bname")
Line 5934: Session.Remove("baddr1")
Line 5935: Session.Remove("baddr2")
Line 5936: Session.Remove("bcity")
Line 5937: Session.Remove("bstate")
Line 5938: Session.Remove("bzip")
Line 5939: Session.Remove("bcountry")
Line 5940: Session.Remove("bphone")
Line 5941: Session.Remove("bemail")
Line 5942: Session.Remove("bemail2")
Line 5943: Session.Remove("scompany")
Line 5944: Session.Remove("sname")
Line 5945: Session.Remove("saddr1")
Line 5946: Session.Remove("saddr2")
Line 5947: Session.Remove("scity")
Line 5948: Session.Remove("sstate")
Line 5949: Session.Remove("szip")
Line 5950: Session.Remove("scountry")
Line 5951: Session.Remove("bdiscount")
Line 5952: Session.Remove("discountspecinst")
Line 5953: Session.Remove("shipweighterror")
Line 5954: Session.Remove("createdpdfs")
Line 5955: Session.Remove("nopersonalization")
Line 5956: Session.Remove("urlgrab1")
Line 5957: Session.Remove("urlgrab2")
Line 5958: Session.Remove("urlgrab3")
Line 5959: For y1 As Integer = 1 To 5
Line 5960: Session.Remove("givexnumber" & y1)
Line 5961: Session.Remove("givexsecur" & y1)
Line 5962: Session.Remove("givexcb" & y1)
Line 5963: Session.Remove("givexchg" & y1)
Line 5964: Next
Line 5965: SessionRemoveSelected("givex")
Line 5966: Session.Remove("givexverify")
Line 5967: Session.Remove("cartFull")
Line 5968: Session.Remove("giftcardsingle")
Line 5969: Session.Remove("interceptold")
Line 5970: Session.Remove("interceptnew")
Line 5971: Session.Remove("C_WHOLESALER")
Line 5972: Session.Remove("getno")
Line 5973: Session.Remove("firstfreeorder")
Line 5974: Session.Remove("CCProcessed")
Line 5975: Session.Remove("CCUpdated")
Line 5976: Session.Remove("GCProcessed")
Line 5977: Session.Remove("GCEmailsSent")
Line 5978: Session.Remove("GivexRedeemed")
Line 5979: Session.Remove("SVProcessed")
Line 5980: Session.Remove("XMLProcessed")
Line 5981: Session.Remove("OrderTransferred")
Line 5982: Session.Remove("ContactCreated")
Line 5983:
Line 5984: If getxmlval("onlineprocessing") = "PromoPayment" Then
Line 5985: Session.Remove("txn_id")
Line 5986: Session.Remove("token-id")
Line 5987: Session.Remove("thisTransGuid")
Line 5988: Session.Remove("ppStepOneResult")
Line 5989: End If
Line 5990: clearABsessions()
Line 5991: getneworderid()
Line 5992: emptyOrderIdonEORDER()
Line 5993:
Line 5994: If Session("cartcleared") = "T" Then
Line 5995: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 5996: Session("add back order id") = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateEloginField", Session("login"), Session("progno"), Session("custno"), "Orderid", Session("orderid"))
Line 5997: dbservermanager = Nothing
Line 5998: Session.Remove("cartcleared")
Line 5999: End If
Line 6000: End Sub
Line 6001:
Line 6002: ' added this to get current IP4 address of this machine (when IIS returns "::1" getneworderid() for Request.ServerVariables("Remote_addr"))
Line 6003: Private Function GetIP4Address() As String
Line 6004: Dim IP4Address As String = String.Empty
Line 6005:
Line 6006: For Each IPA As IPAddress In Dns.GetHostAddresses(HttpContext.Current.Request.UserHostAddress)
Line 6007: If IPA.AddressFamily.ToString() = "InterNetwork" Then
Line 6008: IP4Address = IPA.ToString()
Line 6009: Exit For
Line 6010: End If
Line 6011: Next
Line 6012:
Line 6013: If IP4Address <> String.Empty Then
Line 6014: Return IP4Address
Line 6015: End If
Line 6016:
Line 6017: For Each IPA As IPAddress In Dns.GetHostAddresses(Dns.GetHostName())
Line 6018: If IPA.AddressFamily.ToString() = "InterNetwork" Then
Line 6019: IP4Address = IPA.ToString()
Line 6020: Exit For
Line 6021: End If
Line 6022: Next
Line 6023:
Line 6024: Return IP4Address
Line 6025: End Function
Line 6026:
Line 6027:
Line 6028:
Line 6029:
Line 6030: Sub getneworderid()
Line 6031:
Line 6032: Dim ipaddress As String = r1.Request.ServerVariables("Remote_addr").Replace(".", "")
Line 6033:
Line 6034: ' fix for dave W's setup - not sure why getting ::1 but is better if it is something rather than that.
Line 6035: If ipaddress = "::1" Then
Line 6036: ipaddress = GetIP4Address().Replace(".", "")
Line 6037: End If
Line 6038:
Line 6039: If ipaddress.IndexOf(":") > -1 Then
Line 6040: ipaddress = ipaddress.Replace(":", "")
Line 6041: End If
Line 6042:
Line 6043: Session("orderid") = ipaddress & CStr(Year(Now)) & CStr(Month(Now)) & CStr(Day(Now)) & CStr(Hour(Now)) & CStr(Minute(Now)) & CStr(Second(Now))
Line 6044:
Line 6045: End Sub
Line 6046: Sub properorderid()
Line 6047: Dim properorderid As String
Line 6048: Dim properlength As Integer = Session("orderid").length - 2
Line 6049:
Line 6050: If Left(Session("orderid"), 2) <> "::" Then
Line 6051: properorderid = Session("orderid")
Line 6052: Else
Line 6053: properorderid = Right(Session("orderid"), properlength)
Line 6054: End If
Line 6055: Session("properorderid") = properorderid
Line 6056: End Sub
Line 6057:
Line 6058: Function dumpsessions() As Boolean
Line 6059: Dim doc As New XmlDocument()
Line 6060: Dim root As XmlElement = doc.CreateElement("Root")
Line 6061: Dim attrootID As XmlAttribute = doc.CreateAttribute("orderid")
Line 6062: attrootID.Value = Session("orderid")
Line 6063: root.Attributes.Append(attrootID)
Line 6064: Dim attrootsite As XmlAttribute = doc.CreateAttribute("site")
Line 6065: attrootsite.Value = baseurl() & "paymentnotify.aspx"
Line 6066: root.Attributes.Append(attrootsite)
Line 6067: doc.AppendChild(root)
Line 6068: Dim sessionvals As XmlElement = doc.CreateElement("SessionVals")
Line 6069: root.AppendChild(sessionvals)
Line 6070: 'PROPERORDERID SETS THE SESSION VARIABLE OF THE SAME NAME TO THE PROPER VALUE
Line 6071: properorderid()
Line 6072:
Line 6073: 'CSEC-815 - Comment out the following 2 lines of code for now
Line 6074: 'Session.Remove("ccnumber")
Line 6075: 'Session.Remove("ccsecurity")
Line 6076: For Each lp As String In Session.Contents
Line 6077: 'root.AppendChild(doc.ImportNode(recordSession(lp), True))
Line 6078: Dim firstchar As String = Left(lp, 1)
Line 6079: If Not IsNumeric(firstchar) Then
Line 6080: sessionvals.AppendChild(doc.ImportNode(recordSession(lp), True))
Line 6081: End If
Line 6082:
Line 6083: Next
Line 6084: 'FIND ORDERS FOLDER
Line 6085: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 6086: Dim getordersdir As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders")
Line 6087: Dim sessdir As String = getordersdir & "\dumps"
Line 6088: Dim ondir As String = sessdir & "\OrderNumbers"
Line 6089: 'CREATE FOLDER IF IT DOES NOT EXIST
Line 6090: Dim filesys As Object = Server.CreateObject("Scripting.FileSystemObject")
Line 6091: If filesys.FolderExists(sessdir) = False Then
Line 6092: filesys.CreateFolder(sessdir)
Line 6093: End If
Line 6094: If filesys.FolderExists(ondir) = False Then
Line 6095: filesys.CreateFolder(ondir)
Line 6096: End If
Line 6097: Dim key As RijndaelManaged = Nothing
Line 6098:
Line 6099: Try
Line 6100: ' Create a new Rijndael key.
Line 6101: key = New RijndaelManaged()
Line 6102: Dim mykey() As Byte = {161, 62, 32, 30, 102, 103, 55, 42, 216, 220, 74, 6, 13, 201, 241, 147}
Line 6103: key.Key = mykey
Line 6104:
Line 6105: EncryptXmlElement(doc, "SessionVals", key)
Line 6106:
Line 6107: Finally
Line 6108: ' Clear the key.
Line 6109: If Not (key Is Nothing) Then
Line 6110: key.Clear()
Line 6111: End If
Line 6112: End Try
Line 6113:
Line 6114: filesys = Nothing
Line 6115: doc.Save(sessdir & "\" & Session("properorderid") & ".xml")
Line 6116:
Line 6117: Dim saved As Boolean = True
Line 6118: doc = Nothing
Line 6119: If Session("NPCSecureUsed") = True Then
Line 6120: Dim fp As StreamWriter
Line 6121:
Line 6122: Try
Line 6123: fp = File.CreateText(ondir & "\" & Session("getno") & ".txt")
Line 6124: fp.Write(Session("properorderid"))
Line 6125: fp.Write(vbCrLf & baseurl() & "paymentnotify.aspx")
Line 6126: fp.Close()
Line 6127: Catch err As Exception
Line 6128: End Try
Line 6129: End If
Line 6130: dbservermanager = Nothing
Line 6131: Return saved
Line 6132: End Function
Line 6133:
Line 6134: Function Dumpextract() As Boolean
Line 6135: Dim doc As New XmlDocument()
Line 6136:
Line 6137: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 6138: Dim getordersdir As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(".."), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders")
Line 6139:
Line 6140: Dim saved As Boolean = True
Line 6141: If Right(getordersdir, 1) = "\" Then
Line 6142: getordersdir = Left(getordersdir, getordersdir.Length - 1)
Line 6143: End If
Line 6144:
Line 6145: Dim sessdir As String = getordersdir & "\dumps"
Line 6146: Dim filename As String = sessdir & "\" & Session("properorderid") & ".xml"
Line 6147:
Line 6148:
Line 6149: Dim ordNoFile As String = String.Empty
Line 6150: Dim ordNoContents As String = String.Empty
Line 6151: Dim ordNoContentsLines As Array
Line 6152: 'Dim secfilename As String = sessdir & "\" & File.ReadAllText(ordNoFile) & ".xml"
Line 6153: Dim secfilename As String = String.Empty
Line 6154: If Session("NPCSecureUsed") = True Then
Line 6155: ordNoFile = sessdir & "\OrderNumbers\" & Session("getno") & ".txt"
Line 6156: ordNoContents = File.ReadAllText(ordNoFile)
Line 6157: ordNoContentsLines = ordNoContents.Split(vbCrLf)
Line 6158: secfilename = sessdir & "\" & ordNoContentsLines(0) & ".xml"
Line 6159: logtofile("Paymenttest", "secfilename: " & secfilename, False)
Line 6160: End If
Line 6161:
Line 6162: If Session("NPCSecureUsed") = True AndAlso (VerifyFile(filename) = False) And VerifyFile(ordNoFile) Then
Line 6163: If VerifyFile(secfilename) Then
Line 6164: filename = secfilename
Line 6165: End If
Line 6166: End If
Line 6167:
Line 6168: If Not (VerifyFile(filename)) Then
Line 6169: saved = False
Line 6170: Else
Line 6171:
Line 6172: doc.Load(filename)
Line 6173: Dim key As RijndaelManaged = Nothing
Line 6174: Try
Line 6175: key = New RijndaelManaged()
Line 6176: Dim mykey() As Byte = {161, 62, 32, 30, 102, 103, 55, 42, 216, 220, 74, 6, 13, 201, 241, 147}
Line 6177: key.Key = mykey
Line 6178: DecryptXmlElement(doc, key)
Line 6179: Catch e As Exception
Line 6180: saved = False
Line 6181: Finally
Line 6182: ' Clear the key.
Line 6183: If Not (key Is Nothing) Then
Line 6184: key.Clear()
Line 6185: End If
Line 6186: End Try
Line 6187:
Line 6188: Dim sessvals As XmlElement = doc.DocumentElement.SelectSingleNode("SessionVals")
Line 6189: Dim sess As XmlNodeList = sessvals.ChildNodes
Line 6190:
Line 6191: For Each ren As XmlNode In sess
Line 6192: If Not (ren.InnerText Is Nothing) And ren.InnerText <> String.Empty Then
Line 6193: Dim rName As String = ren.Name
Line 6194: rName = unEscapeXml(rName)
Line 6195: rName = rName.Replace("ASIPLUS", "+")
Line 6196: rName = rName.Replace("ASISPACE", " ")
Line 6197: rName = rName.Replace("ASIDOLLARSIGN", "$")
Line 6198: rName = rName.Replace("ASIPIPE", "|")
Line 6199: rName = rName.Replace("ASISLASH", "/")
Line 6200: rName = rName.Replace("ASIBACKSLASH", "\")
Line 6201: rName = rName.Replace("ASIAT", "@")
Line 6202: rName = rName.Replace("ASIONE", "1")
Line 6203: rName = rName.Replace("ASITWO", "2")
Line 6204: rName = rName.Replace("ASITHREE", "3")
Line 6205: rName = rName.Replace("ASIFOUR", "4")
Line 6206: rName = rName.Replace("ASIFIVE", "5")
Line 6207: rName = rName.Replace("ASISIX", "6")
Line 6208: rName = rName.Replace("ASISEVEN", "7")
Line 6209: rName = rName.Replace("ASIEIGHT", "8")
Line 6210: rName = rName.Replace("ASININE", "9")
Line 6211: rName = rName.Replace("ASIZERO", "0")
Line 6212: 'Select Case ren.Attributes(0).Value
Line 6213: ' Case "System.String"
Line 6214: ' Dim c1 As String = ren.InnerXml
Line 6215: ' Session(rName) = c1
Line 6216: ' Case "System.Boolean"
Line 6217: ' Dim c1 As Boolean = ren.InnerXml
Line 6218: ' Session(rName) = c1
Line 6219: ' Case "System.Double"
Line 6220: ' Dim c1 As Double = ren.InnerXml
Line 6221: ' Session(rName) = c1
Line 6222: ' Case "System.Int32"
Line 6223: ' Dim c1 As Int32 = ren.InnerXml
Line 6224: ' Session(rName) = c1
Line 6225: ' Case Else
Line 6226:
Line 6227: 'End Select
Line 6228:
Line 6229: End If
Line 6230: Next
Line 6231: ' File.Delete(filename)
Line 6232:
Line 6233: doc.Save(sessdir & "\" & Session("properorderid") & "_U.xml")
Line 6234:
Line 6235: End If
Line 6236:
Line 6237: Return saved
Line 6238:
Line 6239: End Function
Line 6240:
Line 6241: Function storesessions() As Boolean
Line 6242: Dim doc As New XmlDocument()
Line 6243: Dim root As XmlElement = doc.CreateElement("Root")
Line 6244: Dim attrootID As XmlAttribute = doc.CreateAttribute("orderid")
Line 6245: attrootID.Value = Session("orderid")
Line 6246: root.Attributes.Append(attrootID)
Line 6247: Dim attrootsite As XmlAttribute = doc.CreateAttribute("site")
Line 6248: attrootsite.Value = baseurl() & "paymentnotify.aspx"
Line 6249: root.Attributes.Append(attrootsite)
Line 6250: doc.AppendChild(root)
Line 6251: Dim sessionvals As XmlElement = doc.CreateElement("SessionVals")
Line 6252: root.AppendChild(sessionvals)
Line 6253: 'PROPERORDERID SETS THE SESSION VARIABLE OF THE SAME NAME TO THE PROPER VALUE
Line 6254: properorderid()
Line 6255:
Line 6256: Session.Remove("ccnumber")
Line 6257: Session.Remove("ccsecurity")
Line 6258:
Line 6259: For Each lp As String In Session.Contents
Line 6260: Dim firstchar As String = Left(lp, 1)
Line 6261: If Not IsNumeric(firstchar) Then
Line 6262: sessionvals.AppendChild(doc.ImportNode(recordSession(lp), True))
Line 6263: End If
Line 6264: Next
Line 6265:
Line 6266: 'FIND ORDERS FOLDER
Line 6267: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 6268: Dim getordersdir As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders")
Line 6269: Dim sessdir As String = getordersdir & "\sessions"
Line 6270: Dim ondir As String = sessdir & "\OrderNumbers"
Line 6271: 'CREATE FOLDER IF IT DOES NOT EXIST
Line 6272: Dim filesys As Object = Server.CreateObject("Scripting.FileSystemObject")
Line 6273: If filesys.FolderExists(sessdir) = False Then
Line 6274: filesys.CreateFolder(sessdir)
Line 6275: End If
Line 6276: If filesys.FolderExists(ondir) = False Then
Line 6277: filesys.CreateFolder(ondir)
Line 6278: End If
Line 6279: Dim key As RijndaelManaged = Nothing
Line 6280:
Line 6281: Try
Line 6282: ' Create a new Rijndael key.
Line 6283: key = New RijndaelManaged()
Line 6284: Dim mykey() As Byte = {161, 62, 32, 30, 102, 103, 55, 42, 216, 220, 74, 6, 13, 201, 241, 147}
Line 6285: key.Key = mykey
Line 6286:
Line 6287: EncryptXmlElement(doc, "SessionVals", key)
Line 6288:
Line 6289: Finally
Line 6290: ' Clear the key.
Line 6291: If Not (key Is Nothing) Then
Line 6292: key.Clear()
Line 6293: End If
Line 6294: End Try
Line 6295:
Line 6296: If Session("SHDeleteAttempted") = True Then
Line 6297: Dim sHDelAttempted As String = sessdir & "\SHDeleteAttempted"
Line 6298: If filesys.FolderExists(sHDelAttempted) = False Then
Line 6299: filesys.CreateFolder(sHDelAttempted)
Line 6300: End If
Line 6301: doc.Save(sHDelAttempted & "\" & Session("properorderid") & ".xml")
Line 6302: End If
Line 6303:
Line 6304: filesys = Nothing
Line 6305: doc.Save(sessdir & "\" & Session("properorderid") & ".xml")
Line 6306:
Line 6307: Dim saved As Boolean = True
Line 6308: doc = Nothing
Line 6309: If Session("NPCSecureUsed") = True Then
Line 6310: Dim fp As StreamWriter
Line 6311:
Line 6312: Try
Line 6313: fp = File.CreateText(ondir & "\" & Session("getno") & ".txt")
Line 6314: fp.Write(Session("properorderid"))
Line 6315: fp.Write(vbCrLf & baseurl() & "paymentnotify.aspx")
Line 6316: fp.Close()
Line 6317: Catch err As Exception
Line 6318: End Try
Line 6319: End If
Line 6320: dbservermanager = Nothing
Line 6321: Return saved
Line 6322: End Function
Line 6323: Function recordSession(ByVal key As String) As XmlElement
Line 6324: Dim doc As New XmlDocument()
Line 6325: Dim newkey As String = key
Line 6326: newkey = newkey.Replace("+", "ASIPLUS")
Line 6327: newkey = newkey.Replace(" ", "ASISPACE")
Line 6328: newkey = newkey.Replace("$", "ASIDOLLARSIGN")
Line 6329: newkey = newkey.Replace("|", "ASIPIPE")
Line 6330: newkey = newkey.Replace("/", "ASISLASH")
Line 6331: newkey = newkey.Replace("\", "ASIBACKSLASH")
Line 6332: newkey = newkey.Replace("@", "ASIAT")
Line 6333: newkey = newkey.Replace("1", "ASIONE")
Line 6334: newkey = newkey.Replace("2", "ASITWO")
Line 6335: newkey = newkey.Replace("3", "ASITHREE")
Line 6336: newkey = newkey.Replace("4", "ASIFOUR")
Line 6337: newkey = newkey.Replace("5", "ASIFIVE")
Line 6338: newkey = newkey.Replace("6", "ASISIX")
Line 6339: newkey = newkey.Replace("7", "ASISEVEN")
Line 6340: newkey = newkey.Replace("8", "ASIEIGHT")
Line 6341: newkey = newkey.Replace("9", "ASININE")
Line 6342: newkey = newkey.Replace("0", "ASIZERO")
Line 6343:
Line 6344: Dim thiselement As XmlElement = doc.CreateElement(newkey)
Line 6345: Dim thisatt As XmlAttribute = doc.CreateAttribute("datatype")
Line 6346:
Line 6347: If Not (Session(key) Is Nothing) Then
Line 6348: thisatt.Value = Session(key).GetType.ToString()
Line 6349: thiselement.Attributes.Append(thisatt)
Line 6350: Try
Line 6351: If InStr(thisatt.Value, "[]") < 1 Then
Line 6352: thiselement.InnerXml = EscapeXml(Session(key).ToString())
Line 6353: 'Session("examplekey") = Session(key)
Line 6354: Else
Line 6355: thiselement.InnerXml = thisatt.Value
Line 6356: End If
Line 6357:
Line 6358: Catch ex As Exception
Line 6359: thiselement.InnerXml = "Problem here"
Line 6360: End Try
Line 6361:
Line 6362: Else
Line 6363: thisatt.Value = "No type"
Line 6364: End If
Line 6365: Return thiselement
Line 6366: End Function
Line 6367:
Line 6368: Function getOriginatingSite() As String
Line 6369: Dim originatingSite As String
Line 6370: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 6371: Dim getordersdir As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders")
Line 6372: Dim saved As Boolean = True
Line 6373: If Right(getordersdir, 1) = "\" Then
Line 6374: getordersdir = Left(getordersdir, getordersdir.Length - 1)
Line 6375: End If
Line 6376: Dim sessdir As String = getordersdir & "\sessions"
Line 6377: Dim filename As String = sessdir & "\" & Session("properorderid") & ".xml"
Line 6378: Dim ordNoFile As String = sessdir & "\OrderNumbers\" & Session("getno") & ".txt"
Line 6379: Dim ordNoContents As String = File.ReadAllText(ordNoFile)
Line 6380: Dim ordNoContentsLines As Array = ordNoContents.Split(vbCrLf)
Line 6381: Dim PaymentNotifyPath As String = ordNoContentsLines(1)
Line 6382: PaymentNotifyPath = PaymentNotifyPath.Replace(vbCrLf, String.Empty)
Line 6383: PaymentNotifyPath = PaymentNotifyPath.Replace(vbLf, String.Empty)
Line 6384: Dim thisSitePNP As String = baseurl() & "paymentnotify.aspx"
Line 6385: Dim PaymentNotifyPathlook = PaymentNotifyPath.Replace(":", String.Empty)
Line 6386: Dim thisSitePNPlook = thisSitePNP.Replace(":", String.Empty)
Line 6387: PaymentNotifyPathlook = PaymentNotifyPath.Replace("/", String.Empty)
Line 6388: thisSitePNPlook = thisSitePNPlook.Replace("/", String.Empty)
Line 6389: PaymentNotifyPathlook = PaymentNotifyPath.Replace(".", String.Empty)
Line 6390: thisSitePNPlook = thisSitePNPlook.Replace(".", String.Empty)
Line 6391:
Line 6392: If StrComp(PaymentNotifyPath, thisSitePNP, CompareMethod.Text) = 0 Then
Line 6393: logtofile("Paymenttest", PaymentNotifyPath & " is equal to " & thisSitePNP, False)
Line 6394: originatingSite = "THIS SITE"
Line 6395: Else
Line 6396: logtofile("Paymenttest", PaymentNotifyPath & " is not equal to " & thisSitePNP, False)
Line 6397: originatingSite = PaymentNotifyPath
Line 6398: End If
Line 6399: dbservermanager = Nothing
Line 6400: Return originatingSite
Line 6401: End Function
Line 6402: Function renewsessions() As Boolean
Line 6403: Dim doc As New XmlDocument()
Line 6404:
Line 6405: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 6406: Dim getordersdir As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders")
Line 6407:
Line 6408: Dim saved As Boolean = True
Line 6409: If Right(getordersdir, 1) = "\" Then
Line 6410: getordersdir = Left(getordersdir, getordersdir.Length - 1)
Line 6411: End If
Line 6412:
Line 6413: Dim sessdir As String = getordersdir & "\sessions"
Line 6414: Dim filename As String = sessdir & "\" & Session("properorderid") & ".xml"
Line 6415:
Line 6416:
Line 6417: Dim ordNoFile As String = String.Empty
Line 6418: Dim ordNoContents As String = String.Empty
Line 6419: Dim ordNoContentsLines As Array
Line 6420: 'Dim secfilename As String = sessdir & "\" & File.ReadAllText(ordNoFile) & ".xml"
Line 6421: Dim secfilename As String = String.Empty
Line 6422: If Session("NPCSecureUsed") = True Then
Line 6423: ordNoFile = sessdir & "\OrderNumbers\" & Session("getno") & ".txt"
Line 6424: ordNoContents = File.ReadAllText(ordNoFile)
Line 6425: ordNoContentsLines = ordNoContents.Split(vbCrLf)
Line 6426: secfilename = sessdir & "\" & ordNoContentsLines(0) & ".xml"
Line 6427: logtofile("Paymenttest", "secfilename: " & secfilename, False)
Line 6428: End If
Line 6429:
Line 6430:
Line 6431:
Line 6432: If Session("NPCSecureUsed") = True AndAlso (VerifyFile(filename) = False) And VerifyFile(ordNoFile) Then
Line 6433: If VerifyFile(secfilename) Then
Line 6434: filename = secfilename
Line 6435: End If
Line 6436: End If
Line 6437:
Line 6438: If Not (VerifyFile(filename)) Then
Line 6439: saved = False
Line 6440: Else
Line 6441:
Line 6442: doc.Load(filename)
Line 6443: Dim key As RijndaelManaged = Nothing
Line 6444: Try
Line 6445: key = New RijndaelManaged()
Line 6446: Dim mykey() As Byte = {161, 62, 32, 30, 102, 103, 55, 42, 216, 220, 74, 6, 13, 201, 241, 147}
Line 6447: key.Key = mykey
Line 6448: DecryptXmlElement(doc, key)
Line 6449: Catch e As Exception
Line 6450: saved = False
Line 6451: Finally
Line 6452: ' Clear the key.
Line 6453: If Not (key Is Nothing) Then
Line 6454: key.Clear()
Line 6455: End If
Line 6456: End Try
Line 6457:
Line 6458: Dim sessvals As XmlElement = doc.DocumentElement.SelectSingleNode("SessionVals")
Line 6459: Dim sess As XmlNodeList = sessvals.ChildNodes
Line 6460:
Line 6461: For Each ren As XmlNode In sess
Line 6462: If Not (ren.InnerText Is Nothing) And ren.InnerText <> String.Empty Then
Line 6463: Dim rName As String = ren.Name
Line 6464: rName = unEscapeXml(rName)
Line 6465: rName = rName.Replace("ASIPLUS", "+")
Line 6466: rName = rName.Replace("ASISPACE", " ")
Line 6467: rName = rName.Replace("ASIDOLLARSIGN", "$")
Line 6468: rName = rName.Replace("ASIPIPE", "|")
Line 6469: rName = rName.Replace("ASISLASH", "/")
Line 6470: rName = rName.Replace("ASIBACKSLASH", "\")
Line 6471: rName = rName.Replace("ASIAT", "@")
Line 6472: rName = rName.Replace("ASIONE", "1")
Line 6473: rName = rName.Replace("ASITWO", "2")
Line 6474: rName = rName.Replace("ASITHREE", "3")
Line 6475: rName = rName.Replace("ASIFOUR", "4")
Line 6476: rName = rName.Replace("ASIFIVE", "5")
Line 6477: rName = rName.Replace("ASISIX", "6")
Line 6478: rName = rName.Replace("ASISEVEN", "7")
Line 6479: rName = rName.Replace("ASIEIGHT", "8")
Line 6480: rName = rName.Replace("ASININE", "9")
Line 6481: rName = rName.Replace("ASIZERO", "0")
Line 6482: Select Case ren.Attributes(0).Value
Line 6483: Case "System.String"
Line 6484: Dim c1 As String = ren.InnerXml
Line 6485: Session(rName) = c1
Line 6486: Case "System.Boolean"
Line 6487: Dim c1 As Boolean = ren.InnerXml
Line 6488: Session(rName) = c1
Line 6489: Case "System.Double"
Line 6490: Dim c1 As Double = ren.InnerXml
Line 6491: Session(rName) = c1
Line 6492: Case "System.Int32"
Line 6493: Dim c1 As Int32 = ren.InnerXml
Line 6494: Session(rName) = c1
Line 6495: Case Else
Line 6496:
Line 6497: End Select
Line 6498:
Line 6499: End If
Line 6500: Next
Line 6501: File.Delete(filename)
Line 6502: End If
Line 6503:
Line 6504: Return saved
Line 6505:
Line 6506: End Function
Line 6507: ''NOT BEING USED YET
Line 6508: 'Function escapeTricky(ByVal input As String) As String
Line 6509: ' Dim output As String = input
Line 6510: ' output = output.Replace("+", "ASIPLUS")
Line 6511: ' output = output.Replace(" ", "ASISPACE")
Line 6512: ' output = output.Replace("$", "ASIDOLLARSIGN")
Line 6513: ' output = output.Replace("|", "ASIPIPE")
Line 6514: ' output = output.Replace("/", "ASISLASH")
Line 6515: ' output = output.Replace("\", "ASIBACKSLASH")
Line 6516: ' output = output.Replace("@", "ASIAT")
Line 6517: ' output = output.Replace("1", "ASIONE")
Line 6518: ' output = output.Replace("2", "ASITWO")
Line 6519: ' output = output.Replace("3", "ASITHREE")
Line 6520: ' output = output.Replace("4", "ASIFOUR")
Line 6521: ' output = output.Replace("5", "ASIFIVE")
Line 6522: ' output = output.Replace("6", "ASISIX")
Line 6523: ' output = output.Replace("7", "ASISEVEN")
Line 6524: ' output = output.Replace("8", "ASIEIGHT")
Line 6525: ' output = output.Replace("9", "ASININE")
Line 6526: ' output = output.Replace("0", "ASIZERO")
Line 6527:
Line 6528: ' Return output
Line 6529: 'End Function
Line 6530:
Line 6531: 'Function UnEscapeTricky(ByVal input As String) As String
Line 6532: ' Dim output As String = input
Line 6533: ' output = output.Replace("+", "ASIPLUS")
Line 6534: ' output = output.Replace(" ", "ASISPACE")
Line 6535: ' output = output.Replace("$", "ASIDOLLARSIGN")
Line 6536: ' output = output.Replace("|", "ASIPIPE")
Line 6537: ' output = output.Replace("/", "ASISLASH")
Line 6538: ' output = output.Replace("\", "ASIBACKSLASH")
Line 6539: ' output = output.Replace("@", "ASIAT")
Line 6540: ' output = output.Replace("ASIONE", "1")
Line 6541: ' output = output.Replace("ASITWO", "2")
Line 6542: ' output = output.Replace("ASITHREE", "3")
Line 6543: ' output = output.Replace("ASIFOUR", "4")
Line 6544: ' output = output.Replace("ASIFIVE", "5")
Line 6545: ' output = output.Replace("ASISIX", "6")
Line 6546: ' output = output.Replace("ASISEVEN", "7")
Line 6547: ' output = output.Replace("ASIEIGHT", "8")
Line 6548: ' output = output.Replace("ASININE", "9")
Line 6549: ' output = output.Replace("ASIZERO", "0")
Line 6550:
Line 6551: ' Return output
Line 6552: 'End Function
Line 6553:
Line 6554: Public Function EscapeCXmlPunchOut(ByVal input As String) As String
Line 6555: Dim output As String = String.Empty
Line 6556:
Line 6557: 'Note - return to ground zero for the ampersand, as parts may have already been converted (i.e. ProfitMaker description)
Line 6558: output = input.Replace("&", "&")
Line 6559: output = output.Replace("&", "&amp;")
Line 6560:
Line 6561: output = output.Replace("®", "&#174;")
Line 6562: output = output.Replace("©", "&#169;")
Line 6563: output = output.Replace("""", """)
Line 6564:
Line 6565: Return output
Line 6566: End Function
Line 6567:
Line 6568: Public Function EscapeXml(ByVal input As String) As String
Line 6569: Dim output As String = String.Empty
Line 6570:
Line 6571: output = input.Replace("&", "&")
Line 6572: output = output.Replace("'", "'")
Line 6573: output = output.Replace("""", """)
Line 6574: output = output.Replace(">", ">")
Line 6575: output = output.Replace("<", "<")
Line 6576:
Line 6577: Return output
Line 6578: End Function
Line 6579: Public Function unEscapeXml(ByVal input As String) As String
Line 6580: Dim output As String = String.Empty
Line 6581: output = input.Replace("&", "&")
Line 6582: output = output.Replace("'", "'")
Line 6583: output = output.Replace(""", """")
Line 6584: output = output.Replace(">", ">")
Line 6585: output = output.Replace("<", "<")
Line 6586:
Line 6587: Return output
Line 6588: End Function
Line 6589: Sub EncryptXmlElement(ByVal Doc As XmlDocument, ByVal ElementName As String, ByVal Key As SymmetricAlgorithm)
Line 6590: ' Check the arguments.
Line 6591: If Doc Is Nothing Then
Line 6592: Throw New ArgumentNullException("Doc")
Line 6593: End If
Line 6594: If ElementName Is Nothing Then
Line 6595: Throw New ArgumentNullException("ElementToEncrypt")
Line 6596: End If
Line 6597: If Key Is Nothing Then
Line 6598: Throw New ArgumentNullException("Alg")
Line 6599: End If
Line 6600: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6601: ' Find the specified element in the XmlDocument
Line 6602: ' object and create a new XmlElemnt object.
Line 6603: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6604: Dim elementToEncrypt As XmlElement = Doc.GetElementsByTagName(ElementName)(0)
Line 6605:
Line 6606: ' Throw an XmlException if the element was not found.
Line 6607: If elementToEncrypt Is Nothing Then
Line 6608: Throw New XmlException("The specified element was not found")
Line 6609: End If
Line 6610:
Line 6611: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6612: ' Create a new instance of the EncryptedXml class
Line 6613: ' and use it to encrypt the XmlElement with the
Line 6614: ' symmetric key.
Line 6615: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6616: Dim eXml As New EncryptedXml()
Line 6617:
Line 6618: Dim encryptedElement As Byte() = eXml.EncryptData(elementToEncrypt, Key, False)
Line 6619: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6620: ' Construct an EncryptedData object and populate
Line 6621: ' it with the desired encryption information.
Line 6622: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6623: Dim edElement As New EncryptedData()
Line 6624: edElement.Type = EncryptedXml.XmlEncElementUrl
Line 6625: ' Create an EncryptionMethod element so that the
Line 6626: ' receiver knows which algorithm to use for decryption.
Line 6627: ' Determine what kind of algorithm is being used and
Line 6628: ' supply the appropriate URL to the EncryptionMethod element.
Line 6629: Dim encryptionMethod As String = Nothing
Line 6630:
Line 6631: If TypeOf Key Is TripleDES Then
Line 6632: encryptionMethod = EncryptedXml.XmlEncTripleDESUrl
Line 6633: ElseIf TypeOf Key Is DES Then
Line 6634: encryptionMethod = EncryptedXml.XmlEncDESUrl
Line 6635: End If
Line 6636: If TypeOf Key Is Rijndael Then
Line 6637: Select Case Key.KeySize
Line 6638: Case 128
Line 6639: encryptionMethod = EncryptedXml.XmlEncAES128Url
Line 6640: Case 192
Line 6641: encryptionMethod = EncryptedXml.XmlEncAES192Url
Line 6642: Case 256
Line 6643: encryptionMethod = EncryptedXml.XmlEncAES256Url
Line 6644: End Select
Line 6645: Else
Line 6646: ' Throw an exception if the transform is not in the previous categories
Line 6647: Throw New CryptographicException("The specified algorithm is not supported for XML Encryption.")
Line 6648: End If
Line 6649:
Line 6650: edElement.EncryptionMethod = New EncryptionMethod(encryptionMethod)
Line 6651: ' Add the encrypted element data to the
Line 6652: ' EncryptedData object.
Line 6653: edElement.CipherData.CipherValue = encryptedElement
Line 6654: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6655: ' Replace the element from the original XmlDocument
Line 6656: ' object with the EncryptedData element.
Line 6657: ''''''''''''''''''''''''''''''''''''''''''''''''''
Line 6658: EncryptedXml.ReplaceElement(elementToEncrypt, edElement, False)
Line 6659:
Line 6660: End Sub 'Encrypt
Line 6661:
Line 6662:
Line 6663: Sub DecryptXmlElement(ByVal Doc As XmlDocument, ByVal Alg As SymmetricAlgorithm)
Line 6664: ' Check the arguments.
Line 6665: If Doc Is Nothing Then
Line 6666: Throw New ArgumentNullException("Doc")
Line 6667: End If
Line 6668: If Alg Is Nothing Then
Line 6669: Throw New ArgumentNullException("Alg")
Line 6670: End If
Line 6671: ' Find the EncryptedData element in the XmlDocument.
Line 6672: 'Dim rt As String = Doc.OuterXml.ToString()
Line 6673: Dim encryptedElement As XmlElement = Doc.GetElementsByTagName("EncryptedData")(0)
Line 6674:
Line 6675: ' If the EncryptedData element was not found, throw an exception.
Line 6676: If encryptedElement Is Nothing Then
Line 6677: Throw New XmlException("The EncryptedData element was not found.")
Line 6678: End If
Line 6679:
Line 6680:
Line 6681: ' Create an EncryptedData object and populate it.
Line 6682: Dim edElement As New EncryptedData()
Line 6683: edElement.LoadXml(encryptedElement)
Line 6684: ' Create a new EncryptedXml object.
Line 6685: Dim exml As New EncryptedXml()
Line 6686:
Line 6687:
Line 6688: ' Decrypt the element using the symmetric key.
Line 6689: Dim rgbOutput As Byte() = exml.DecryptData(edElement, Alg)
Line 6690: ' Replace the encryptedData element with the plaintext XML element.
Line 6691: exml.ReplaceData(encryptedElement, rgbOutput)
Line 6692: End Sub
Line 6693:
Line 6694: Function getfinalpdflist() As String()
Line 6695: Dim dbservermanager As Object
Line 6696: dbservermanager = Server.CreateObject(getcomname())
Line 6697: Dim items = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "getorderiteminfo", "ELINITM", Session("orderid"))
Line 6698: dbservermanager = Nothing
Line 6699: Dim orderid As String = Session("properorderid")
Line 6700: Dim pdfnum As Integer = Session("pdfnum")
Line 6701: Dim cartpdflist As String
Line 6702:
Line 6703: 'loop through the items in the cart
Line 6704: For testitems As Integer = LBound(items) To UBound(items) - 1
Line 6705: Dim filecheck As String = removespaces(Session("pdfpath") & "\templates\" & items(testitems, 3) & ".pdf")
Line 6706: Dim xmlfilecheck As String = removespaces(Session("pdfpath") & "\templates\" & items(testitems, 3) & ".xml")
Line 6707: Dim itempers As String = items(testitems, 13)
Line 6708: Dim personalpos As Integer = InStr(itempers, "Personalization:")
Line 6709: Dim pdfpos As Integer = InStr(itempers, "pdf")
Line 6710: 'Dim orderidpos As Integer = InStr(itempers, orderid)
Line 6711: Dim ordnopos As Integer = InStr(itempers, Session("theordno"))
Line 6712: Dim logopos As Integer = InStr(itempers, "Logo")
Line 6713: 'Session("filename" & testitems) = orderid & "_" & items(testitems, 3) & "_" & (testitems) & ".pdf"
Line 6714:
Line 6715: 'make sure this item is the right kind of personalization, and that the template exists
Line 6716: 'If (personalpos > 0 And orderidpos > personalpos And pdfpos > orderidpos) And (System.IO.File.Exists(filecheck) = True) Then
Line 6717:
Line 6718: 'If (personalpos > 0 And ordnopos > personalpos And pdfpos > ordnopos) And (System.IO.File.Exists(filecheck) = True) Then
Line 6719: 'Changing in order to remove the word "Personalization:"
Line 6720: If (pdfpos > ordnopos) And ((System.IO.File.Exists(filecheck) = True) Or ((System.IO.File.Exists(xmlfilecheck) = True))) Then
Line 6721: 'Dim pdfproofname As String = Mid(itempers, 18, pdfpos - 15)
Line 6722: Dim pdfproofname As String = Mid(itempers, ordnopos, (pdfpos - ordnopos + 3))
Line 6723: Dim oldpdfproofname As String = Replace(pdfproofname, Session("theordno"), orderid)
Line 6724:
Line 6725: 'make sure the proof exists
Line 6726: If System.IO.File.Exists(removespaces(Session("pdfpath") & "\proofs\soft\" & oldpdfproofname)) Then
Line 6727: Session("pdfproofname" & testitems) = oldpdfproofname
Line 6728: cartpdflist += oldpdfproofname & ","
Line 6729:
Line 6730: End If
Line 6731: End If
Line 6732: Next
Line 6733: Dim cartarray As Array
Line 6734: If cartpdflist <> String.Empty Then
Line 6735: cartpdflist = Left(cartpdflist, Len(cartpdflist) - 1)
Line 6736: cartarray = Split(cartpdflist, ",")
Line 6737: Session("nopersonalization") = "false"
Line 6738: End If
Line 6739: Return cartarray
Line 6740:
Line 6741: End Function
Line 6742:
Line 6743: Private Sub eraseincomplete()
Line 6744: Dim fs, f, pdffile, prodfile
Line 6745: Dim trunclength As Integer = Len(Session("CreatedPDFs")) - 1
Line 6746: Session("CreatedPDFs") = Left(Session("CreatedPDFs"), trunclength)
Line 6747: Dim incompletepdfs As Array = Split(Session("CreatedPDFs"), ",")
Line 6748:
Line 6749: For incomploop As Integer = LBound(incompletepdfs) To UBound(incompletepdfs)
Line 6750:
Line 6751: pdffile = removespaces(Session("pdfpath") & "\proofs\soft\" & incompletepdfs(incomploop))
Line 6752: prodfile = removespaces(Session("pdfpath") & "\proofs\production\p$" & incompletepdfs(incomploop))
Line 6753:
Line 6754: Try
Line 6755: fs = Server.CreateObject("Scripting.FileSystemObject")
Line 6756: f = fs.GetFile(prodfile)
Line 6757: f.Delete()
Line 6758: f = Nothing
Line 6759: fs = Nothing
Line 6760: Catch err As Exception
Line 6761: End Try
Line 6762:
Line 6763: Try
Line 6764: fs = Server.CreateObject("Scripting.FileSystemObject")
Line 6765: f = fs.GetFile(pdffile)
Line 6766: f.Delete()
Line 6767: f = Nothing
Line 6768: fs = Nothing
Line 6769: Catch err As Exception
Line 6770: End Try
Line 6771:
Line 6772: Next
Line 6773: End Sub
Line 6774:
Line 6775: Function orderinfo(ByVal pg As String, ByVal orderidinput As String) As String
Line 6776:
Line 6777: Dim dbservermanager, aitem, aoutp
Line 6778: Dim icount, ccholdname
Line 6779: Dim porderid, ccmonth, ccyear, pccexp, aBComp, aEmailID, aCustID, aBattn, aSattn, aBaddr1, aBaddr2, aBcity, aBState, aBzip, aBCo, aSaddr1, aSaddr2, aScity, aSstate, aSzip, aShipMth, aCustpo, aOrdno, aScomp, aCCtype, aCCnum, aSpecInst, aSdate, aPhone, aSubTotal, aShipAmt, aGrdTotal, aTaxAmt, aProdImg, aOrdDate, UDF1, UDF2, UDF3, aWebno, aShipped, aSaddr, aBaddr, ordno, datatype, datatype1, terms, slsno, slsperson, status, trackno, orderid, dotdot, aSshipco, inhand, shipcomment1, shipcomment2, itemdesc, aOrderPointsSubTotal As String
Line 6780: Dim aSplitOrderOETaxAmt As String
Line 6781: Dim softwareProductType As String = getSoftwareProductType()
Line 6782: Dim aSPhone As String
Line 6783: Dim dta As New StringBuilder()
Line 6784: ordno = Trim(r1.Request("ordno"))
Line 6785: orderid = Trim(r1.Request("orderid"))
Line 6786: Dim usePromoPayment As Boolean = (InStr(pg, "PromoPayment") <> 0)
Line 6787: Dim cGiftCertMC As String = getxmlval("giftcertmc")
Line 6788: Dim cHideBillingConfirmation As String = getxmlval("hidebillingconfirmation")
Line 6789: Dim cHideQtyShipped As String = getxmlval("hideqtyshipped")
Line 6790: Dim cPointsOn As String = getxmlval("pointson")
Line 6791: Dim cRemovePricing As String = getxmlval("removepricing")
Line 6792: Dim cSingleItemOn As String = getxmlval("singleitemon")
Line 6793: Dim cSVSpecialOn As String = getxmlval("svspecialon")
Line 6794: Dim orderType As String = getxmlval("ordertype")
Line 6795:
Line 6796: Session("splitordergiftcertbalanceamt") = Session("giftcertamt")
Line 6797:
Line 6798: If orderidinput <> "" Then
Line 6799: dotdot = ".."
Line 6800: orderid = orderidinput
Line 6801: End If
Line 6802:
Line 6803: If ordno = "" Then 'i.e. web store Order Entry
Line 6804: If orderid <> "" Then
Line 6805: porderid = orderid
Line 6806: dotdot = ".."
Line 6807: Else
Line 6808: porderid = Session("orderid")
Line 6809: End If
Line 6810:
Line 6811: datatype = "EORDER"
Line 6812: datatype1 = "ELINITM"
Line 6813: Else
Line 6814: 'else if order is already in backend system
Line 6815: porderid = ordno
Line 6816:
Line 6817: If getxmlval("ordertype") = "reg" And softwareProductType <> "ASISB" Then
Line 6818: datatype = "ORDER"
Line 6819: datatype1 = "LNITM"
Line 6820: Else
Line 6821: If softwareProductType <> "ASISB" Then
Line 6822: datatype = "FFORDER"
Line 6823: datatype1 = "FFLINITM"
Line 6824: Else
Line 6825: datatype = "SB"
Line 6826: datatype1 = "SB"
Line 6827: End If
Line 6828: End If
Line 6829: End If
Line 6830:
Line 6831: If datatype = "SB" Then
Line 6832: aoutp = ecomwrapperGetOrderInfo(porderid)
Line 6833: aitem = ecomwrapperGetOrderItemInfo(porderid)
Line 6834: Else
Line 6835: dbservermanager = Server.CreateObject(getcomname())
Line 6836: aoutp = dbservermanager.ecomcall_array(Me.ToString() + " / Function_is_orderinfo", Server.MapPath(dotdot), "GetOrderInfo", datatype, porderid)
Line 6837: aitem = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "GetOrderItemInfo", datatype1, porderid, getxmlval("longcolordesc"))
Line 6838: End If
Line 6839:
Line 6840: ' ORDER DATA
Line 6841: aOrdno = Trim(aoutp(1)) 'Order Number
Line 6842: aOrdDate = Trim(aoutp(2)) 'Order Date
Line 6843: aWebno = Trim(aoutp(3)) 'Web Tracking #
Line 6844: aBComp = Trim(aoutp(6)) 'Bill Company
Line 6845: aBattn = Trim(aoutp(7)) 'Bill Attention
Line 6846: aBaddr1 = Trim(aoutp(8)) 'Bill Address Line 1
Line 6847: aBaddr2 = Trim(aoutp(9)) 'Bill Address Line 2
Line 6848: aBcity = Trim(aoutp(10)) 'Bill City
Line 6849: aBState = Trim(aoutp(11)) 'Bill State
Line 6850: aBzip = Trim(aoutp(12)) 'Bill Zip
Line 6851: aScomp = Trim(aoutp(13)) 'Ship Company
Line 6852: aSattn = Trim(aoutp(14)) 'Ship Attention
Line 6853: aSaddr1 = Trim(aoutp(15)) 'Ship Address Line 1
Line 6854: aSaddr2 = Trim(aoutp(16)) 'Ship Address Line 2
Line 6855: aScity = Trim(aoutp(17)) 'Ship City
Line 6856: aSstate = Trim(aoutp(18)) 'Ship State
Line 6857: aSzip = Trim(aoutp(19)) 'Ship Zip
Line 6858: aPhone = Trim(aoutp(20)) 'Bill Phone
Line 6859: If Session("sphone") <> String.Empty Then
Line 6860: aSPhone = Session("sphone")
Line 6861: ElseIf Session("s_phone") <> String.Empty Then
Line 6862: aSPhone = Session("s_phone") 'Ship Phone
Line 6863: Else
Line 6864: aSPhone = String.Empty
Line 6865: End If
Line 6866: aShipAmt = aoutp(22) 'Shipping amount
Line 6867: aTaxAmt = aoutp(23) 'Tax amount
Line 6868: Session("TaxAmt") = aTaxAmt
Line 6869: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 6870: aSplitOrderOETaxAmt = aoutp(78) 'Tax amount for Split Order OE line items only
Line 6871: Else
Line 6872: aSplitOrderOETaxAmt = "0"
Line 6873: End If
Line 6874:
Line 6875: aShipMth = Trim(aoutp(24)) 'Ship Method ...FedEX, so on
Line 6876: aBCo = Trim(aoutp(65)) 'Bill Country Name
Line 6877: aSshipco = Trim(aoutp(25)) 'Shipto ctry
Line 6878: aCustpo = Trim(aoutp(27)) 'Customer Purchase Order Number
Line 6879: ccmonth = Trim(aoutp(28)) 'CC Month
Line 6880: ccyear = Trim(aoutp(29)) 'CC Year
Line 6881: aCCtype = Trim(aoutp(30)) 'Credit Card Type
Line 6882:
Line 6883: aCCnum = "xxxx-" 'Credit Card Number with xxxx
Line 6884: Dim CustomerVaultID As String = String.Empty
Line 6885: Dim MaskedCCNumber As String = String.Empty
Line 6886: If getxmlval("onlineprocessing") = "PromoPayment" Then
Line 6887: If Session("UsingVaultedCard") = True And Session("custVaultID") <> String.Empty Then
Line 6888: CustomerVaultID = Session("custVaultID")
Line 6889: ElseIf Session("PromoPaymentValid") = True And Session("VaultedCardId") <> String.Empty Then
Line 6890: CustomerVaultID = Session("VaultedCardId")
Line 6891: End If
Line 6892: If Session("MaskedCCNumber") <> String.Empty Then
Line 6893: MaskedCCNumber = Session("MaskedCCNumber")
Line 6894: ElseIf Session("MaskedCCFor" & CustomerVaultID) <> String.Empty Then
Line 6895: MaskedCCNumber = Session("MaskedCCFor" & CustomerVaultID)
Line 6896: End If
Line 6897: End If
Line 6898: If MaskedCCNumber <> String.Empty Then
Line 6899: aCCnum = MaskedCCNumber
Line 6900: ElseIf ordno = "" And dotdot = "" Then
Line 6901: aCCnum += Session("lastfour")
Line 6902: ElseIf aoutp(31) <> String.Empty Then
Line 6903: aCCnum += Right(aoutp(31), 4)
Line 6904: End If
Line 6905:
Line 6906: ccholdname = Trim(aoutp(32)) 'Card Holder Name
Line 6907: aGrdTotal = Trim(aoutp(33)) 'Grand Total
Line 6908:
Line 6909: If softwareProductType = "ASISB" And cPointsOn = "points" Then
Line 6910: aOrderPointsSubTotal = aoutp(77)
Line 6911: aGrdTotal = aOrderPointsSubTotal
Line 6912: End If
Line 6913:
Line 6914: aCustID = Trim(aoutp(34)) 'Customer ID Number
Line 6915: UDF1 = Trim(aoutp(35)) 'User Defined 1
Line 6916: UDF2 = Trim(aoutp(36)) 'User Defined 2
Line 6917: UDF3 = Trim(aoutp(37)) 'User Defined 3
Line 6918: aEmailID = Trim(aoutp(41)) 'Email Address
Line 6919: aSdate = aoutp(42) 'Shipping Date
Line 6920: aSpecInst = Trim(aoutp(43)) 'Special Instructions
Line 6921: terms = Trim(aoutp(44)) 'Terms
Line 6922: slsno = Trim(aoutp(45)) 'Salesperson #
Line 6923: slsperson = Trim(aoutp(46)) 'Salesperson
Line 6924: status = Trim(aoutp(47)) 'Status
Line 6925: trackno = gettrackno(Trim(aoutp(48))) 'Track No
Line 6926: inhand = aoutp(52) 'In Hand Date
Line 6927: shipcomment1 = aoutp(53) 'Shipping Comment 1
Line 6928: shipcomment2 = aoutp(54) 'Shipping Comment 2
Line 6929: If aBCo <> "" Then
Line 6930: aBCo = "<br />" & aBCo
Line 6931: End If
Line 6932:
Line 6933: If aSshipco <> "" Then
Line 6934: aSshipco = "<br />" & aSshipco
Line 6935: End If
Line 6936:
Line 6937: If aBaddr2 = "" Then
Line 6938: aBaddr = aBaddr1
Line 6939: Else
Line 6940: aBaddr = aBaddr1 & "<br />" & aBaddr2
Line 6941: End If
Line 6942:
Line 6943: If aSaddr2 = String.Empty And getxmlval("hideshippingaddress1") <> "Y" Then
Line 6944: aSaddr = aSaddr1
Line 6945: ElseIf (aSaddr1 = String.Empty Or getxmlval("hideshippingaddress1") = "Y") And aSaddr2 <> String.Empty And getxmlval("hideshippingaddress2") <> "Y" Then
Line 6946: aSaddr = aSaddr2
Line 6947: ElseIf getxmlval("hideshippingaddress1") = "Y" And getxmlval("hideshippingaddress2") = "Y" Then
Line 6948: aSaddr = String.Empty
Line 6949: Else
Line 6950: aSaddr = aSaddr1 & "<br />" & aSaddr2
Line 6951: End If
Line 6952:
Line 6953: If Len(ccmonth) < 2 Then
Line 6954: ccmonth = "0" & ccmonth
Line 6955: End If
Line 6956:
Line 6957: If Len(ccyear) < 2 Then
Line 6958: ccyear = "0" & ccyear
Line 6959: End If
Line 6960:
Line 6961: pccexp = ccmonth & "/" & ccyear 'CC Expiration
Line 6962:
Line 6963: If InStr(pg, "email") <> 0 Then
Line 6964: dta.Append("<html>" & vbCrLf)
Line 6965: dta.Append("<head>" & vbCrLf)
Line 6966: dta.Append("<title>" & vbCrLf)
Line 6967: dta.Append("</title>" & vbCrLf)
Line 6968: dta.Append("<style type=""text/css"">" & vbCrLf)
Line 6969: dta.Append("BODY, TR, TD { font-family: arial; font-size: 12; color: #000000; }" & vbCrLf)
Line 6970: dta.Append(".tblwhite { color: #000000; }" & vbCrLf)
Line 6971: dta.Append("</style>" & vbCrLf)
Line 6972: dta.Append("</head>" & vbCrLf)
Line 6973: dta.Append("<body>" & vbCrLf)
Line 6974:
Line 6975: ' MSG Opening
Line 6976: If Trim(getxmlval("body")) <> "" And pg = "email" Then
Line 6977: dta.Append(getxmlval("body") & "<br /><br />" & vbCrLf)
Line 6978: End If
Line 6979: End If
Line 6980:
Line 6981: If usePromoPayment Then
Line 6982: dta.Append("<style type=""text/css"" > table {-moz-border-radius: 15px; border-radius: 15px;} </style>")
Line 6983: dta.Append("<table style=""border-radius: 25px; width:100%; background-color:#FFFFF6; padding:5px; border:1px solid black;"" cellspacing=""0"" cellpadding=""5"" >" & vbCrLf)
Line 6984: 'dta.Append("<tr><td></td></tr>")
Line 6985: Else
Line 6986: dta.Append("<table border=""1"" cellspacing=""0"" cellpadding=""5"" width=""100%"" bgcolor=""#FFFFFF"">" & vbCrLf)
Line 6987: dta.Append("<tr>" & vbCrLf)
Line 6988: dta.Append("<td colspan=""8"" align=""right"" class=""tblwhite"">" & vbCrLf)
Line 6989:
Line 6990: If getxmlval("companylogo") <> "" Then
Line 6991: dta.Append("<img src=""" & getxmlval("companylogo") & """ align=""left"">" & vbCrLf)
Line 6992: End If
Line 6993:
Line 6994: dta.Append(getxmlval("compname") & "<br />" & getxmlval("compaddr") & "<br />" & getxmlval("compphone") & vbCrLf)
Line 6995: dta.Append("</td>" & vbCrLf)
Line 6996: dta.Append("</tr>" & vbCrLf)
Line 6997: dta.Append("<tr bgcolor=""#EFEFEF"">" & vbCrLf)
Line 6998: dta.Append("<td colspan=""8"" align=""center"" class=""tblwhite"">" & vbCrLf)
Line 6999: dta.Append("<b>Order Information</b><br />" & vbCrLf)
Line 7000: dta.Append("</td>" & vbCrLf)
Line 7001: dta.Append("</tr>" & vbCrLf)
Line 7002: dta.Append("<tr>" & vbCrLf)
Line 7003: dta.Append("<td colspan=""8"" align=""center"" class=""tblwhite"">" & vbCrLf)
Line 7004:
Line 7005: dta.Append("<table width=""100%"" align=""center"">" & vbCrLf)
Line 7006: dta.Append("<tr>" & vbCrLf)
Line 7007:
Line 7008: If IsDate(aOrdDate) Then
Line 7009: dta.Append("<td>" & vbCrLf)
Line 7010: dta.Append("<b>Order Date:</b> " & aOrdDate & vbCrLf)
Line 7011: dta.Append("</td>" & vbCrLf)
Line 7012: End If
Line 7013:
Line 7014: If IsDate(aSdate) Then
Line 7015: dta.Append("<td>" & vbCrLf)
Line 7016: dta.Append("<b>Ship Date:</b> " & aSdate & vbCrLf)
Line 7017: dta.Append("</td>" & vbCrLf)
Line 7018: End If
Line 7019:
Line 7020: If IsDate(inhand) Then
Line 7021: dta.Append("<td>" & vbCrLf)
Line 7022: dta.Append("<b>" & getxmlval("shipinhandlbl") & ":</b> " & inhand & vbCrLf)
Line 7023: dta.Append("</td>" & vbCrLf)
Line 7024: End If
Line 7025:
Line 7026: If r1.Request("p") <> "verifyorder" Then
Line 7027: dta.Append("<td>" & vbCrLf)
Line 7028: dta.Append("<b>Order #:</b> " & vbCrLf)
Line 7029:
Line 7030: If ordno = "" Then
Line 7031: dta.Append(aOrdno & vbCrLf)
Line 7032: Else
Line 7033: dta.Append(aWebno & vbCrLf)
Line 7034: End If
Line 7035:
Line 7036: dta.Append("</td>" & vbCrLf)
Line 7037: End If
Line 7038:
Line 7039: Session("ordno") = aOrdno
Line 7040: If Left(aWebno, 2) <> "::" Then
Line 7041: Session("webno") = aWebno
Line 7042: Else
Line 7043: Session("webno") = Right(aWebno, (Len(aWebno) - 2))
Line 7044: End If
Line 7045:
Line 7046: If aCustpo <> "" And (aCustpo <> aWebno) Then
Line 7047: dta.Append("<td>" & vbCrLf)
Line 7048: dta.Append("<b>" & getxmlval("polabel") & ":</b> " & aCustpo & vbCrLf)
Line 7049: dta.Append("</td>" & vbCrLf)
Line 7050: End If
Line 7051:
Line 7052: If ordno <> "" Then
Line 7053: dta.Append("<td>" & vbCrLf)
Line 7054: dta.Append("<b>Job #:</b> " & aOrdno & vbCrLf)
Line 7055: dta.Append("</td>" & vbCrLf)
Line 7056: End If
Line 7057:
Line 7058: dta.Append("</tr>" & vbCrLf)
Line 7059: dta.Append("</table>" & vbCrLf)
Line 7060:
Line 7061: dta.Append("</td>" & vbCrLf)
Line 7062: dta.Append("</tr>" & vbCrLf)
Line 7063: End If
Line 7064: dta.Append("<tr bgcolor=""#EFEFEF"">" & vbCrLf)
Line 7065: If usePromoPayment Then
Line 7066: dta.Append("<td colspan=""8""><table style=""width:100%;""><tr>")
Line 7067: End If
Line 7068: 'check to remove pricing from verifyorder, processorder, and emails except email to supervisor
Line 7069: Dim billtospan As String = "4"
Line 7070: Dim shiptospan As String = "4"
Line 7071: Dim showbillto As Boolean = False
Line 7072: Dim showshipto As Boolean = False
Line 7073: If (cRemovePricing <> "Y") Or (pg = "appemail") Then
Line 7074: If Session("ShippingInfoAllHidden") Then
Line 7075: billtospan = "8"
Line 7076: End If
Line 7077: If cSingleItemOn <> "Y" And cHideBillingConfirmation <> "Y" Then
Line 7078: showbillto = True
Line 7079: End If
Line 7080: If Not Session("ShippingInfoAllHidden") Then
Line 7081: If cSingleItemOn <> "Y" And cHideBillingConfirmation <> "Y" Then
Line 7082: shiptospan = "4"
Line 7083: Else
Line 7084: shiptospan = "8"
Line 7085: End If
Line 7086: showshipto = True
Line 7087: End If
Line 7088:
Line 7089: Else
Line 7090: If cSingleItemOn <> "Y" And cHideBillingConfirmation <> "Y" And Not Session("ShippingInfoAllHidden") Then
Line 7091: billtospan = "3"
Line 7092: shiptospan = "3"
Line 7093: showbillto = True
Line 7094: showshipto = True
Line 7095: ElseIf Not Session("ShippingInfoAllHidden") Then
Line 7096: shiptospan = "8"
Line 7097: showshipto = True
Line 7098: ElseIf Session("ShippingInfoAllHidden") And (cHideBillingConfirmation = "Y" Or cSingleItemOn = "Y") Then
Line 7099: showbillto = False
Line 7100: showshipto = False
Line 7101: ElseIf Session("ShippingInfoAllHidden") Then
Line 7102: billtospan = "8"
Line 7103: showbillto = True
Line 7104: showshipto = False
Line 7105: End If
Line 7106:
Line 7107: End If
Line 7108:
Line 7109: If showbillto Then
Line 7110: dta.Append("<td align=""center"" colspan=""" & billtospan & """ class=""tblwhite""><b>Bill to</b></td>" & vbCrLf)
Line 7111: End If
Line 7112: If showshipto Then
Line 7113: dta.Append("<td align=""center"" colspan=""" & shiptospan & """ class=""tblwhite""><b>Ship to</b></td>" & vbCrLf)
Line 7114: End If
Line 7115: 'end remove pricing
Line 7116:
Line 7117: dta.Append("</tr>" & vbCrLf)
Line 7118:
Line 7119: dta.Append("<tr valign=""top"">" & vbCrLf)
Line 7120:
Line 7121: 'section is skipped if using single item site
Line 7122: If cSingleItemOn <> "Y" And cHideBillingConfirmation <> "Y" Then
Line 7123:
Line 7124: 'check to remove pricing from verifyorder, processorder, and emails except email to supervisor
Line 7125: If (cRemovePricing <> "Y") Or (pg = "appemail") Then
Line 7126: dta.Append("<td colspan=""" & billtospan & """ class=""tblwhite"">" & vbCrLf)
Line 7127: Else
Line 7128: 'dta.Append("<td colspan=""" & (CInt(billtospan) - 1).ToString() & """ class=""tblwhite"">" & vbCrLf)
Line 7129: dta.Append("<td colspan=""" & billtospan & """ class=""tblwhite"">" & vbCrLf)
Line 7130: End If
Line 7131: 'end remove pricing
Line 7132:
Line 7133: dta.Append(aBComp & "<br />" & vbCrLf)
Line 7134: dta.Append(aBattn & "<br />" & vbCrLf)
Line 7135: dta.Append(aBaddr & "<br />" & vbCrLf)
Line 7136: dta.Append(aBcity & ", " & aBState & " " & aBzip & aBCo & "<br /><br />" & vbCrLf)
Line 7137: dta.Append(aPhone & "<br />" & vbCrLf)
Line 7138: If getxmlval("emailconfirm") = "Y" Then
Line 7139: dta.Append("Email: " & aEmailID & vbCrLf)
Line 7140: End If
Line 7141: dta.Append("<br /><br />" & vbCrLf)
Line 7142:
Line 7143: If (pg <> String.Empty) And cSVSpecialOn = "Y" AndAlso getxmlval("svnummessageloc") = "B" And getxmlval("svnummessagetxt") <> String.Empty Then
Line 7144: dta.Append("<table style=""max-width:250px; width:250px;""><tr><td>")
Line 7145: dta.Append(SvNumMessageTxt(orderid))
Line 7146: dta.Append("</td></tr></table>")
Line 7147: dta.Append("<br /><br />" & vbCrLf)
Line 7148: End If
Line 7149: 'probably need to reduce a colspan above here
Line 7150: dta.Append("</td>" & vbCrLf)
Line 7151: If Not Session("ShippingInfoAllHidden") Then
Line 7152: dta.Append("<td colspan=""4"" class=""tblwhite"">" & vbCrLf)
Line 7153: End If
Line 7154: 'end of section skipped if using single item site
Line 7155: ElseIf Not Session("ShippingInfoAllHidden") Then
Line 7156: dta.Append("<td colspan=""8"" class=""tblwhite"">" & vbCrLf)
Line 7157: End If
Line 7158:
Line 7159: If Not Session("ShippingInfoAllHidden") Then
Line 7160: If getxmlval("hideshippingcompanyname") <> "Y" Then
Line 7161: dta.Append(aScomp & vbCrLf)
Line 7162: dta.Append("<br />" & vbCrLf)
Line 7163: End If
Line 7164: If getxmlval("hideshippingcontactname") <> "Y" Then
Line 7165: dta.Append(aSattn & vbCrLf)
Line 7166: dta.Append("<br />" & vbCrLf)
Line 7167: End If
Line 7168:
Line 7169: If aSaddr <> String.Empty Then
Line 7170: dta.Append(aSaddr & vbCrLf)
Line 7171: dta.Append("<br />" & vbCrLf)
Line 7172: End If
Line 7173: If getxmlval("hideshippingcity") <> "Y" Then
Line 7174: dta.Append(aScity)
Line 7175: End If
Line 7176:
Line 7177: If (aScity <> String.Empty And aSstate <> String.Empty) And (getxmlval("hideshippingcity") <> "Y" And getxmlval("hideshippingstate") <> "Y") Then
Line 7178: dta.Append(", ")
Line 7179: End If
Line 7180: If getxmlval("hideshippingstate") <> "Y" And aSstate <> String.Empty Then
Line 7181: dta.Append(aSstate & " ")
Line 7182: End If
Line 7183: If getxmlval("hideshippingzip") <> "Y" Then
Line 7184: dta.Append(aSzip)
Line 7185: End If
Line 7186: If getxmlval("hideshippingcountry") <> "Y" And aSshipco <> String.Empty Then
Line 7187: dta.Append(aSshipco & "<br /><br />" & vbCrLf)
Line 7188: End If
Line 7189: If getxmlval("hideshippingphone") <> "Y" Then
Line 7190: dta.Append(aSPhone & "<br />" & vbCrLf)
Line 7191: End If
Line 7192:
Line 7193: dta.Append("</td>" & vbCrLf)
Line 7194: End If
Line 7195:
Line 7196: dta.Append("</tr>" & vbCrLf)
Line 7197:
Line 7198: If usePromoPayment Then
Line 7199: dta.Append("</table></td></tr>")
Line 7200: End If
Line 7201:
Line 7202: Dim orderInfoLineItemHeaderInfo As String
Line 7203: Dim orderInfoLineItemsInfo As String
Line 7204: Dim orderInfoSummaryRowInfo As String
Line 7205: Dim thisSplitOrderHasFFLineItem As String = "N"
Line 7206: Dim thisSplitOrderHasOELineItem As String = "N"
Line 7207: Dim aShippingData() As Object = {aShipMth, trackno, shipcomment1, shipcomment2, orderid}
Line 7208: Dim aPaymentData() As Object = {aCCnum, aCCtype, ccholdname, pccexp, aCustpo, aWebno, UDF1, UDF2, UDF3}
Line 7209:
Line 7210: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7211: Dim aLineItemTypes As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "GetSplitOrderLineItemTypes", porderid, Trim(getxmlval("splitorderfflineitemcode")), Trim(getxmlval("splitorderoelineitemcode")))
Line 7212: thisSplitOrderHasFFLineItem = aLineItemTypes(1)
Line 7213: thisSplitOrderHasOELineItem = aLineItemTypes(2)
Line 7214: End If
Line 7215:
Line 7216: If (orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls") And thisSplitOrderHasFFLineItem = "Y" Then
Line 7217: Dim splitOrderItemTypeHeader As String
Line 7218: splitOrderItemTypeHeader = orderInfoSplitOrderItemTypeHeader("Standard Items")
Line 7219: dta.Append(splitOrderItemTypeHeader)
Line 7220:
Line 7221: orderInfoLineItemHeaderInfo = orderInfoLineItemHeader(pg)
Line 7222: dta.Append(orderInfoLineItemHeaderInfo)
Line 7223:
Line 7224: orderInfoLineItemsInfo = orderInfoLineItems("FF", aitem, orderid, pg, datatype1)
Line 7225: dta.Append(orderInfoLineItemsInfo)
Line 7226:
Line 7227: orderInfoSummaryRowInfo = orderInfoSummaryRow("FF", aitem, pg, datatype, aShipAmt, aGrdTotal, aOrderPointsSubTotal, aTaxAmt, aSplitOrderOETaxAmt, status, ordno, aShippingData, aPaymentData)
Line 7228: dta.Append(orderInfoSummaryRowInfo)
Line 7229: End If
Line 7230:
Line 7231: If (orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls") And thisSplitOrderHasOELineItem = "Y" Then
Line 7232: Dim splitOrderItemTypeHeader As String
Line 7233: splitOrderItemTypeHeader = orderInfoSplitOrderItemTypeHeader("Special Order Items")
Line 7234: dta.Append(splitOrderItemTypeHeader)
Line 7235:
Line 7236: orderInfoLineItemHeaderInfo = orderInfoLineItemHeader(pg)
Line 7237: dta.Append(orderInfoLineItemHeaderInfo)
Line 7238:
Line 7239: orderInfoLineItemsInfo = orderInfoLineItems("OE", aitem, orderid, pg, datatype1)
Line 7240: dta.Append(orderInfoLineItemsInfo)
Line 7241:
Line 7242: orderInfoSummaryRowInfo = orderInfoSummaryRow("OE", aitem, pg, datatype, aShipAmt, aGrdTotal, aOrderPointsSubTotal, aTaxAmt, aSplitOrderOETaxAmt, status, ordno, aShippingData, aPaymentData)
Line 7243: dta.Append(orderInfoSummaryRowInfo)
Line 7244: End If
Line 7245:
Line 7246: If orderType <> "splitorderxmls" And orderType <> "aribasplitorderxmls" Then
Line 7247: orderInfoLineItemHeaderInfo = orderInfoLineItemHeader(pg)
Line 7248: dta.Append(orderInfoLineItemHeaderInfo)
Line 7249:
Line 7250: orderInfoLineItemsInfo = orderInfoLineItems("ALL", aitem, orderid, pg, datatype1)
Line 7251: dta.Append(orderInfoLineItemsInfo)
Line 7252:
Line 7253: orderInfoSummaryRowInfo = orderInfoSummaryRow("ALL", aitem, pg, datatype, aShipAmt, aGrdTotal, aOrderPointsSubTotal, aTaxAmt, aSplitOrderOETaxAmt, status, ordno, aShippingData, aPaymentData)
Line 7254: dta.Append(orderInfoSummaryRowInfo)
Line 7255: End If
Line 7256:
Line 7257: If (orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls") And (thisSplitOrderHasFFLineItem = "Y" Or thisSplitOrderHasOELineItem = "Y") Then
Line 7258: Dim orderInfoSplitOrderGrandTotalRowInfo As String
Line 7259: orderInfoSplitOrderGrandTotalRowInfo = orderInfoSplitOrderGrandTotalRow(pg, aGrdTotal, aCCnum, aCCtype, ccholdname, ordno, pccexp, aCustpo, aWebno, UDF1, UDF2, UDF3)
Line 7260: dta.Append(orderInfoSplitOrderGrandTotalRowInfo)
Line 7261: End If
Line 7262:
Line 7263: aSpecInst = orderInfoSpecialInstructions(aSpecInst, UDF1, UDF2, UDF3)
Line 7264: dta.Append(aSpecInst)
Line 7265:
Line 7266: dta.Append("</table>" & vbCrLf)
Line 7267: dta.Append("<br />" & vbCrLf)
Line 7268:
Line 7269: dta.Append(getxmlval("confirmclosing") & "<br />")
Line 7270: If InStr(pg, "email") <> 0 Then
Line 7271: If Trim(getxmlval("confirmationending")) <> String.Empty Then
Line 7272: Dim confirmEnd As String = ""
Line 7273: confirmEnd = orderInfoConfirmationEnding(orderid, dotdot, aSubTotal)
Line 7274: dta.Append(confirmEnd & vbCrLf)
Line 7275: End If
Line 7276: dta.Append("</body>" & vbCrLf)
Line 7277: dta.Append("</html>" & vbCrLf)
Line 7278: End If
Line 7279:
Line 7280: dbservermanager = Nothing
Line 7281:
Line 7282: Return dta.ToString()
Line 7283:
Line 7284: 'EOF Function orderinfo
Line 7285: End Function
Line 7286:
Line 7287: Function orderInfoSplitOrderItemTypeHeader(itemTypeDescription As String) As String
Line 7288: Dim dta As New StringBuilder()
Line 7289:
Line 7290: dta.Append("<tr bgcolor=""#EFEFEF"">" & vbCrLf)
Line 7291: dta.Append("<td colspan=""8"" align=""CENTER"" class=""tblwhite""><b>" & itemTypeDescription & "</b></td>" & vbCrLf)
Line 7292: dta.Append("</tr>" & vbCrLf)
Line 7293:
Line 7294: Return dta.ToString()
Line 7295: End Function
Line 7296:
Line 7297: Function orderInfoLineItemHeader(pg As String) As String
Line 7298: Dim dta As New StringBuilder()
Line 7299: Dim cHideQtyShipped As String = getxmlval("hideqtyshipped")
Line 7300: Dim cRemovePricing As String = getxmlval("removepricing")
Line 7301: Dim cSingleItemOn As String = getxmlval("singleitemon")
Line 7302: Dim usePromoPayment As Boolean = (InStr(pg, "PromoPayment") <> 0)
Line 7303:
Line 7304: dta.Append("<tr bgcolor=""#EFEFEF"">" & vbCrLf)
Line 7305: If usePromoPayment = False Then
Line 7306: dta.Append("<td colspan=""2"" align=""CENTER"" class=""tblwhite""><b>Item #</b></td>" & vbCrLf)
Line 7307: dta.Append("<td align=""CENTER"" class=""tblwhite""><b>Description</b></td>" & vbCrLf)
Line 7308: Else
Line 7309: dta.Append("<td class=""tblwhite"" style=""width:270px;""><b>Product</b></td>" & vbCrLf)
Line 7310: End If
Line 7311:
Line 7312: If cSingleItemOn = "Y" Then
Line 7313: dta.Append("<td colspan=""4"" align=""CENTER"" class=""tblwhite""><b>Qty Ordered</b></td>" & vbCrLf)
Line 7314: End If
Line 7315:
Line 7316: If cSingleItemOn <> "Y" Then
Line 7317: If usePromoPayment = False Then
Line 7318: dta.Append("<td align=""CENTER"" class=""tblwhite""><b>Qty Ordered</b></td>" & vbCrLf)
Line 7319: Else
Line 7320: dta.Append("<td align=""CENTER"" class=""tblwhite""><b>Qty</b></td>" & vbCrLf)
Line 7321: End If
Line 7322:
Line 7323: If cHideQtyShipped <> "Y" And usePromoPayment = False Then
Line 7324: dta.Append("<td align=""CENTER"" class=""tblwhite""><b>Qty Shipped</b></td>" & vbCrLf)
Line 7325: End If
Line 7326:
Line 7327: If usePromoPayment = False Then
Line 7328: dta.Append("<td align=""CENTER"" class=""tblwhite""><b>Per</b></td>" & vbCrLf)
Line 7329: End If
Line 7330:
Line 7331: 'remove pricing from verifyorder, processorder, and emails except email to supervisor
Line 7332: If (cRemovePricing <> "Y") Or (pg = "appemail") Then
Line 7333: dta.Append("<td align=""CENTER"" class=""tblwhite""><b>Unit Price</b></td>" & vbCrLf)
Line 7334: dta.Append("<td align=""CENTER"" class=""tblwhite""><b>Total Price</b></td>" & vbCrLf)
Line 7335: ElseIf pg = "PromoPayment" Then
Line 7336: dta.Append("<td class=""tblwhite""></td></td>")
Line 7337: End If
Line 7338: End If
Line 7339:
Line 7340: dta.Append("</tr>" & vbCrLf)
Line 7341:
Line 7342: Return dta.ToString()
Line 7343: End Function
Line 7344:
Line 7345: Function orderInfoLineItems(lineItemType As String, aitem As Array, orderid As String, pg As String, datatype1 As String) As String
Line 7346: Dim dta As New StringBuilder()
Line 7347: Dim aItemID, aItemSub As String
Line 7348: Dim aDesc, aDesc2 As String
Line 7349: Dim aQty, aPrice, aExtnd, aPer, aPersonalization, aProdImg, aShipped As String
Line 7350: Dim cDutyMC As String = getxmlval("dutymc")
Line 7351: Dim cGiftCertMC As String = getxmlval("giftcertmc")
Line 7352: Dim cGivexMCItem As String = getxmlval("givexmcitem")
Line 7353: Dim cHideQtyShipped As String = getxmlval("hideqtyshipped")
Line 7354: Dim cPointsOn As String = getxmlval("pointson")
Line 7355: Dim cItemImg_thumb As String = getxmlval("itemimg_thumb")
Line 7356: Dim cMissingThumbnailItemImageDefault As String = getxmlval("missingthumbnailitemimagedefault")
Line 7357: Dim cPointBuyBack As String = getxmlval("pointbuyback")
Line 7358: Dim cPointItemNo As String = getxmlval("pointitemno")
Line 7359: Dim cRemovePricing As String = getxmlval("removepricing")
Line 7360: Dim cResShipMC As String = getxmlval("resshipmc")
Line 7361: Dim cSingleItemOn As String = getxmlval("singleitemon")
Line 7362: Dim itemdesc As String
Line 7363: Dim orderType As String = getxmlval("ordertype")
Line 7364: Dim processLine As Boolean
Line 7365: Dim softwareProductType As String = getSoftwareProductType()
Line 7366: Dim splitOrderLineItemType As String = ""
Line 7367: Dim splitOrderFFLineItemCode As String = ""
Line 7368: Dim splitOrderOELineItemCode As String = ""
Line 7369: Dim iSplitOrderFFSubTotal As Double
Line 7370: Dim iSplitOrderOESubTotal As Double
Line 7371: Dim usePromoPayment As Boolean = (InStr(pg, "PromoPayment") <> 0)
Line 7372:
Line 7373: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7374: splitOrderFFLineItemCode = Trim(getxmlval("splitorderfflineitemcode"))
Line 7375: splitOrderOELineItemCode = Trim(getxmlval("splitorderoelineitemcode"))
Line 7376: Session("splitorderffsubtotal") = "0"
Line 7377: Session("splitorderoesubtotal") = "0"
Line 7378: End If
Line 7379:
Line 7380: ' LINE DATA
Line 7381: For icount = 1 To UBound(aitem) - 1
Line 7382: processLine = True
Line 7383:
Line 7384: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7385: splitOrderLineItemType = Trim(aitem(icount, 30))
Line 7386:
Line 7387: If lineItemType = "FF" Then
Line 7388: If splitOrderLineItemType <> splitOrderFFLineItemCode Then
Line 7389: processLine = False
Line 7390: End If
Line 7391: ElseIf lineItemType = "OE" Then
Line 7392: If splitOrderLineItemType <> splitOrderOELineItemCode Then
Line 7393: processLine = False
Line 7394: End If
Line 7395: End If
Line 7396: End If
Line 7397:
Line 7398: If processLine Then
Line 7399: aItemID = Trim(aitem(icount, 3))
Line 7400: aItemSub = Trim(aitem(icount, 4))
Line 7401: aDesc = Trim(aitem(icount, 6))
Line 7402: aDesc2 = Trim(aitem(icount, 7))
Line 7403:
Line 7404: If aDesc2 <> "" Then
Line 7405: aDesc = aDesc & "<br />" & aDesc2
Line 7406: End If
Line 7407:
Line 7408: aQty = Trim(aitem(icount, 9))
Line 7409:
Line 7410: If softwareProductType = "ASISB" And cPointsOn = "points" Then
Line 7411: aPrice = showValues(aitem(icount, 15)) 'Points per item
Line 7412: aExtnd = aPrice * aQty
Line 7413: Else
Line 7414: aPrice = aitem(icount, 10) 'Price per item (Discount price, if applicable, or item price)
Line 7415: aExtnd = aitem(icount, 11) 'Extended price ((Qty*Price) / Per) Note - this Price is same as above aPrice)
Line 7416: End If
Line 7417:
Line 7418: aPer = Trim(aitem(icount, 12)) 'item Per
Line 7419: aPersonalization = Trim(aitem(icount, 13))
Line 7420: If InStr(aPersonalization, vbCrLf) <> 0 Then
Line 7421: aPersonalization = Replace(aPersonalization, vbCrLf, "<br />")
Line 7422: End If
Line 7423:
Line 7424: Dim pdfpos As Integer = InStr(aPersonalization, "pdf")
Line 7425: Dim orderidpos As Integer = InStr(aPersonalization, Session("properorderid"))
Line 7426: Dim ordnopos As Integer = InStr(aPersonalization, Session("ordno"))
Line 7427:
Line 7428: If aPersonalization = setupitemtext() Or (getxmlval("pdfpershidden") = "Y" And (orderidpos = 18 Or ordnopos = 18) And pdfpos > 18) Then
Line 7429: aPersonalization = ""
Line 7430: End If
Line 7431:
Line 7432: Dim xmlpath As String = Session("pdfpath") & "\proofs\" & Session("properorderid") & ".xml"
Line 7433:
Line 7434: aProdImg = getCorrectItemImages(r1.Request("p")) & Trim(aitem(icount, 14)) & cItemImg_thumb
Line 7435:
Line 7436: If orderid <> "" Then
Line 7437: aProdImg = "../" & aProdImg
Line 7438: End If
Line 7439:
Line 7440: If checkURL(aProdImg) = False And cMissingThumbnailItemImageDefault <> String.Empty Then
Line 7441: aProdImg = cMissingThumbnailItemImageDefault
Line 7442: End If
Line 7443:
Line 7444: If datatype1 = "SB" Then
Line 7445: aShipped = Trim(aitem(icount, 30))
Line 7446: ElseIf datatype1 <> "ELINITM" Then
Line 7447: aShipped = Trim(aitem(icount, 15))
Line 7448: Else
Line 7449: aShipped = "0"
Line 7450: End If
Line 7451:
Line 7452: itemdesc = "<br />" & aitem(icount, 26) & " " & aitem(icount, 27)
Line 7453:
Line 7454: If Session("goyopoints") And UCase(aItemID) = UCase(Trim(cPointItemNo)) Then
Line 7455: 'Note - this is now calculated in getLineItemExtendedPrice when applicable
Line 7456: ElseIf UCase(aItemID) = UCase(Trim(cPointBuyBack)) Then
Line 7457:
Line 7458: ElseIf UCase(aItemID) = "SH" Then
Line 7459: 'shfreight = aExtnd 'Note - this is now calculated in getLineItemExtendedPrice when applicable
Line 7460: ElseIf UCase(aItemID) = cResShipMC And cResShipMC <> String.Empty Then
Line 7461: 'resshipmc = aExtnd 'Note - this is now calculated in getLineItemExtendedPrice when applicable
Line 7462: ElseIf UCase(aItemID) <> UCase(cGiftCertMC) And UCase(aItemID) <> UCase(cGivexMCItem) And UCase(aItemID) <> UCase(cDutyMC) And (Session("zero" & aItemID) <> True) Then
Line 7463: dta.Append("<tr valign=""middle"">" & vbCrLf)
Line 7464:
Line 7465: If usePromoPayment = False Then
Line 7466: dta.Append("<td colspan=""2"">" & vbCrLf)
Line 7467: dta.Append("<table border=""0"" width=""100%"" cellspacing=""2"" cellpadding=""2"">" & vbCrLf)
Line 7468: dta.Append("<tr align=""center"">" & vbCrLf)
Line 7469: dta.Append("<td class=""tblwhite"">" & vbCrLf)
Line 7470:
Line 7471: ' SHOW/HIDE ITEM IMAGE
Line 7472: If InStr(pg, "email") = 0 And usePromoPayment = False Then
Line 7473: dta.Append("<img src=""" & aProdImg & """ width=""30"" border=""0""><br />")
Line 7474: End If
Line 7475:
Line 7476: dta.Append(aItemID & IIf(softwareProductType = "ASISB", "", aItemSub) & itemdesc & vbCrLf)
Line 7477: dta.Append("</td>" & vbCrLf)
Line 7478: dta.Append("</tr>" & vbCrLf)
Line 7479: dta.Append("</table>" & vbCrLf)
Line 7480: dta.Append("</td>" & vbCrLf)
Line 7481: End If
Line 7482:
Line 7483: dta.Append("<td class=""tblwhite"">" & vbCrLf)
Line 7484: dta.Append(aDesc & "<br />" & vbCrLf)
Line 7485:
Line 7486: If aPersonalization <> "" Then
Line 7487: dta.Append(aPersonalization & vbCrLf)
Line 7488: End If
Line 7489:
Line 7490: dta.Append("</td>" & vbCrLf)
Line 7491:
Line 7492: If cSingleItemOn <> "Y" Then
Line 7493: dta.Append("<td align=""CENTER"" valign=""MIDDLE"" nowrap class=""tblwhite"">" & vbCrLf)
Line 7494: Else
Line 7495: dta.Append("<td colspan=""4"" align=""CENTER"" valign=""MIDDLE"" nowrap class=""tblwhite"">" & vbCrLf)
Line 7496: End If
Line 7497:
Line 7498: dta.Append(aQty & vbCrLf)
Line 7499: dta.Append("</td>" & vbCrLf)
Line 7500:
Line 7501: If cHideQtyShipped <> "Y" And usePromoPayment = False Then
Line 7502: dta.Append("<td align=""CENTER"" valign=""MIDDLE"" nowrap class=""tblwhite"">" & vbCrLf)
Line 7503: dta.Append(aShipped & vbCrLf)
Line 7504: End If
Line 7505:
Line 7506: dta.Append("</td>" & vbCrLf)
Line 7507:
Line 7508: If cSingleItemOn <> "Y" Then
Line 7509: If usePromoPayment = False Then
Line 7510: dta.Append("<td align=""CENTER"" valign=""MIDDLE"" nowrap class=""tblwhite"">" & vbCrLf)
Line 7511: dta.Append(aPer & vbCrLf)
Line 7512: dta.Append("</td>" & vbCrLf)
Line 7513: End If
Line 7514:
Line 7515: 'Do not remove pricing from verifyorder, processorder, and emails except email to supervisor
Line 7516: If (cRemovePricing <> "Y") Or (pg = "appemail") Then
Line 7517: dta.Append("<td align=""RIGHT"" class=""tblwhite"">" & showValues(aPrice) & "<br /></td>" & vbCrLf)
Line 7518: dta.Append("<td align=""RIGHT"" class=""tblwhite"">" & showValues(aExtnd) & "<br /></td>" & vbCrLf)
Line 7519: End If
Line 7520: End If
Line 7521:
Line 7522: dta.Append("</tr>" & vbCrLf)
Line 7523:
Line 7524: If lineItemType = "FF" Then
Line 7525: Session("splitorderffsubtotal") += aExtnd
Line 7526: iSplitOrderFFSubTotal += aExtnd
Line 7527: Else
Line 7528: iSplitOrderOESubTotal += aExtnd
Line 7529: End If
Line 7530: End If
Line 7531: End If
Line 7532: Next
Line 7533:
Line 7534: Session("splitorderffsubtotal") = iSplitOrderFFSubTotal
Line 7535: Session("splitorderoesubtotal") = iSplitOrderOESubTotal
Line 7536:
Line 7537: Return dta.ToString()
Line 7538: End Function
Line 7539:
Line 7540: Function orderInfoSummaryRow(lineItemType As String, aitem As Array, pg As String, datatype As String, aShipAmt As String, aGrdTotal As String, aOrderPointsSubTotal As String, aTaxAmt As String, aSplitOrderOETaxAmt As String, status As String, ordno As String, aShippingData As Object, aPaymentData As Object) As String
Line 7541: Dim aSubTotal As String
Line 7542: Dim aTotalBeforePayment As String
Line 7543: Dim cCurrencyFormat As String = getxmlval("currencyformat")
Line 7544: Dim cDutyMC As String = getxmlval("dutymc")
Line 7545: Dim cGivexSpecOn As String = getxmlval("givexspecon")
Line 7546: Dim cHideQtyShipped As String = getxmlval("hideqtyshipped")
Line 7547: Dim cPointsOn As String = getxmlval("pointson")
Line 7548: Dim cRemovePricing As String = getxmlval("removepricing")
Line 7549: Dim cResShipMC As String = getxmlval("resshipmc")
Line 7550: Dim cSingleItemOn As String = getxmlval("singleitemon")
Line 7551: Dim dta As New StringBuilder()
Line 7552: Dim iPointConverion As Integer = IIf(getxmlval("pointconversion") <> "", getxmlval("pointconversion"), 1)
Line 7553: Dim itemdiff, shfreight As Double
Line 7554: Dim orderType As String = getxmlval("ordertype")
Line 7555: Dim resShipMCAmt As Double = 0.0
Line 7556: Dim shipMethod As String = aShippingData(0)
Line 7557: Dim softwareProductType As String = getSoftwareProductType()
Line 7558: Dim splitorderffgrandtotal As String
Line 7559: Dim splitorderoegrandtotal As String
Line 7560: Dim usePromoPayment As Boolean = (InStr(pg, "PromoPayment") <> 0)
Line 7561:
Line 7562: 'BOF Summary Row: Payment (depending on order type), Shipping Method, and Totals sections data
Line 7563:
Line 7564: 'set up Row
Line 7565: dta.Append("<tr>" & vbCrLf)
Line 7566:
Line 7567: 'remove pricing from verifyorder, processorder, and emails except email to supervisor
Line 7568: If ((cRemovePricing <> "Y") Or (pg = "appemail")) And usePromoPayment = False Then
Line 7569: dta.Append("<td colspan=""4"" class=""tblwhite"">" & vbCrLf)
Line 7570: Else
Line 7571: dta.Append("<td colspan=""2"" class=""tblwhite"">" & vbCrLf)
Line 7572: End If
Line 7573: 'end remove pricing
Line 7574:
Line 7575: 'BOF Payment section for non Split Orders
Line 7576: If orderType <> "splitorderxmls" And orderType <> "aribasplitorderxmls" Then
Line 7577: Dim orderInfoPaymentInfo As String
Line 7578: 'aPaymentData = (aCCnum, aCCtype, ccholdname, pccexp, aCustpo, aWebno, UDF1, UDF2, UDF3)
Line 7579: orderInfoPaymentInfo = orderInfoPayment(pg, ordno, aPaymentData(0), aPaymentData(1), aPaymentData(2), aPaymentData(3), aPaymentData(4), aPaymentData(5), aPaymentData(6), aPaymentData(7), aPaymentData(8))
Line 7580: dta.Append(orderInfoPaymentInfo)
Line 7581: End If
Line 7582:
Line 7583: 'BOF Shipping Info section
Line 7584: Dim orderInfoShippingInfo As String
Line 7585: If (orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls") And lineItemType = "OE" Then
Line 7586: orderInfoShippingInfo = orderInfoShippingSplitOrderOE()
Line 7587: Else
Line 7588: 'aShippingData = (aShipMth, trackno, shipcomment1, shipcomment2, orderid)
Line 7589: orderInfoShippingInfo = orderInfoShipping(pg, aShippingData(0), aShippingData(1), aShippingData(2), aShippingData(3), aShippingData(4))
Line 7590: End If
Line 7591: dta.Append(orderInfoShippingInfo)
Line 7592:
Line 7593: 'BOF Totals section
Line 7594: If cGivexSpecOn = "Y" Then
Line 7595: If Not IsNumeric(Session("givexcb")) Then
Line 7596: Session("givexcb") = 0
Line 7597: End If
Line 7598:
Line 7599: If Not IsNumeric(Session("givexcharge")) Then
Line 7600: Session("givexcharge") = 0
Line 7601: End If
Line 7602: End If
Line 7603:
Line 7604: If Not IsNumeric(Session("giftcertamt")) Then
Line 7605: Session("giftcertamt") = 0
Line 7606: End If
Line 7607:
Line 7608: If Not IsNumeric(Session("dutymcamt")) Then
Line 7609: Session("dutymcamt") = 0
Line 7610: End If
Line 7611:
Line 7612: Dim givexcharge As String = "0"
Line 7613: If Session("givexcharge") <> Nothing Then
Line 7614: If Session("givexcharge").ToString() <> String.Empty Then
Line 7615: givexcharge = Session("givexcharge")
Line 7616: End If
Line 7617: End If
Line 7618:
Line 7619: 'Note the last element in array is for the 3 extra pieces of info: Total # of items found, Order subtotal, & Total SH line item freight charge
Line 7620: Dim ubounder As Integer = UBound(aitem)
Line 7621:
Line 7622: 'BOF Sub-Total setup
Line 7623: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7624: itemdiff = 0
Line 7625: Else
Line 7626: itemdiff = getLineItemExtendedPrice(aitem, ordno, "itemDiff")
Line 7627: End If
Line 7628:
Line 7629: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7630: If lineItemType = "FF" Then
Line 7631: aSubTotal = Session("splitorderffsubtotal")
Line 7632: Else
Line 7633: aSubTotal = Session("splitorderoesubtotal")
Line 7634: End If
Line 7635: ElseIf softwareProductType = "ASISB" And cPointsOn = "points" Then
Line 7636: aSubTotal = aOrderPointsSubTotal
Line 7637: ElseIf cPointsOn = "pointsallowpaydiff" Then
Line 7638: aSubTotal = (CDbl(aitem(ubounder, 2)) * iPointConverion) - CDbl(itemdiff)
Line 7639: Else
Line 7640: aSubTotal = CDbl(aitem(ubounder, 2)) - CDbl(itemdiff) + CDbl(Session("giftcertamt")) + CDbl(givexcharge) - CDbl(Session("dutymcamt"))
Line 7641: End If
Line 7642:
Line 7643: 'BOF Shipping
Line 7644: Dim aShipReturn
Line 7645: aShipReturn = aitem(ubounder, 3)
Line 7646:
Line 7647: If CStr(aShipReturn) = "NIL" Then
Line 7648: aShipReturn = 0
Line 7649: End If
Line 7650:
Line 7651: If datatype = "EORDER" Then
Line 7652: aShipAmt = CDbl(aShipAmt)
Line 7653: Else
Line 7654: aShipAmt = CDbl(aShipAmt) + CDbl(aShipReturn)
Line 7655: End If
Line 7656: Session.Remove("shippingiszero")
Line 7657: If aShipAmt = 0 Then
Line 7658: Session("shippingiszero") = True
Line 7659: End If
Line 7660:
Line 7661: If (orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls") And lineItemType = "OE" Then
Line 7662: shfreight = 0.0
Line 7663: Else
Line 7664: shfreight = getLineItemExtendedPrice(aitem, ordno, "SH")
Line 7665: End If
Line 7666:
Line 7667: If getxmlval("zerofreight") = "Y" And Session("zerofreightamount") <> 0 Then
Line 7668: aShipAmt = showValues(Session("zerofreightamount"))
Line 7669: aGrdTotal = showValues(CDbl(aGrdTotal) + CDbl(Session("zerofreightamount")))
Line 7670: ElseIf shfreight <> 0 Then
Line 7671: aShipAmt = showValues(shfreight)
Line 7672: If datatype <> "SB" And orderType <> "splitorderxmls" And orderType <> "aribasplitorderxmls" Then
Line 7673: aSubTotal = aSubTotal - shfreight
Line 7674: End If
Line 7675: Else
Line 7676: aShipAmt = showValues(aShipAmt)
Line 7677: End If
Line 7678:
Line 7679: If lineItemType <> "OE" Then
Line 7680: If getxmlval("resshipmc") <> String.Empty And Session("residential_ck") = "Y" And ((Left(shipMethod, 1) = "U" And Left(shipMethod, 4) <> "USPS") Or Left(shipMethod, 5) = "FedEx") Then
Line 7681: resShipMCAmt = getLineItemExtendedPrice(aitem, ordno, "ResidentialShip")
Line 7682: End If
Line 7683:
Line 7684: End If
Line 7685:
Line 7686: 'only subtract out for non Split Orders
Line 7687: If datatype <> "SB" And orderType <> "splitorderxmls" And orderType <> "aribasplitorderxmls" Then
Line 7688: aSubTotal = aSubTotal - resShipMCAmt
Line 7689: End If
Line 7690:
Line 7691: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7692: If lineItemType = "FF" Then
Line 7693: aTaxAmt = CDbl(aTaxAmt) - CDbl(aSplitOrderOETaxAmt)
Line 7694: Else
Line 7695: aTaxAmt = aSplitOrderOETaxAmt
Line 7696: End If
Line 7697: End If
Line 7698:
Line 7699: 'BOF Grandtotal for non Split Orders or Total for each section for Split Orders
Line 7700: Session("passgrandtotal") = aGrdTotal
Line 7701: If cPointsOn = "pointsallowpaydiff" Then
Line 7702: aGrdTotal = showValuesPointsPayDifferenceAmount(aGrdTotal)
Line 7703: ElseIf orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7704: If lineItemType = "FF" Then
Line 7705: splitorderffgrandtotal = CDbl(Session("splitorderffsubtotal"))
Line 7706: aTotalBeforePayment = splitorderffgrandtotal + CDbl(aShipAmt) + CDbl(resShipMCAmt) + CDbl(aTaxAmt)
Line 7707:
Line 7708: If Session("giftcertamt") > 0 Then
Line 7709: If CDbl(Session("giftcertamt")) >= CDbl(aTotalBeforePayment) Then
Line 7710: Session("splitorderffgcamt") = aTotalBeforePayment
Line 7711: Session("splitordergiftcertbalanceamt") = Session("giftcertamt") - Session("splitorderffgcamt")
Line 7712: Else
Line 7713: Session("splitorderffgcamt") = Session("giftcertamt")
Line 7714: Session("splitordergiftcertbalanceamt") = 0
Line 7715:
Line 7716: End If
Line 7717: End If
Line 7718:
Line 7719: aGrdTotal = showValues(aTotalBeforePayment - Session("splitorderffgcamt"))
Line 7720:
Line 7721: Else
Line 7722: splitorderoegrandtotal = CDbl(Session("splitorderoesubtotal"))
Line 7723: aTotalBeforePayment = showValues(splitorderoegrandtotal + CDbl(aTaxAmt))
Line 7724:
Line 7725: If Session("giftcertamt") > 0 Then
Line 7726: If CDbl(Session("splitordergiftcertbalanceamt")) >= CDbl(aTotalBeforePayment) Then
Line 7727: Session("splitorderoegcamt") = aTotalBeforePayment
Line 7728: Session("splitordergiftcertbalanceamt") = Session("giftcertamt") - Session("splitorderffgcamt")
Line 7729: Else
Line 7730: Session("splitorderoegcamt") = Session("splitordergiftcertbalanceamt")
Line 7731: End If
Line 7732: End If
Line 7733:
Line 7734: aGrdTotal = showValues(aTotalBeforePayment - Session("splitorderoegcamt"))
Line 7735: End If
Line 7736: Else
Line 7737: aGrdTotal = showValues(aGrdTotal)
Line 7738: End If
Line 7739:
Line 7740: Dim lastcolspan As Integer = 4
Line 7741: If cHideQtyShipped = "Y" Then
Line 7742: lastcolspan -= 1
Line 7743: End If
Line 7744: If cRemovePricing = "Y" And cSingleItemOn = "Y" Then
Line 7745: lastcolspan += 2
Line 7746: End If
Line 7747:
Line 7748: 'BOF Totals html
Line 7749: dta.Append("<td align=""right"" colspan=""" & lastcolspan & """ class=""tblwhite"" valign=""top"">" & vbCrLf)
Line 7750:
Line 7751: If InStr(pg, "email") = 0 And status = "Cancelled" Then
Line 7752: dta.Append("<img src=""cancelled.jpg"" border=""0"" align=""left"">" & vbCrLf)
Line 7753: End If
Line 7754:
Line 7755: If getxmlval("showordertotals") <> "N" Then
Line 7756:
Line 7757: 'BOF Sub Total html
Line 7758: dta.Append("<table class=""tblwhite"">" & vbCrLf)
Line 7759: dta.Append("<tr>" & vbCrLf)
Line 7760: dta.Append("<td align=""right"" class=""tblwhite""><b>Sub Total:</b></td>" & vbCrLf)
Line 7761:
Line 7762: If cPointsOn = "pointsallowpaydiff" Then
Line 7763: dta.Append("<td align=""right"" class=""tblwhite"">" & showValuesPointsPayDifference(CInt(aSubTotal)) & "</td>" & vbCrLf)
Line 7764: Else
Line 7765: dta.Append("<td align=""right"" class=""tblwhite"">" & showValues(aSubTotal) & "</td>" & vbCrLf)
Line 7766: End If
Line 7767:
Line 7768: dta.Append("</tr>" & vbCrLf)
Line 7769:
Line 7770: 'BoF Freight/Shipping html
Line 7771: If (getxmlval("hidezeroshipping") <> "Y") OrElse Session("shippingiszero") <> True OrElse (getxmlval("displayordapkgdtludf1") = "Y" AndAlso r1.Request("frt") <> String.Empty) Then
Line 7772:
Line 7773: dta.Append("<tr>" & vbCrLf)
Line 7774: If getxmlval("displayordapkgdtludf1") = "Y" AndAlso r1.Request("frt") <> String.Empty Then
Line 7775: dta.Append("<td align=""right"" class=""tblwhite""><b>Freight:</b></td>" & vbCrLf)
Line 7776: dta.Append("<td align=""right"" class=""tblwhite"">" & showValues(filterInput(r1.Request("frt"), "numeric", "Freight from APKGDTL")) & "</td>" & vbCrLf)
Line 7777: Else
Line 7778: Dim shippingLabel As String = "Shipping"
Line 7779: If getxmlval("altshippinglabel") <> String.Empty Then
Line 7780: shippingLabel = getxmlval("altshippinglabel")
Line 7781: End If
Line 7782: dta.Append("<td align=""right"" class=""tblwhite""><b>" & shippingLabel & ":</b></td>" & vbCrLf)
Line 7783:
Line 7784: If (orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls") And lineItemType = "OE" Then
Line 7785: Dim shippingTBDvalue As String = getxmlval("splitorderoetbdtext")
Line 7786: If shippingTBDvalue = "" Then
Line 7787: shippingTBDvalue = "TBDtest"
Line 7788: End If
Line 7789: dta.Append("<td align=""right"" class=""tblwhite"">" & shippingTBDvalue & "</td>" & vbCrLf)
Line 7790: Else
Line 7791: dta.Append("<td align=""right"" class=""tblwhite"">" & aShipAmt & "</td>" & vbCrLf)
Line 7792: End If
Line 7793: End If
Line 7794: dta.Append("</tr>" & vbCrLf)
Line 7795: End If
Line 7796:
Line 7797: 'BOF Residential Shipping Charge html
Line 7798: If cResShipMC <> String.Empty And Session("residential_ck") = "Y" And lineItemType <> "OE" And ((Left(shipMethod, 1) = "U" And Left(shipMethod, 4) <> "USPS") Or Left(shipMethod, 5) = "FedEx") Then
Line 7799: dta.Append("<tr>" & vbCrLf)
Line 7800: dta.Append("<td align=""right"" class=""tblwhite""><b>" & getxmlval("resshiplbl") & ":</b></td>" & vbCrLf)
Line 7801: dta.Append("<td align=""right"" class=""tblwhite"">" & showValues(resShipMCAmt) & "</td>" & vbCrLf)
Line 7802: dta.Append("</tr>" & vbCrLf)
Line 7803: End If
Line 7804:
Line 7805: 'BOF Tax html
Line 7806: If cPointsOn <> "pointsallowpaydiff" Then
Line 7807: dta.Append("<tr valign=""top"">" & vbCrLf)
Line 7808: dta.Append("<td align=""right"" class=""tblwhite""><b>Tax:</b></td>" & vbCrLf)
Line 7809: aTaxAmt = showValues(CDbl(aTaxAmt))
Line 7810: dta.Append("<td align=""right"" class=""tblwhite"">" & aTaxAmt & "</td>" & vbCrLf)
Line 7811: dta.Append("</tr>")
Line 7812: End If
Line 7813:
Line 7814: 'BOF Duty Amt html
Line 7815: If ordno = "" And Trim(cDutyMC) <> "" And Session("dutymcamt") > 0 Then
Line 7816: dta.Append("<tr>" & vbCrLf)
Line 7817: dta.Append("<td align=""right"" class=""tblwhite""><b>" & getxmlval("dutylbl") & ":</b></td>" & vbCrLf)
Line 7818: dta.Append("<td align=""right"" class=""tblwhite"">" & reformatcurrency(FormatCurrency(Session("dutymcamt"), cCurrencyFormat)) & "</td>" & vbCrLf)
Line 7819: dta.Append("</tr>" & vbCrLf)
Line 7820: End If
Line 7821:
Line 7822: 'BOF GC Amt html
Line 7823: Dim gcnotblank = "F"
Line 7824: Dim x
Line 7825: Session("gcnotblank") = gcnotblank
Line 7826: For x = 1 To Int(Session("numofgiftcerts"))
Line 7827:
Line 7828: Session("gcnotblank") = gcnotblank
Line 7829: If Session("giftcertno" & x) <> "" Then
Line 7830: gcnotblank = "T"
Line 7831: Exit For
Line 7832: End If
Line 7833: Next
Line 7834:
Line 7835: If ordno = "" And (gcnotblank = "T" Or Session("giftcertno") <> "") Then
Line 7836: Dim giftamt
Line 7837: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7838: If lineItemType = "FF" Then
Line 7839: giftamt = reformatcurrency(FormatCurrency(Session("splitorderffgcamt") * -1, cCurrencyFormat))
Line 7840: Else
Line 7841: giftamt = reformatcurrency(FormatCurrency(Session("splitorderoegcamt") * -1, cCurrencyFormat))
Line 7842: End If
Line 7843:
Line 7844: Else
Line 7845: giftamt = reformatcurrency(FormatCurrency(Session("giftcertamt") * -1, cCurrencyFormat))
Line 7846: End If
Line 7847:
Line 7848: dta.Append("<tr>" & vbCrLf)
Line 7849: dta.Append("<td align=""right"" class=""tblwhite""><b>" & getxmlval("giftfinlbl") & ":</b></td>" & vbCrLf)
Line 7850: dta.Append("<td align=""right"" class=""tblwhite"">" & giftamt & "</td>" & vbCrLf)
Line 7851: dta.Append("</tr>" & vbCrLf)
Line 7852: End If
Line 7853:
Line 7854: 'BOF GiveX Payment html
Line 7855: If cGivexSpecOn = "Y" And (Session("givexcharge") <> "0") Then
Line 7856: Dim givexamt = reformatcurrency(FormatCurrency(Session("givexcharge") * -1, cCurrencyFormat))
Line 7857:
Line 7858: dta.Append("<tr>" & vbCrLf)
Line 7859: dta.Append("<td align=""right"" class=""tblwhite""><b>" & getxmlval("givex42label") & ":</b></td>" & vbCrLf)
Line 7860: dta.Append("<td align=""right"" class=""tblwhite"">" & givexamt & "</td>" & vbCrLf)
Line 7861: dta.Append("</tr>" & vbCrLf)
Line 7862: End If
Line 7863:
Line 7864: 'BOF Points Payment html
Line 7865: If CDbl(itemdiff) <> 0 Then
Line 7866: dta.Append("<tr>" & vbCrLf)
Line 7867: dta.Append("<td align=""right"" class=""tblwhite""><b>" & getxmlval("pointlabel") & ":</b></td>" & vbCrLf)
Line 7868:
Line 7869: If cPointsOn = "pointsallowpaydiff" Then
Line 7870: dta.Append("<td align=""right"" class=""tblwhite"">" & showValuesPointsPayDifference(CInt(itemdiff)) & "</td>" & vbCrLf)
Line 7871: Else
Line 7872: dta.Append("<td align=""right"" class=""tblwhite"">" & showValues(CDbl(itemdiff)) & "</td>" & vbCrLf)
Line 7873: End If
Line 7874:
Line 7875: dta.Append("</tr>")
Line 7876: End If
Line 7877:
Line 7878: dta.Append("<tr>" & vbCrLf)
Line 7879: dta.Append("<td colspan=""2""><br /></td>" & vbCrLf)
Line 7880: dta.Append("</tr>" & vbCrLf)
Line 7881:
Line 7882: 'BOF Grandtotal for non Split Orders or Total for each section for Split Orders
Line 7883: dta.Append("<tr>" & vbCrLf)
Line 7884:
Line 7885: If orderType = "splitorderxmls" Or orderType = "aribasplitorderxmls" Then
Line 7886: dta.Append("<td align=""right"" class=""tblwhite""><b>Total:</b></td>" & vbCrLf)
Line 7887: Dim splitOrderGrandTotal As String = ""
Line 7888: If lineItemType = "FF" Then
Line 7889: splitOrderGrandTotal = splitorderffgrandtotal
Line 7890:
Line 7891: 'if there was enough GC to pay for FF part, then Regular OE part may need to be paid with CC
Line 7892: If aGrdTotal = 0 And Session("splitorderffgcamt") > 0 Then
Line 7893: Session("ccinfotooexml") = True
Line 7894: Else
Line 7895: Session("ccinfotooexml") = False
Line 7896: End If
Line 7897:
Line 7898: Else
Line 7899: splitOrderGrandTotal = splitorderoegrandtotal
Line 7900: End If
Line 7901: Else
Line 7902: dta.Append("<td align=""right"" class=""tblwhite""><b>Grand Total:</b></td>" & vbCrLf)
Line 7903: End If
Line 7904:
Line 7905: dta.Append("<td align=""right"" class=""tblwhite""><b>" & aGrdTotal & "</b></td>" & vbCrLf)
Line 7906:
Line 7907: dta.Append("</tr>" & vbCrLf)
Line 7908: dta.Append("</table>" & vbCrLf)
Line 7909:
Line 7910: Else
Line 7911: dta.Append("<br />" & vbCrLf)
Line 7912: End If
Line 7913: 'EOF Totals Section
Line 7914:
Line 7915: dta.Append("</td>" & vbCrLf)
Line 7916: dta.Append("</tr>" & vbCrLf)
Line 7917: 'EOF Payment, Shipping Method and Totals row data aka from now on as orderInfoSummaryRow
Line 7918:
Line 7919: Return dta.ToString()
Line 7920: End Function
Line 7921:
Line 7922: Function getLineItemExtendedPrice(aItem As Array, orderID As String, itemTypeToCalc As String) As String
Line 7923: Dim aItemID, aQty, aPrice, aExtendedPrice, aPer, aPersonalization, aProdImg, aShipped As String
Line 7924: Dim itemExtendedPrice As String = "0"
Line 7925: Dim calculateThisLine As Boolean = False
Line 7926: Dim cPointItemNo As String = getxmlval("pointitemno")
Line 7927: Dim cPointsOn As String = getxmlval("pointson")
Line 7928: Dim cResShipMC As String = getxmlval("resshipmc")
Line 7929: Dim iPointConverion As Integer = IIf(getxmlval("pointconversion") <> "", getxmlval("pointconversion"), 1)
Line 7930: Dim orderType As String = getxmlval("ordertype")
Line 7931: Dim softwareProductType As String = getSoftwareProductType()
Line 7932:
Line 7933: ' LINE DATA
Line 7934: For icount = 1 To UBound(aItem) - 1
Line 7935: aItemID = Trim(aItem(icount, 3))
Line 7936:
Line 7937: Select Case itemTypeToCalc
Line 7938: Case "itemDiff"
Line 7939: If Session("goyopoints") And UCase(aItemID) = UCase(Trim(cPointItemNo)) Then
Line 7940: calculateThisLine = True
Line 7941: End If
Line 7942: Case "SH"
Line 7943: If UCase(aItemID) = "SH" Then
Line 7944: calculateThisLine = True
Line 7945: End If
Line 7946: Case "ResidentialShip"
Line 7947: If UCase(aItemID) = cResShipMC And cResShipMC <> String.Empty Then
Line 7948: calculateThisLine = True
Line 7949: End If
Line 7950: End Select
Line 7951:
Line 7952: If calculateThisLine = True Then
Line 7953: aQty = Trim(aItem(icount, 9))
Line 7954:
Line 7955: If softwareProductType = "ASISB" And cPointsOn = "points" Then
Line 7956: aPrice = showValues(aItem(icount, 15)) 'Points per item
Line 7957: aExtendedPrice = aPrice * aQty
Line 7958: Else
Line 7959: aPrice = aItem(icount, 10) 'Price per item (Discount price, if applicable, or item price)
Line 7960: aExtendedPrice = aItem(icount, 11) 'Extended price ((Qty*Price) / Per) Note - this Price is same as above aPrice)
Line 7961: End If
Line 7962:
Line 7963: Select Case itemTypeToCalc
Line 7964: Case "itemDiff"
Line 7965: If cPointsOn = "points" Or cPointsOn = "pointsallowpaydiff" Then
Line 7966: itemExtendedPrice = aExtendedPrice * iPointConverion
Line 7967: Else
Line 7968: itemExtendedPrice = aExtendedPrice
Line 7969: End If
Line 7970: Case "SH"
Line 7971: itemExtendedPrice = aExtendedPrice
Line 7972: Case "ResidentialShip"
Line 7973: itemExtendedPrice = aExtendedPrice
Line 7974: End Select
Line 7975:
Line 7976: Exit For
Line 7977: End If
Line 7978: Next
Line 7979:
Line 7980: Return itemExtendedPrice
Line 7981: End Function
Line 7982:
Line 7983: Function orderInfoPayment(pg As String, ordno As String, aCCnum As String, aCCtype As String, ccholdname As String, pccexp As String, aCustpo As String, aWebno As String, UDF1 As String, UDF2 As String, UDF3 As String) As String
Line 7984: Dim cGivexSpecOn As String = getxmlval("givexspecon")
Line 7985: Dim cSingleItemOn As String = getxmlval("singleitemon")
Line 7986: Dim dta As New StringBuilder()
Line 7987: Dim usePromoPayment As Boolean = (InStr(pg, "PromoPayment") <> 0)
Line 7988:
Line 7989: dta.Append("<table width=""100%"" cellspacing=""0"" cellpadding=""0"">" & vbCrLf)
Line 7990:
Line 7991: dta.Append("<tr valign=""top"">" & vbCrLf)
Line 7992:
Line 7993: If getxmlval("hidepaymentconfirm") <> "Y" And usePromoPayment = False Then
Line 7994: dta.Append("<td class=""tblwhite"">" & vbCrLf)
Line 7995: dta.Append("<b>Payment Information:</b>" & vbCrLf)
Line 7996:
Line 7997: If Session("paymentmethod") = "comdata" Then
Line 7998: dta.Append("Comdata <br />" & vbCrLf)
Line 7999: dta.Append("<table width=""100%"">" & vbCrLf)
Line 8000:
Line 8001: If getxmlval("comdatatdlabel1") <> "" Then
Line 8002: dta.Append("<tr>" & vbCrLf)
Line 8003: dta.Append("<td> </td>" & "<td class=""tblwhite"">" & vbCrLf)
Line 8004: dta.Append(getxmlval("comdatatdlabel1") & ": " & Session("compmt1") & "</td>" & vbCrLf)
Line 8005: dta.Append("</tr>" & vbCrLf)
Line 8006: End If
Line 8007:
Line 8008: If getxmlval("comdatatdlabel2") <> "" Then
Line 8009: dta.Append("<tr>" & vbCrLf)
Line 8010: dta.Append("<td> </td>" & "<td class=""tblwhite"">" & vbCrLf)
Line 8011: dta.Append(getxmlval("comdatatdlabel2") & ": " & Session("compmt2") & "</td>" & vbCrLf)
Line 8012: dta.Append("</tr>" & vbCrLf)
Line 8013: End If
Line 8014:
Line 8015: If aCCnum <> "xxxx-" Then
Line 8016: dta.Append("<tr>" & vbCrLf)
Line 8017: dta.Append("<td> </td>" & vbCrLf)
Line 8018: dta.Append("<td class=""tblwhite"">Card Number: " & aCCnum & "</td>" & vbCrLf)
Line 8019: dta.Append("</tr>" & vbCrLf)
Line 8020: End If
Line 8021:
Line 8022: dta.Append("</table>" & vbCrLf)
Line 8023:
Line 8024: ElseIf aCCtype <> "" Then
Line 8025: dta.Append("Credit Card <br />" & vbCrLf)
Line 8026: dta.Append("<table width=""100%"">" & vbCrLf)
Line 8027:
Line 8028: If ordno = "" And ccholdname <> String.Empty Then
Line 8029: dta.Append("<tr>" & vbCrLf)
Line 8030: dta.Append("<td width=""10""> </td>" & vbCrLf)
Line 8031: dta.Append("<td class=""tblwhite"">" & vbCrLf)
Line 8032: dta.Append("Card Holder: " & ccholdname & vbCrLf)
Line 8033: dta.Append("</td>" & vbCrLf)
Line 8034: dta.Append("</tr>" & vbCrLf)
Line 8035: End If
Line 8036:
Line 8037: dta.Append("<tr>" & vbCrLf)
Line 8038: dta.Append("<td> </td>" & vbCrLf)
Line 8039: dta.Append("<td class=""tblwhite"">Card Type: " & aCCtype & "</td>" & vbCrLf)
Line 8040: dta.Append("</tr>" & vbCrLf)
Line 8041: If Session("NPCSecureUsed") <> True And aCCnum <> "xxxx-" Then
Line 8042: dta.Append("<tr>" & vbCrLf)
Line 8043: dta.Append("<td> </td>" & vbCrLf)
Line 8044: dta.Append("<td class=""tblwhite"">Card Number: " & aCCnum & "</td>" & vbCrLf)
Line 8045: dta.Append("</tr>" & vbCrLf)
Line 8046: End If
Line 8047:
Line 8048: If Session("ccNickNameForDisplayOnly") <> String.Empty And Session("ccNickNameForDisplayOnly") <> "Enter Nickname" Then
Line 8049: Dim promopaymentnicknamelabel As String = "Nickname"
Line 8050: If getxmlval("promopaymentnicknamelabel") <> String.Empty Then
Line 8051: promopaymentnicknamelabel = getxmlval("promopaymentnicknamelabel")
Line 8052: End If
Line 8053: dta.Append("<tr>" & vbCrLf)
Line 8054: dta.Append("<td> </td>" & vbCrLf)
Line 8055: dta.Append("<td class=""tblwhite"">" & promopaymentnicknamelabel & ": " & Session("ccNickNameForDisplayOnly") & "</td>" & vbCrLf)
Line 8056: dta.Append("</tr>" & vbCrLf)
Line 8057: End If
Line 8058:
Line 8059: If InStr(pccexp, "00") = 0 Then
Line 8060: dta.Append("<tr>" & vbCrLf)
Line 8061: dta.Append("<td> </td>" & vbCrLf)
Line 8062: dta.Append("<td class=""tblwhite"">Expiration: " & pccexp & "</td>" & vbCrLf)
Line 8063: dta.Append("</tr>" & vbCrLf)
Line 8064: End If
Line 8065:
Line 8066: dta.Append("</table>" & vbCrLf)
Line 8067: ElseIf getxmlval("pcicson") = "Y" And Session("paymentmethod") = "creditcard" Then
Line 8068: dta.Append("Credit Card <br />" & vbCrLf)
Line 8069: ElseIf aCustpo <> "" And (aCustpo <> aWebno) Then
Line 8070: dta.Append(getxmlval("polabel") & ": " & aCustpo & "<br />" & vbCrLf)
Line 8071: ElseIf UDF1 <> "" And getxmlval("showbudget") = "lateshipto" And getxmlval("latebudgetform") = "P" And Session("paymentmethod") = getxmlval("budgetpayname") Then
Line 8072: dta.Append(getxmlval("budgetpayname") & ": " & UDF1 & vbCrLf)
Line 8073: ElseIf UDF1 <> "" And getxmlval("pmt1") <> "" Then
Line 8074:
Line 8075: If getxmlval("pmtop1") <> "" Then
Line 8076: dta.Append(getxmlval("pmt1") & ": " & UDF1 & vbCrLf)
Line 8077: Else
Line 8078: dta.Append(getxmlval("pmt1") & vbCrLf)
Line 8079: End If
Line 8080:
Line 8081: ElseIf UDF2 <> "" And getxmlval("pmt2") <> "" Then
Line 8082:
Line 8083: If getxmlval("pmtop2") <> "" Then
Line 8084: dta.Append(getxmlval("pmt2") & ": " & UDF2 & vbCrLf)
Line 8085: Else
Line 8086: dta.Append(getxmlval("pmt2") & vbCrLf)
Line 8087: End If
Line 8088:
Line 8089: ElseIf UDF3 <> "" And getxmlval("pmt3") <> "" Then
Line 8090:
Line 8091: If getxmlval("pmtop3") <> "" Then
Line 8092: dta.Append(getxmlval("pmt3") & ": " & UDF3 & vbCrLf)
Line 8093: Else
Line 8094: dta.Append(getxmlval("pmt3") & vbCrLf)
Line 8095: End If
Line 8096:
Line 8097: ElseIf (getxmlval("showgiftcert") = "Y" Or getxmlval("attachloginstogiftcertsbutallowpayment") = "Y") And (Session("giftcertamt") <> "0.000") Then
Line 8098: dta.Append("Gift Certificate" & vbCrLf)
Line 8099:
Line 8100: ElseIf cGivexSpecOn = "Y" And (Session("givexcharge") <> "0") Then
Line 8101: dta.Append("Givex Card" & vbCrLf)
Line 8102:
Line 8103: ElseIf cSingleItemOn = "Y" Then
Line 8104: dta.Append(getxmlval("singleitemlabel") & ":" & Session("giftCardTemp") & vbCrLf)
Line 8105:
Line 8106: Else
Line 8107: dta.Append("Bill" & vbCrLf)
Line 8108: End If
Line 8109:
Line 8110: dta.Append("</td>" & vbCrLf)
Line 8111: End If ' If getxmlval("hidepaymentconfirm") <> "Y" Then
Line 8112:
Line 8113: dta.Append("</tr>" & vbCrLf)
Line 8114: dta.Append("</table>" & vbCrLf)
Line 8115:
Line 8116: Return dta.ToString()
Line 8117: End Function
Line 8118:
Line 8119: Function orderInfoShippingSplitOrderOE() As String
Line 8120: Dim dta As New StringBuilder()
Line 8121:
Line 8122: dta.Append("<br /><b>Shipping Notes:</b> " & getxmlval("splitorderoeshippingnotestext") & vbCrLf)
Line 8123:
Line 8124: Return dta.ToString()
Line 8125: End Function
Line 8126:
Line 8127: Function orderInfoShipping(pg As String, aShipMth As String, trackNo As String, shipcomment1 As String, shipcomment2 As String, orderid As String) As String
Line 8128: Dim cSingleItemOn As String = getxmlval("singleitemon")
Line 8129: Dim cSVSpecialOn As String = getxmlval("svspecialon")
Line 8130: Dim dta As New StringBuilder()
Line 8131:
Line 8132: If cSingleItemOn <> "Y" And getxmlval("hideshippingdescription") <> "Y" Then
Line 8133: dta.Append("<br /><b>Shipping Method:</b> " & aShipMth & vbCrLf)
Line 8134: End If
Line 8135:
Line 8136: If trackNo <> "" Then
Line 8137: dta.Append("<br /><b>Tracking #:</b> " & trackNo & vbCrLf)
Line 8138: End If
Line 8139:
Line 8140: If shipcomment1 <> "" Or shipcomment2 <> "" Then
Line 8141: dta.Append("<br /><br /><b>" & getxmlval("supshipcommentlbl") & ":</b><br />" & vbCrLf)
Line 8142: If shipcomment1 <> "" Then
Line 8143: dta.Append(shipcomment1 & "<br />" & vbCrLf)
Line 8144: End If
Line 8145: If shipcomment2 <> "" Then
Line 8146: dta.Append(shipcomment2 & vbCrLf)
Line 8147: End If
Line 8148: End If
Line 8149:
Line 8150: If (pg <> String.Empty) And cSVSpecialOn = "Y" AndAlso getxmlval("svnummessageloc") = "P" And getxmlval("svnummessagetxt") <> String.Empty Then
Line 8151: dta.Append("<table style=""max-width:250px; width:250px;""><tr><td>")
Line 8152: dta.Append(SvNumMessageTxt(orderid))
Line 8153: dta.Append("</td></tr></table>")
Line 8154: dta.Append("<br /><br />" & vbCrLf)
Line 8155: End If
Line 8156:
Line 8157: dta.Append("</td>" & vbCrLf)
Line 8158:
Line 8159: Return dta.ToString()
Line 8160: End Function
Line 8161:
Line 8162: Function orderInfoSplitOrderGrandTotalRow(pg As String, aGrdTotal As String, aCCnum As String, aCCtype As String, ccholdname As String, ordno As String, pccexp As String, aCustpo As String, aWebno As String, UDF1 As String, UDF2 As String, UDF3 As String) As String
Line 8163: Dim cHideQtyShipped As String = getxmlval("hideqtyshipped")
Line 8164: Dim cRemovePricing As String = getxmlval("removepricing")
Line 8165: Dim cSingleItemOn As String = getxmlval("singleitemon")
Line 8166: Dim dta As New StringBuilder()
Line 8167: Dim usePromoPayment As Boolean = (InStr(pg, "PromoPayment") <> 0)
Line 8168:
Line 8169: dta.Append("<tr>" & vbCrLf)
Line 8170:
Line 8171: 'remove pricing from verifyorder, processorder, and emails except email to supervisor
Line 8172: If ((cRemovePricing <> "Y") Or (pg = "appemail")) And usePromoPayment = False Then
Line 8173: dta.Append("<td colspan=""4"" class=""tblwhite"">" & vbCrLf)
Line 8174: Else
Line 8175: dta.Append("<td colspan=""2"" class=""tblwhite"">" & vbCrLf)
Line 8176: End If
Line 8177: 'end remove pricing
Line 8178:
Line 8179: Dim orderInfoPaymentInfo As String
Line 8180: orderInfoPaymentInfo = orderInfoPayment(pg, ordno, aCCnum, aCCtype, ccholdname, pccexp, aCustpo, aWebno, UDF1, UDF2, UDF3)
Line 8181: dta.Append(orderInfoPaymentInfo)
Line 8182:
Line 8183: Dim lastcolspan As Integer = 4
Line 8184: If cHideQtyShipped = "Y" Then
Line 8185: lastcolspan -= 1
Line 8186: End If
Line 8187: If cRemovePricing = "Y" And cSingleItemOn = "Y" Then
Line 8188: lastcolspan += 2
Line 8189: End If
Line 8190:
Line 8191: 'BOF Totals html
Line 8192: dta.Append("<td align=""right"" colspan=""" & lastcolspan & """ class=""tblwhite"" valign=""top"">" & vbCrLf)
Line 8193:
Line 8194: If getxmlval("showordertotals") <> "N" Then
Line 8195: dta.Append("<table class=""tblwhite"">" & vbCrLf)
Line 8196: dta.Append("<tr>" & vbCrLf)
Line 8197: dta.Append("<td align=""right"" class=""tblwhite""><b>Grand Total:</b></td>" & vbCrLf)
Line 8198: dta.Append("<td align=""right"" class=""tblwhite""><b>" & showValues(aGrdTotal) & "</b></td>" & vbCrLf)
Line 8199: dta.Append("</tr>" & vbCrLf)
Line 8200: dta.Append("</table>" & vbCrLf)
Line 8201: End If
Line 8202:
Line 8203: dta.Append("</td>" & vbCrLf)
Line 8204: dta.Append("</tr>" & vbCrLf)
Line 8205:
Line 8206: Return dta.ToString()
Line 8207: End Function
Line 8208: Function orderInfoSpecialInstructions(aSpecInst As String, UDF1 As String, UDF2 As String, UDF3 As String) As String
Line 8209: Dim cGivexSpecOn As String = getxmlval("givexspecon")
Line 8210: Dim dta As New StringBuilder()
Line 8211:
Line 8212: Dim givexfieldqty As Integer
Line 8213: If getxmlval("givexfieldqty") <> String.Empty And getxmlval("givexfieldqty") <= 18 Then
Line 8214: givexfieldqty = getxmlval("givexfieldqty")
Line 8215: ElseIf getxmlval("givexfieldqty") > 18 Then
Line 8216: givexfieldqty = 18
Line 8217: Else
Line 8218: givexfieldqty = 5
Line 8219: End If
Line 8220:
Line 8221: If cGivexSpecOn = "Y" Then
Line 8222: For x As Integer = 1 To givexfieldqty
Line 8223: If Session("givexnumber" & x) <> String.Empty And InStr(aSpecInst, Session("givexnumber" & x)) < 1 Then
Line 8224: aSpecInst += Session("givexnumber" & x) & "; "
Line 8225: End If
Line 8226: Next
Line 8227: End If
Line 8228:
Line 8229: If aSpecInst <> "" Or (UDF1 <> "" Or UDF2 <> "" Or UDF3 <> "") Then
Line 8230:
Line 8231: Dim speclabel
Line 8232: If getxmlval("lblspecinst") <> "" Then
Line 8233: speclabel = getxmlval("lblspecinst")
Line 8234: Else
Line 8235: speclabel = "Special Instructions:"
Line 8236: End If
Line 8237:
Line 8238: If getxmlval("ordertype") = "reg" Then
Line 8239: If InStr(aSpecInst, "#Payment Method#") <> 0 Then
Line 8240: aSpecInst = Left(aSpecInst, InStr(aSpecInst, "#Payment Method#") - 1)
Line 8241: End If
Line 8242:
Line 8243: If InStr(aSpecInst, "#Credit Card Information#") <> 0 Then
Line 8244: aSpecInst = Left(aSpecInst, InStr(aSpecInst, "#Credit Card Information#") - 1)
Line 8245: End If
Line 8246: End If
Line 8247:
Line 8248: If getxmlval("specinstcarriage") = "Y" Then
Line 8249: aSpecInst = Replace(aSpecInst, "//n", "<br />")
Line 8250: End If
Line 8251:
Line 8252: dta.Append("<tr>" & vbCrLf)
Line 8253: dta.Append("<td colspan=""8"" class=""tblwhite"">" & vbCrLf)
Line 8254:
Line 8255: If (getxmlval("gcusedleft") = "N" Or getxmlval("attachloginstogiftcertsbutallowpayment") = "Y") And InStr(aSpecInst, "GC#") > 0 And InStr(aSpecInst, "Used") > 0 And (InStr(aSpecInst, "Left") > 0 Or InStr(aSpecInst, "Balance") > 0) Then
Line 8256: Dim startPosGCNumber As Integer = InStr(aSpecInst, "GC#")
Line 8257: Dim beforestrip As String = Left(aSpecInst, startPosGCNumber - 1)
Line 8258: Dim afterstrip As String
Line 8259:
Line 8260: If InStr(aSpecInst, "Left") > 0 Then
Line 8261: afterstrip = Right(aSpecInst, (aSpecInst.Length - InStr(aSpecInst, "Left") - 3))
Line 8262: ElseIf InStr(aSpecInst, "Balance") > 0 Then
Line 8263: Dim startPosEndOfLine As Integer = InStr(startPosGCNumber, aSpecInst, vbCrLf)
Line 8264: If startPosEndOfLine > 0 Then
Line 8265: afterstrip = Right(aSpecInst, (aSpecInst.Length - startPosEndOfLine))
Line 8266: Else
Line 8267: afterstrip = ""
Line 8268: End If
Line 8269: End If
Line 8270:
Line 8271: aSpecInst = beforestrip & afterstrip
Line 8272: End If
Line 8273:
Line 8274: If getxmlval("gcusedleft") = "Y" And InStr(aSpecInst, "GC#") > 0 And InStr(aSpecInst, "Used") > 0 And InStr(aSpecInst, "Left") > 0 Then
Line 8275: Dim currencysymbol As String = getcurrencysymbol()
Line 8276:
Line 8277: If getxmlval("currencysymbolplacement") = "afteramt" Then
Line 8278: 'parse out Special instructions string for the GC# info
Line 8279: Dim startPosUsedText As Integer = InStr(InStr(aSpecInst, "GC#"), aSpecInst, "Used")
Line 8280: Dim startPosAmtUsed As Integer = InStr(startPosUsedText, aSpecInst, "$")
Line 8281: Dim startPosAmtLeft As Integer = InStr(startPosAmtUsed + 1, aSpecInst, "$")
Line 8282: Dim startPosLeftText As Integer = InStr(startPosAmtLeft, aSpecInst, "Left")
Line 8283:
Line 8284: Dim preGCText As String = Left(aSpecInst, startPosAmtUsed - 1)
Line 8285: Dim amtUsed As String = Mid(aSpecInst, startPosAmtUsed, startPosAmtLeft - startPosAmtUsed)
Line 8286: Dim amtLeft As String = Mid(aSpecInst, startPosAmtLeft, startPosLeftText - startPosAmtLeft)
Line 8287: Dim postGCText As String = Right(aSpecInst, ((aSpecInst.Length - startPosLeftText) + 1))
Line 8288:
Line 8289: amtUsed = Trim(Replace(amtUsed, "$", "")) & currencysymbol
Line 8290: amtLeft = Trim(Replace(amtLeft, "$", "")) & currencysymbol
Line 8291:
Line 8292: 'put GC# string back together
Line 8293: aSpecInst = preGCText & amtUsed & " " & amtLeft & " " & postGCText
Line 8294: End If
Line 8295:
Line 8296: If currencysymbol <> "$" Then
Line 8297: aSpecInst = Replace(aSpecInst, "$", currencysymbol)
Line 8298: End If
Line 8299:
Line 8300: End If
Line 8301:
Line 8302: If aSpecInst <> String.Empty Then
Line 8303: dta.Append("<b>" & speclabel & "</b><br />" & Replace(aSpecInst, vbCrLf, "<br />") & vbCrLf)
Line 8304: End If
Line 8305:
Line 8306: ' CUSTOM OPTS
Line 8307: For icount = 1 To 3
Line 8308: Dim newstr As String
Line 8309:
Line 8310: Select Case icount
Line 8311:
Line 8312: Case 1
Line 8313: newstr = UDF1
Line 8314:
Line 8315: Case 2
Line 8316: newstr = UDF2
Line 8317:
Line 8318: Case 3
Line 8319: newstr = UDF3
Line 8320:
Line 8321: End Select
Line 8322:
Line 8323: If newstr <> "" And getxmlval("pmt" & icount) = "" And getxmlval("alpha" & icount) <> "" Then
Line 8324: dta.Append(getxmlval("alpha" & icount) & ": " & newstr & "<br />")
Line 8325: End If
Line 8326: Next
Line 8327:
Line 8328: dta.Append("</td>" & vbCrLf)
Line 8329: dta.Append("</tr>" & vbCrLf)
Line 8330: End If
Line 8331:
Line 8332: Return dta.ToString()
Line 8333: End Function
Line 8334: Function orderInfoConfirmationEnding(orderid As String, dotdot As String, aSubTotal As String) As String
Line 8335: Dim confirmationEndingData As String
Line 8336:
Line 8337: Dim confirmEnd As String = getxmlval("confirmationending")
Line 8338: Dim intSubBegin As Integer = InStr(confirmEnd, "[subtotal.")
Line 8339: Dim intSubEnd As Integer = InStr(confirmEnd, ".percent]")
Line 8340: Dim intSubEntire As Integer = InStr(confirmEnd, "[subtotal.100.percent]")
Line 8341: If intSubEntire > 0 Then
Line 8342: confirmEnd = confirmEnd.Replace("[subtotal.100.percent]", "$" & (FormatNumber((aSubTotal), 2)).ToString())
Line 8343: ElseIf intSubBegin > 0 And intSubEnd > 0 Then
Line 8344: Dim strSubPercent As String = Mid(confirmEnd, intSubBegin + 10, intSubEnd - intSubBegin - 10)
Line 8345: Dim dblSubPercent As Double = CDbl("." & strSubPercent)
Line 8346: confirmEnd = confirmEnd.Replace(".percent]", String.Empty)
Line 8347: confirmEnd = confirmEnd.Replace("[subtotal." & strSubPercent, "$" & (FormatNumber((dblSubPercent * aSubTotal), 2)).ToString())
Line 8348: End If
Line 8349: Dim tempOrderID As String = Session("orderid")
Line 8350: If orderid <> String.Empty Then
Line 8351: tempOrderID = orderid
Line 8352: End If
Line 8353: confirmEnd = SubstituteAccountTokens(confirmEnd, tempOrderID, dotdot)
Line 8354: confirmationEndingData = confirmEnd
Line 8355:
Line 8356:
Line 8357: Return confirmationEndingData
Line 8358: End Function
Line 8359:
Line 8360: Function SubstituteAccountTokens(ByVal original As String, ByVal orderid As String, ByVal dotdot As String) As String
Line 8361: Dim ReturnValue As String = original
Line 8362:
Line 8363: Dim loginid As String = Session("login")
Line 8364: Dim password As String = Session("pwd")
Line 8365: Dim orderDate As String ' = Today()
Line 8366:
Line 8367: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 8368: Dim aOrder As Object = dbservermanager.ecomcall_array(Me.ToString() + " / Function_is_SubstituteAccountTokens", Server.MapPath(dotdot), "getorderinfo", "EORDER", orderid)
Line 8369:
Line 8370: If aOrder.length > 3 Then
Line 8371: loginid = aOrder(4)
Line 8372: orderDate = aOrder(2)
Line 8373:
Line 8374: Dim findpw As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "ForgotPassword", loginid)
Line 8375: If findpw(1) <> "Invalid Login" Then
Line 8376: password = findpw(1)
Line 8377: End If
Line 8378: End If
Line 8379: dbservermanager = Nothing
Line 8380:
Line 8381: Dim pwdMask As String = String.Empty
Line 8382: If password <> String.Empty Then
Line 8383: For pwl As Integer = 1 To password.Length
Line 8384: pwdMask &= "*"
Line 8385: Next
Line 8386: End If
Line 8387: ReturnValue = ReturnValue.Replace("[loginid]", loginid)
Line 8388: ReturnValue = ReturnValue.Replace("[password]", pwdMask)
Line 8389: ReturnValue = ReturnValue.Replace("[orderdate]", orderDate)
Line 8390:
Line 8391: Return ReturnValue
Line 8392: End Function
Line 8393: Private Function gettrackno(ByVal val As Object) As String
Line 8394:
Line 8395: Dim trackno As String = val.ToString
Line 8396: Dim tracklink As String
Line 8397:
Line 8398: If trackno = "NIL" Then
Line 8399: trackno = ""
Line 8400: End If
Line 8401:
Line 8402: If trackno <> "" Then
Line 8403:
Line 8404: Dim i As Integer
Line 8405: Dim newarray As Array
Line 8406: Dim shipvend As String
Line 8407:
Line 8408: newarray = Split(trackno, ",")
Line 8409:
Line 8410: For i = 0 To UBound(newarray)
Line 8411:
Line 8412: If Left(newarray(i), 2) = "1Z" Then
Line 8413: shipvend = "http://wwwapps.ups.com/WebTracking/processInputRequest?tracknum=" & newarray(i)
Line 8414: Else
Line 8415: shipvend = "http://www.fedex.com/Tracking?tracknumbers=" & newarray(i)
Line 8416: End If
Line 8417:
Line 8418: tracklink += "<a target=""track"" href=""" & shipvend & """>" & newarray(i) & "</a><br />"
Line 8419:
Line 8420: Next
Line 8421:
Line 8422: End If
Line 8423:
Line 8424: Return tracklink
Line 8425:
Line 8426: End Function
Line 8427:
Line 8428: Function getShipDesc(ByVal shipdesc As String, ByVal carrier As String) As String
Line 8429:
Line 8430: Dim newdesc As String
Line 8431:
Line 8432: If carrier = "FedEx" Then
Line 8433:
Line 8434: Select Case shipdesc
Line 8435: Case "EUROPE_FIRST_INTERNATIONAL_PRIORITY", "EUROPEFIRSTINTERNATIONALPRIORITY"
Line 8436: newdesc = "FedEx Europe First International Priority"
Line 8437:
Line 8438: Case "FEDEX_1_DAY_FREIGHT", "FEDEX1DAYFREIGHT"
Line 8439: newdesc = "FedEx 1day Freight"
Line 8440:
Line 8441: Case "FEDEX_2_DAY", "FEDEX2DAY"
Line 8442: newdesc = "FedEx 2 day"
Line 8443:
Line 8444: Case "FEDEX_2_DAY_AM"
Line 8445: newdesc = "FedEx 2 day AM"
Line 8446:
Line 8447: Case "FEDEX_2_DAY_FREIGHT", "FEDEX2DAYFREIGHT"
Line 8448: newdesc = "FedEx 2 day Freight"
Line 8449:
Line 8450: Case "FEDEX_3_DAY_FREIGHT", "FEDEX3DAYFREIGHT"
Line 8451: newdesc = "FedEx 3 day Freight"
Line 8452:
Line 8453: Case "FEDEX_EXPRESS_SAVER", "FEDEXEXPRESSSAVER"
Line 8454: newdesc = "FedEx Express Saver"
Line 8455:
Line 8456: Case "FEDEX_GROUND", "FEDEXGROUND"
Line 8457: newdesc = "FedEx Ground Service"
Line 8458:
Line 8459: Case "FIRST_OVERNIGHT", "FIRSTOVERNIGHT"
Line 8460: newdesc = "FedEx First Overnight"
Line 8461:
Line 8462: Case "GROUND_HOME_DELIVERY", "GROUNDHOMEDELIVERY"
Line 8463: newdesc = "FedEx Home Delivery"
Line 8464:
Line 8465: Case "INTERNATIONAL_ECONOMY", "INTERNATIONALECONOMY"
Line 8466: newdesc = "FedEx International Economy"
Line 8467:
Line 8468: Case "INTERNATIONAL_ECONOMY_FREIGHT", "INTERNATIONALECONOMY FREIGHT"
Line 8469: newdesc = "FedEx International Economy Freight"
Line 8470:
Line 8471: Case "INTERNATIONAL_FIRST", "INTERNATIONALFIRST"
Line 8472: newdesc = "FedEx International First"
Line 8473:
Line 8474: Case "INTERNATIONAL_PRIORITY", "INTERNATIONALPRIORITY"
Line 8475: newdesc = "FedEx International Priority"
Line 8476:
Line 8477: Case "INTERNATIONAL_PRIORITY_FREIGHT", "INTERNATIONALPRIORITY FREIGHT"
Line 8478: newdesc = "FedEx International Priority Freight"
Line 8479:
Line 8480: Case "PRIORITY_OVERNIGHT", "PRIORITYOVERNIGHT"
Line 8481: newdesc = "FedEx Priority Overnight"
Line 8482:
Line 8483: Case "SMART_POST"
Line 8484: newdesc = "FedEx Smart Post"
Line 8485:
Line 8486: Case "STANDARD_OVERNIGHT", "STANDARDOVERNIGHT"
Line 8487: newdesc = "FedEx Standard Overnight"
Line 8488:
Line 8489: Case "FEDEX_FREIGHT"
Line 8490: newdesc = "FedEx Freight"
Line 8491:
Line 8492: Case "FEDEX_NATIONAL_FREIGHT"
Line 8493: newdesc = "FedEx National Freight"
Line 8494:
Line 8495: Case "INTERNATIONAL_GROUND"
Line 8496: newdesc = "FedEx International Ground"
Line 8497:
Line 8498: End Select
Line 8499:
Line 8500: ElseIf carrier = "UPS" Then
Line 8501:
Line 8502: Select Case shipdesc
Line 8503:
Line 8504: Case "U01"
Line 8505: newdesc = "UPS Next Day Air"
Line 8506:
Line 8507: Case "U02"
Line 8508: newdesc = "UPS 2nd Day Air"
Line 8509:
Line 8510: Case "U03"
Line 8511: newdesc = "UPS Ground"
Line 8512:
Line 8513: Case "U07"
Line 8514: newdesc = "UPS Worldwide Express"
Line 8515:
Line 8516: Case "U08"
Line 8517: newdesc = "UPS Worldwide Expedited"
Line 8518:
Line 8519: Case "U11"
Line 8520: newdesc = "UPS Standard"
Line 8521:
Line 8522: Case "U12"
Line 8523: newdesc = "UPS 3-Day Select"
Line 8524:
Line 8525: Case "U13"
Line 8526: newdesc = "UPS Next Day Air Saver"
Line 8527:
Line 8528: Case "U14"
Line 8529: newdesc = "UPS AM Early Next Day Air"
Line 8530:
Line 8531: Case "U54"
Line 8532: newdesc = "UPS Worldwide Express Plus"
Line 8533:
Line 8534: Case "U59"
Line 8535: newdesc = "UPS AM 2nd Day Air"
Line 8536:
Line 8537: Case "U65"
Line 8538: newdesc = "UPS Express Saver"
Line 8539:
Line 8540: Case "U92"
Line 8541: newdesc = "UPS SurePost" ' Less Than 1 lb
Line 8542:
Line 8543: Case "U93"
Line 8544: newdesc = "UPS SurePost" ' 1 lb or Greater
Line 8545:
Line 8546: End Select
Line 8547: ElseIf carrier = "USPS" Then
Line 8548:
Line 8549: Select Case shipdesc
Line 8550:
Line 8551: Case "PRIORITY"
Line 8552: newdesc = "Priority Mail"
Line 8553:
Line 8554: Case "USPS RETAIL GROUND"
Line 8555: newdesc = "USPS Retail Ground"
Line 8556: End Select
Line 8557:
Line 8558: End If
Line 8559:
Line 8560: Return newdesc
Line 8561:
Line 8562: End Function
Line 8563:
Line 8564: Public Function setupitemtext() As String
Line 8565: Dim retval As String = "~*setup charge item*~"
Line 8566: If getxmlval("setupitemtext") <> String.Empty Then
Line 8567: retval = getxmlval("setupitemtext")
Line 8568: End If
Line 8569: Return retval
Line 8570: End Function
Line 8571:
Line 8572: Function showValues(ByVal price As Object) As String
Line 8573:
Line 8574: 'NOTE - alot of places still call _function.ascx. Therefore, if change something here, make the same change there. But as come across those situations, try to change to use this call
Line 8575:
Line 8576: Dim cPointsOn As String = getxmlval("pointson")
Line 8577:
Line 8578: 'Session("AppCode_Function_ShowValuesProductType") = getSoftwareProductType()
Line 8579: 'Session("AppCode_Function_ShowValuesPointson") = getxmlval("pointson")
Line 8580:
Line 8581: If cPointsOn = "points" And getSoftwareProductType() = "ASISB" Then
Line 8582: If price = 0 Then
Line 8583: Return price
Line 8584: Else
Line 8585: Return String.Format("{0:#,###}", price)
Line 8586: End If
Line 8587: Else
Line 8588: If (cPointsOn = "points" Or cPointsOn = "pointsallowpaydiff") And IsNumeric(getxmlval("pointconversion")) Then
Line 8589: If price = 0 Then
Line 8590: Return price
Line 8591: Else
Line 8592: If cPointsOn = "pointsallowpaydiff" Then
Line 8593: Return reformatPoints(String.Format("{0:#,###}", price * getxmlval("pointconversion")))
Line 8594: Else
Line 8595: Return String.Format("{0:#,###}", price * getxmlval("pointconversion"))
Line 8596: End If
Line 8597: End If
Line 8598: Else
Line 8599: Return reformatcurrency(FormatCurrency(price, getxmlval("currencyformat")))
Line 8600: End If
Line 8601: End If
Line 8602:
Line 8603: End Function
Line 8604:
Line 8605: Function reformatPoints(ByVal price As Object) As String
Line 8606: Dim currencyLabel As String = getxmlval("currencylabel")
Line 8607:
Line 8608: If getxmlval("currencysymbolplacement") = "afteramt" Or getxmlval("currencysymbol") = "label" And currencyLabel <> String.Empty Then
Line 8609: price = price & " " & currencyLabel
Line 8610: End If
Line 8611:
Line 8612: Return price
Line 8613: End Function
Line 8614:
Line 8615: Function showValuesPointsPayDifference(ByVal price As Object) As String
Line 8616: 'Display already converted Points as a numeric value
Line 8617:
Line 8618: Return reformatPoints(String.Format("{0:#,###}", price))
Line 8619: End Function
Line 8620:
Line 8621: Function showValuesPointsPayDifferenceAmount(ByVal price As Object) As String
Line 8622: 'Display already converted Points as a Dollar Value. Note - this would be for the amount due
Line 8623:
Line 8624: If price > 0 Then
Line 8625: price = FormatCurrency(price)
Line 8626: End If
Line 8627:
Line 8628: Return price
Line 8629: End Function
Line 8630:
Line 8631: Sub FinishSessions()
Line 8632: ' STAY LOGGED IN BUT RESET SESSIONS
Line 8633: If getxmlval("keepsessions") = "Y" And Session("goyopoints") = False Then
Line 8634: killordersessions()
Line 8635: Else
Line 8636: ' RESET ALL SESSIONS
Line 8637: killordersessions()
Line 8638: logtofile("PromoPayment", "session abandoned 5662", False)
Line 8639: Session.Abandon()
Line 8640: End If
Line 8641:
Line 8642: 'GET RID OF PDFNUM SESSION VARIABLES IF PDF SPECIAL IS ON
Line 8643: If getxmlval("pdfspecialon") = "Y" Then
Line 8644: SessionRemoveSelected("pdf")
Line 8645: SessionRemoveSelected("a_pdf")
Line 8646: End If
Line 8647: End Sub
Line 8648:
Line 8649: Sub emptyOrderIdonEORDER()
Line 8650: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 8651:
Line 8652: Session("remove order id") = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateEloginField", Session("login"), Session("progno"), Session("custno"), "Orderid", String.Empty)
Line 8653:
Line 8654: dbservermanager = Nothing
Line 8655: End Sub
Line 8656:
Line 8657: Function countThisInCart(ByVal itemno As String, ByVal subno As String) As Integer
Line 8658: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 8659: Dim foundincart As Integer = 0
Line 8660:
Line 8661: Dim aitem As Object
Line 8662: If Session("GetOrderItemInfo") Is Nothing Then
Line 8663: aitem = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetOrderItemInfo", "ELINITM", Session("orderid"), getxmlval("longcolordesc"))
Line 8664: Session("GetOrderItemInfo") = aitem
Line 8665: Else
Line 8666: aitem = Session("GetOrderItemInfo")
Line 8667: End If
Line 8668: If Not (aitem Is Nothing) Then
Line 8669: For y As Integer = LBound(aitem) To UBound(aitem) - 1
Line 8670: If aitem(y, 3) = itemno And aitem(y, 4) = subno Then
Line 8671: foundincart += aitem(y, 9)
Line 8672: End If
Line 8673: Next
Line 8674: End If
Line 8675: dbservermanager = Nothing
Line 8676:
Line 8677: Return foundincart
Line 8678: End Function
Line 8679:
Line 8680: Function checkreadonly(ByVal tag As String) As String
Line 8681: Dim retval As String = String.Empty
Line 8682: Dim billorship As String = Left(tag, 4)
Line 8683: If getxmlval(billorship & "readonly") = "Y" Or (Not (getxmlval("readonly" & tag) Is Nothing) AndAlso getxmlval("readonly" & tag) = True) Then
Line 8684: 'retval = " readonly"
Line 8685: retval = "readonly="" readonly"""
Line 8686: End If
Line 8687:
Line 8688: Return retval
Line 8689: End Function
Line 8690:
Line 8691: 'Function RestrictNumLineItems() As Boolean
Line 8692: ' Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 8693: ' Dim maxincart As Integer = 99
Line 8694: ' Dim retval As Boolean = True
Line 8695: ' Dim aitem As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetOrderItemInfo", "ELINITM", Session("orderid"), getxmlval("longcolordesc"))
Line 8696: ' Dim finalitem As Integer = UBound(aitem) - 1
Line 8697: ' If finalitem > maxincart Then
Line 8698: ' retval = False
Line 8699: ' Session("badmaxlineitemstxt") = "<font color=""" & Session("errormsgcolor") & """><b><li>The maximum number of line items in the cart is " & maxincart & ". </b></font><br />"
Line 8700: ' Session("errors") += 1
Line 8701: ' End If
Line 8702: ' dbservermanager = Nothing
Line 8703: ' Return retval
Line 8704: 'End Function
Line 8705:
Line 8706: Sub StoreNumLineItems()
Line 8707: Dim dbservermanager = Server.CreateObject(getcomname())
Line 8708: Dim TotalItemsInCart As Integer = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "getorderlineitemcount", "ELINITM", Session("orderid"))
Line 8709: Session("TotalItemsInCart") = TotalItemsInCart
Line 8710:
Line 8711: End Sub
Line 8712: ' MAKES DROP DOWN OPTIONS - VALUES AND DESC ARE SAME
Line 8713: ' val = cv list, sel is selected option
Line 8714: Function makeddl(ByVal val As String, ByVal sel As String) As String
Line 8715:
Line 8716: Dim newarray As Array = Split(val, ",")
Line 8717: Dim retval, selectit As String
Line 8718: Dim i As Integer
Line 8719:
Line 8720: For i = 0 To UBound(newarray)
Line 8721:
Line 8722: If sel = Trim(newarray(i)) Then
Line 8723: selectit = " selected=""selected"" "
Line 8724: Else
Line 8725: selectit = ""
Line 8726: End If
Line 8727:
Line 8728: retval += "<option value=""" & Trim(newarray(i)) & """" & selectit & ">" & Trim(newarray(i)) & "</option>" & vbCrLf
Line 8729:
Line 8730: Next
Line 8731:
Line 8732: Return retval
Line 8733:
Line 8734: End Function
Line 8735:
Line 8736: Function removertcomma(ByVal val As String) As String
Line 8737:
Line 8738: If Right(val, 1) = "," Then
Line 8739: val = Left(val, Len(val) - 1)
Line 8740: End If
Line 8741:
Line 8742: Return val
Line 8743:
Line 8744: End Function
Line 8745:
Line 8746:
Line 8747: Public Function getsortname(ByVal sortby As String, ByVal sortorder As String) As String
Line 8748: Dim namesort As String
Line 8749: Dim prefix As String = "<b>You Are Sorting By</b>:"
Line 8750: Dim retSortOrder As String = ", Ascending"
Line 8751: If sortorder = "descend" Then
Line 8752: retSortOrder = ", Descending"
Line 8753: End If
Line 8754: Select Case sortby
Line 8755: Case "webtrack"
Line 8756: namesort = "Order #"
Line 8757:
Line 8758: Case "odate"
Line 8759: namesort = "Order Date"
Line 8760:
Line 8761: Case "status"
Line 8762: namesort = "Status"
Line 8763:
Line 8764: Case "custpo"
Line 8765: namesort = "Customer PO#"
Line 8766:
Line 8767: Case "invoice"
Line 8768: namesort = "Invoice"
Line 8769:
Line 8770: Case "item"
Line 8771: namesort = "1st Item"
Line 8772:
Line 8773: Case "desc"
Line 8774: namesort = "Description"
Line 8775:
Line 8776: Case "tracking"
Line 8777: namesort = "Tracking #"
Line 8778:
Line 8779: Case "sdate"
Line 8780: namesort = "Ship Date"
Line 8781:
Line 8782: End Select
Line 8783: Return prefix & namesort & retSortOrder
Line 8784: End Function
Line 8785: Sub EraseCC()
Line 8786: Dim dbservermanager As Object
Line 8787:
Line 8788: Dim xy As Object = Server.CreateObject("asiec5.object")
Line 8789: dbservermanager = Server.CreateObject(getcomname())
Line 8790:
Line 8791: If Session("svlev1") = String.Empty And Session("orderid") <> String.Empty And Session("mappath") <> String.Empty Then
Line 8792: Dim clearstatus As Object = dbservermanager.ecomcall_single(Me.ToString(), Session("mappath"), "ClearCreditCardInfo", Session("orderid"))
Line 8793: End If
Line 8794: dbservermanager = Nothing
Line 8795: End Sub
Line 8796:
Line 8797: Function endqtyprice() As String
Line 8798:
Line 8799: Select Case (getxmlval("endqtyprice"))
Line 8800:
Line 8801: Case "login"
Line 8802: Return Session("custno")
Line 8803:
Line 8804: Case "site"
Line 8805: Return getxmlval("scust")
Line 8806:
Line 8807: Case Else
Line 8808: Return ""
Line 8809:
Line 8810: End Select
Line 8811:
Line 8812: End Function
Line 8813: Function RepCharsInFilename(ByVal origFilename As String) As String
Line 8814: Dim altFilename As String = origFilename
Line 8815: altFilename = altFilename.Replace("\", "-bslash-")
Line 8816: altFilename = altFilename.Replace("/", "-slash-")
Line 8817: altFilename = altFilename.Replace(":", "-colon-")
Line 8818: altFilename = altFilename.Replace("*", "-asterisk-")
Line 8819: altFilename = altFilename.Replace("?", "-question-")
Line 8820: altFilename = altFilename.Replace("""", "-dquote-")
Line 8821: altFilename = altFilename.Replace("<", "-lessthan-")
Line 8822: altFilename = altFilename.Replace(">", "-greaterthan-")
Line 8823: altFilename = altFilename.Replace("|", "-pipe-")
Line 8824: If getSoftwareProductType() = "ASISB" Then
Line 8825: altFilename = altFilename.Replace(" ", "_")
Line 8826: End If
Line 8827: Return altFilename
Line 8828: End Function
Line 8829:
Line 8830: Public Sub SendDownloadablesEmails(ByVal orderid As String, ByVal email As String)
Line 8831: Dim dlFolder As String = getxmlval("downloadablesfolder")
Line 8832: Dim Dir As Directory
Line 8833: Dim strDLFiles As String() = Dir.GetFiles(dlFolder)
Line 8834: Dim url As String = "http://" & r1.Request.ServerVariables("SERVER_NAME") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 8835: url = Left(url, InStrRev(url, "/"))
Line 8836: Dim https As String = r1.Request.ServerVariables("HTTPS")
Line 8837: url = replaceHTTPS(url)
Line 8838:
Line 8839: Dim FilesAndExt() As String
Line 8840: Dim lCount As Integer = -1
Line 8841:
Line 8842: For Each f As String In strDLFiles
Line 8843: Dim lastslash As Integer = f.Length - InStrRev(f, "\")
Line 8844: Dim FileNameAndExt As String = Right(f, lastslash)
Line 8845: lCount = lCount + 1
Line 8846: ReDim Preserve FilesAndExt(lCount)
Line 8847: FilesAndExt(lCount) = FileNameAndExt
Line 8848: Next
Line 8849:
Line 8850: Dim dlPrefix As String = getxmlval("downloadableitemnumberprefix")
Line 8851: Dim PrefixLen As Integer = Len(dlPrefix)
Line 8852: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 8853: 'GET THE LIST OF ITEMS IN THE CART
Line 8854: Dim aitem As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetOrderItemInfo", "ELINITM", Session("orderid"), getxmlval("longcolordesc"))
Line 8855:
Line 8856: If Not (aitem Is Nothing) Then
Line 8857: 'loop through all the items in the cart
Line 8858: For y As Integer = LBound(aitem) To UBound(aitem) - 1
Line 8859: Dim itemno As String = aitem(y, 3)
Line 8860: If Left(itemno, PrefixLen) = dlPrefix Then
Line 8861: 'we found an item with the prefix in the cart
Line 8862: Dim itLen As Integer = itemno.Length
Line 8863:
Line 8864: If Not (FilesAndExt Is Nothing) Then
Line 8865: For z As Integer = 0 To FilesAndExt.Length - 1
Line 8866: If UCase(Left(FilesAndExt(z), itLen)) = UCase(itemno) Then
Line 8867: 'the filename matches the item number
Line 8868: Dim timestamp As String = System.DateTime.Now.ToString("HH:mm:ss_MM/dd/yyyy")
Line 8869: Dim rawval As String = itemno & timestamp & getxmlval("secretkeyfordownloadables")
Line 8870: Dim strInts As String = getxmlval("bytearrayfordownloadables")
Line 8871: Dim bytIV() As Byte = stringToByteArray(strInts)
Line 8872: Session("bytArray") = bytIV
Line 8873: Dim val1 As String = EncryptString128Bit(rawval, getxmlval("secretkeyfordownloadables"))
Line 8874: Dim body As String = "<a href=""" & url & "downloads.aspx?itemno=" & itemno & "×tamp=" & timestamp & "&val1=" & val1 & """ >" & itemno & "</a><br /><br /> Thank you. "
Line 8875: emailsend(email, "Your Downloadable Item: " & itemno, getxmlval("emailfrom"), getxmlval("emailfromname"), body, Nothing, Nothing, "STANDARD", "STANDARD", "STANDARD", "STANDARD", Nothing)
Line 8876: End If
Line 8877: Next
Line 8878: End If
Line 8879: End If
Line 8880: Next
Line 8881: End If
Line 8882:
Line 8883:
Line 8884: dbservermanager = Nothing
Line 8885: End Sub
Line 8886: Public Function stringToByteArray(ByVal str As String) As Byte()
Line 8887: Dim s As String()
Line 8888: s = str.Split(",")
Line 8889: Dim b(s.Length - 1) As Byte
Line 8890: Dim i As Integer
Line 8891: For i = 0 To s.Length - 1
Line 8892: b(i) = Convert.ToByte(s(i))
Line 8893: Next
Line 8894: Return b
Line 8895: End Function
Line 8896:
Line 8897: Function POSTdata(ByVal pURL As String, ByVal data As String, Optional ByVal ConType As String = "application/x-www-form-urlencoded") As String
Line 8898:
Line 8899: Dim theURL As New Uri(pURL)
Line 8900: Dim theHttpWebRequest As HttpWebRequest = WebRequest.Create(theURL)
Line 8901:
Line 8902: theHttpWebRequest.ContentLength = data.Length
Line 8903: 'theHttpWebRequest.ContentType = "application/x-www-form-urlencoded"
Line 8904: theHttpWebRequest.ContentType = ConType
Line 8905: theHttpWebRequest.Method = WebRequestMethods.Http.Post
Line 8906: theHttpWebRequest.Timeout = 10000
Line 8907: Dim writer As New StreamWriter(theHttpWebRequest.GetRequestStream())
Line 8908: writer.Write(data)
Line 8909: writer.Close()
Line 8910: Dim httpresponse As HttpWebResponse = theHttpWebRequest.GetResponse()
Line 8911: Dim reader As StreamReader = New StreamReader(httpresponse.GetResponseStream())
Line 8912: Dim resp As String = reader.ReadToEnd()
Line 8913:
Line 8914: httpresponse.Close()
Line 8915:
Line 8916: Return resp
Line 8917: End Function
Line 8918:
Line 8919: Function sendXMLRequest(ByVal uri As String, ByVal xmlRequest As XmlDocument) As String
Line 8920: 'Dim uri As String = "https://secure.nmi.com/api/transact"
Line 8921: Dim req As WebRequest = WebRequest.Create(uri)
Line 8922: 'req.Proxy = WebProxy.GetDefaultProxy(); // Enable if using proxy
Line 8923: req.Method = "POST"
Line 8924: ' Post method
Line 8925: req.ContentType = "text/xml"
Line 8926: ' content type
Line 8927: ' Wrap the request stream with a text-based writer
Line 8928: Dim writer As New StreamWriter(req.GetRequestStream())
Line 8929: ' Write the XML text into the stream
Line 8930: 'writer.WriteLine(this.GetTextFromXMLFile(fileName));
Line 8931: xmlRequest.Save(writer)
Line 8932: 'xmlRequest.
Line 8933: writer.Close()
Line 8934: ' Send the data to the webserver
Line 8935: Dim rsp As WebResponse = req.GetResponse()
Line 8936:
Line 8937: Dim dataStream As Stream = rsp.GetResponseStream()
Line 8938: ' Open the stream using a StreamReader
Line 8939: Dim reader As New StreamReader(dataStream)
Line 8940: ' Read the content.
Line 8941: Dim responseFromServer As String = reader.ReadToEnd()
Line 8942:
Line 8943: ' int index = responseFromServer.IndexOf("<?");
Line 8944: 'string substr = responseFromServer.Substring(index);
Line 8945: ' Display the content.
Line 8946: 'MessageBox.Show(responseFromServer);
Line 8947: ' Clean up the streams.
Line 8948:
Line 8949: reader.Close()
Line 8950: dataStream.Close()
Line 8951: rsp.Close()
Line 8952:
Line 8953: Return responseFromServer
Line 8954:
Line 8955: End Function
Line 8956: Function CheckItemChanged(ByVal comMethod As String, ByVal itemno As String, ByVal subno As String, ByVal itCustno As String) As Boolean
Line 8957: Dim ItemHasChanged As Boolean = False
Line 8958: itemno = Trim(itemno)
Line 8959: subno = Trim(subno)
Line 8960: Try
Line 8961: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 8962: Dim itemModDT As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "getmodifieddatetime", itemno, subno, itCustno)
Line 8963:
Line 8964: If UBound(itemModDT) > 1 Then
Line 8965: Dim itModDate As String = itemModDT(1)
Line 8966: Dim itModTime As String = itemModDT(2)
Line 8967: If IsDate(itModDate & " " & itModTime) Then
Line 8968: Dim dtModDate As DateTime = CDate(itModDate & " " & itModTime)
Line 8969: Dim inCurModDate As Integer = DateTimeToEpoch(dtModDate)
Line 8970: If Session(comMethod & "-ModDate:" & itemno & subno & "|" & itCustno) Is Nothing Then
Line 8971: ItemHasChanged = True
Line 8972: Else
Line 8973: Dim inPrevModDate As Integer = Session(comMethod & "-ModDate:" & itemno & subno & "|" & itCustno)
Line 8974: If inCurModDate > inPrevModDate Then
Line 8975: ItemHasChanged = True
Line 8976: End If
Line 8977: End If
Line 8978: End If
Line 8979: If ItemHasChanged = True Then
Line 8980: setLastMod(comMethod, itemno, subno, itCustno, itModDate, itModTime)
Line 8981: End If
Line 8982: End If
Line 8983: dbservermanager = Nothing
Line 8984: Catch ex As Exception
Line 8985: ItemHasChanged = True
Line 8986: End Try
Line 8987:
Line 8988: Return ItemHasChanged
Line 8989:
Line 8990: End Function
Line 8991: Sub setLastMod(ByVal comMethod As String, ByVal itemno As String, ByVal subno As String, ByVal itCustno As String, ByVal modDate As String, ByVal modTime As String)
Line 8992: Dim dtModDate As DateTime
Line 8993: Dim inModDate As Integer
Line 8994: If modDate = "GETMOD" And modTime = "GETMOD" Then
Line 8995: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 8996: Dim itemModDT As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "getmodifieddatetime", itemno, subno, itCustno)
Line 8997: dbservermanager = Nothing
Line 8998: If UBound(itemModDT) > 1 And IsDate(itemModDT(1) & " " & itemModDT(2)) Then
Line 8999: dtModDate = CDate(itemModDT(1) & " " & itemModDT(2))
Line 9000: inModDate = DateTimeToEpoch(dtModDate)
Line 9001: Session(comMethod & "-ModDate:" & itemno & subno & "|" & itCustno) = inModDate
Line 9002: End If
Line 9003: ElseIf IsDate(modDate & " " & modTime) Then
Line 9004: dtModDate = CDate(modDate & " " & modTime)
Line 9005: inModDate = DateTimeToEpoch(dtModDate)
Line 9006: Session(comMethod & "-ModDate:" & itemno & subno & "|" & itCustno) = inModDate
Line 9007: End If
Line 9008: End Sub
Line 9009:
Line 9010: 'Public Function GetOrdersDir() As String
Line 9011: ' Dim retval As String = String.Empty
Line 9012: ' If Session("ordersdir") = String.Empty Then
Line 9013: ' Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9014: ' retval = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE", "DATAPATH", "c:\ecommerce\orders")
Line 9015: ' dbservermanager = Nothing
Line 9016: ' Session("ordersdir") = retval
Line 9017: ' Else
Line 9018: ' retval = Session("ordersdir")
Line 9019: ' End If
Line 9020: ' Return retval
Line 9021: 'End Function
Line 9022: Public Function DateTimeToEpoch(ByVal DateTimeValue As Date) As Integer
Line 9023: '
Line 9024: Try
Line 9025: Return CInt(DateTimeValue.Subtract(CDate("1.1.1970 00:00:00")).TotalSeconds)
Line 9026: Catch ex As System.OverflowException
Line 9027: Return -1
Line 9028: End Try
Line 9029:
Line 9030: End Function
Line 9031: Function getMIMEtype(ByVal fileLOC As String) As String
Line 9032: Dim ext As String = LCase(Path.GetExtension(fileLOC))
Line 9033: Dim mType As String = "application/unknown"
Line 9034: Dim regKey As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.ClassesRoot.OpenSubKey(ext)
Line 9035: If Not (regKey Is Nothing) AndAlso Not (regKey.GetValue("ContentType") Is Nothing) Then
Line 9036: mType = regKey.GetValue("Content Type").ToString()
Line 9037: End If
Line 9038: Return mType
Line 9039: End Function
Line 9040:
Line 9041: Function getCurrencyCode(ByVal Country As String) As String
Line 9042: Dim retval As String = String.Empty
Line 9043: Country = UCase(Country)
Line 9044: Select Case Country
Line 9045: Case "US", "UNITED STATES", "UNITED STATES OF AMERICA", "USA"
Line 9046: retval = "840"
Line 9047: Case "CA", "CANADA"
Line 9048: retval = "124"
Line 9049: End Select
Line 9050: Return retval
Line 9051: End Function
Line 9052:
Line 9053: Function replaceHTTPS(ByVal url As String) As String
Line 9054: Dim https As String = r1.Request.ServerVariables("HTTPS")
Line 9055: If https = "on" Then
Line 9056: url = url.Replace("http://", "https://")
Line 9057: End If
Line 9058:
Line 9059: Return url
Line 9060:
Line 9061: End Function
Line 9062:
Line 9063: Function baseurl() As String
Line 9064: Dim retval As String
Line 9065:
Line 9066: If getxmlval("allssl") = "Y" Or r1.Request.ServerVariables("HTTPS") = "on" Then
Line 9067: retval = "https://" & r1.Request.ServerVariables("SERVER_NAME") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 9068: Else
Line 9069: If r1.Request.ServerVariables("SERVER_PORT") = 80 Or r1.Request.ServerVariables("SERVER_PORT") = 8080 Then
Line 9070: retval = "http://" & r1.Request.ServerVariables("SERVER_NAME") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 9071: Else
Line 9072: retval = "http://" & r1.Request.ServerVariables("SERVER_NAME") & ":" & r1.Request.ServerVariables("SERVER_PORT") & r1.Request.ServerVariables("SCRIPT_NAME")
Line 9073: End If
Line 9074: End If
Line 9075:
Line 9076:
Line 9077: retval = Left(retval, InStrRev(retval, "/"))
Line 9078: Return retval
Line 9079: End Function
Line 9080:
Line 9081: Function SendProblemEmail(ByVal subject As String, ByVal body As String) As Boolean
Line 9082: If getxmlval("emailproblems") <> String.Empty Then
Line 9083:
Line 9084: Dim ems As Object = emailsend(getxmlval("emailproblems"), subject, getxmlval("emailfrom"), getxmlval("emailfromname"), body, String.Empty, String.Empty, "STANDARD", "STANDARD", "STANDARD", "STANDARD", Nothing)
Line 9085:
Line 9086: End If
Line 9087: End Function
Line 9088:
Line 9089: Function formtext(ByVal page As String, ByVal location As String, ByVal priortext As String, ByVal aftertext As String) As String
Line 9090: Dim finalText As String = String.Empty
Line 9091: Dim stackvertically As Boolean = False
Line 9092: If getxmlval("formbuttonsstackvertically") = "Y" Then
Line 9093: stackvertically = True
Line 9094: End If
Line 9095: For x As Integer = 1 To getxmlval("numberofforms")
Line 9096: Dim formno As String = x
Line 9097: If x = 1 Then
Line 9098: formno = String.Empty
Line 9099: End If
Line 9100:
Line 9101: If getxmlval("form" & formno & "show" & page) = location Then
Line 9102: If stackvertically Then
Line 9103: finalText &= "<div>"
Line 9104: End If
Line 9105: finalText &= priortext & Session("form" & formno & "collectbutton") & aftertext
Line 9106: If stackvertically Then
Line 9107: finalText &= "</div>"
Line 9108: End If
Line 9109: End If
Line 9110: Next
Line 9111: Return finalText
Line 9112: End Function
Line 9113:
Line 9114: Function jqzoom() As String
Line 9115: Dim jq As New StringBuilder()
Line 9116:
Line 9117: jq.Append("<script src=""js/jquery-1.6.js"" type=""text/javascript""></script>")
Line 9118: jq.Append("<script src=""js/jquery.jqzoom-core.js"" type=""text/javascript""></script>")
Line 9119:
Line 9120: jq.Append("<link rel=""stylesheet"" href=""css/jquery.jqzoom.css"" type=""text/css"">")
Line 9121: jq.Append("<style type""text/css"">")
Line 9122:
Line 9123: jq.Append("a img,:link img,:visited img { border: none; }")
Line 9124:
Line 9125: jq.Append(":focus { outline: none; }")
Line 9126:
Line 9127: jq.Append("blockquote, dd, dt{margin:0 0 8px 0;line-height:1.5em;}")
Line 9128: jq.Append("fieldset {padding:0px;padding-left:7px;padding-right:7px;padding-bottom:7px;}")
Line 9129: jq.Append("fieldset legend{margin-left:15px;padding-left:3px;padding-right:3px;color:#333;}")
Line 9130: jq.Append("dl dd{margin:0px;}")
Line 9131: jq.Append("dl dt{}")
Line 9132:
Line 9133: jq.Append(".clearfix:after{clear:both;content:""."";display:block;font-size:0;height:0;line-height:0;visibility:hidden;}")
Line 9134: jq.Append(".clearfix{display:block;zoom:1}")
Line 9135:
Line 9136: jq.Append("ul#thumblist{display:block;}")
Line 9137: jq.Append("ul#thumblist li{float:left;margin-right:2px;list-style:none;}")
Line 9138: jq.Append("ul#thumblist li a{display:block;border:1px solid #CCC;}")
Line 9139: jq.Append("ul#thumblist li a.zoomThumbActive{")
Line 9140: jq.Append("border:1px solid red;")
Line 9141: jq.Append("}")
Line 9142:
Line 9143: jq.Append(".jqzoom{")
Line 9144:
Line 9145: jq.Append("text-decoration:none;")
Line 9146: jq.Append("float:left;")
Line 9147: jq.Append("}")
Line 9148:
Line 9149: jq.Append("</style>")
Line 9150: jq.Append("<script type=""text/javascript"">")
Line 9151:
Line 9152: jq.Append("$(document).ready(function() {")
Line 9153: jq.Append("$('.jqzoom').jqzoom({")
Line 9154: jq.Append("zoomType: 'innerzoom',")
Line 9155: jq.Append("preloadImages: false,")
Line 9156: jq.Append("alwaysOn:false")
Line 9157: jq.Append(" });")
Line 9158: jq.Append("});")
Line 9159: jq.Append("</script>")
Line 9160:
Line 9161:
Line 9162: jq.Append("<!-- Cloud Zoom -->")
Line 9163: jq.Append("<link href=""styles/cloud-zoom.css"" rel=""stylesheet"" type=""text/css"" />")
Line 9164: jq.Append("<script type=""text/JavaScript"" src=""js/cloud-zoom.1.0.2.min.js""></script>")
Line 9165:
Line 9166: Return jq.ToString()
Line 9167: End Function
Line 9168:
Line 9169: Function quizzesWaiting(ByVal dept As String, ByVal login As String) As Array
Line 9170:
Line 9171: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9172: Dim getQuizzes As Array = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetQuizzesAvailableForEmployee", Session("dept"), getxmlval("quizdeptspecific"))
Line 9173:
Line 9174: Dim keptQuizzes As New List(Of String)
Line 9175: Dim retakesperquiz As Integer = CInt(getxmlval("retakesperquiz"))
Line 9176: If Not getQuizzes Is Nothing Then
Line 9177:
Line 9178:
Line 9179: For x As Integer = LBound(getQuizzes) To UBound(getQuizzes)
Line 9180: If getQuizzes.Rank = 1 Then
Line 9181: Exit For
Line 9182: End If
Line 9183: Dim quiz As String = getQuizzes(x, 1)
Line 9184: Dim includeThisQuiz As Boolean = False
Line 9185: Dim quizAttempts As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetQuizResults", quiz, Session("dept"), Session("empid"))
Line 9186:
Line 9187: 'THE CONSUMER HAS TAKEN THIS TEST BEFORE
Line 9188: If quizAttempts(1) <> "ERROR Employee/dept/quiz does not exist in Quizrslt" Then
Line 9189:
Line 9190: If quizAttempts(1) = quiz AndAlso Trim(quizAttempts(5)) = "Fail" AndAlso quizAttempts(6) = 0 Then
Line 9191: If retakesperquiz > quizAttempts(4) - 1 Then
Line 9192: includeThisQuiz = True
Line 9193: End If
Line 9194: End If
Line 9195: 'THE CONSUMER HAS NOT TAKEN THIS TEST BEFORE, THEY CAN TAKE IT NOW
Line 9196: Else
Line 9197: includeThisQuiz = True
Line 9198: End If
Line 9199: If includeThisQuiz = True Then
Line 9200: keptQuizzes.Add(quiz)
Line 9201: End If
Line 9202: ' session("quizEarnPoints") =
Line 9203: Next
Line 9204: End If
Line 9205: Return keptQuizzes.ToArray
Line 9206: End Function
Line 9207: Sub checkEmployeePoints(ByVal custno As String, ByVal empid As String, ByVal dots As String)
Line 9208: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9209: Dim pointcustno As String
Line 9210:
Line 9211: If getxmlval("pointsnocustno") = "Y" And Session("custno") = 0 Then
Line 9212: pointcustno = getxmlval("scust")
Line 9213: Else
Line 9214: pointcustno = custno
Line 9215: End If
Line 9216:
Line 9217: If getSoftwareProductType() = "ASISB" Then
Line 9218: Session("GetEmployeePoints") = ecomwrapperCheckCustomerPointsValid(pointcustno, getxmlval("sprogram"), IIf(empid = "", "_", empid))
Line 9219: 'Session("TEMPDebug_GetEmployeePoints1") = Session("GetEmployeePoints")(1)
Line 9220:
Line 9221: If InStr(Session("GetEmployeePoints")(1), "InvalidPointsLogin") = 0 Then
Line 9222: Session("GetEmployeePoints") = ecomwrapperGetPointsByCustomerPoints(pointcustno, getxmlval("sprogram"), IIf(empid = "", "_", empid))
Line 9223: Session("availpoints") = Session("GetEmployeePoints")(1)
Line 9224: End If
Line 9225: Else
Line 9226: Session("GetEmployeePoints") = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dots), "GetEmployeePoints", pointcustno, empid)
Line 9227: End If
Line 9228:
Line 9229: If getSoftwareProductType() <> "ASISB" Then
Line 9230: If InStr(Session("GetEmployeePoints")(1), "no user") = 0 Then
Line 9231: If getxmlval("pointson") = "dollars" Then
Line 9232: Session("availpoints") = Session("GetEmployeePoints")(1) / getxmlval("pointconversion")
Line 9233: Else
Line 9234: Session("availpoints") = Session("GetEmployeePoints")(1)
Line 9235: End If
Line 9236: End If
Line 9237: End If
Line 9238:
Line 9239: dbservermanager = Nothing
Line 9240: End Sub
Line 9241:
Line 9242: Function ecomwrapperGetPointsByCustomerPoints(customerNumber As String, program As String, employeeID As String) As Object
Line 9243: Dim ecomWrap As EcommWrapper = New EcommWrapper()
Line 9244: Dim getPointsResults As Object
Line 9245:
Line 9246: Try
Line 9247: getPointsResults = ecomWrap.GetPointsByCustomerPoints(customerNumber, program, employeeID)
Line 9248: 'Session("TEMPDebug_getPointsResults") = getPointsResults(1)
Line 9249: Catch ex As Exception
Line 9250:
Line 9251: End Try
Line 9252:
Line 9253: Return getPointsResults
Line 9254: End Function
Line 9255:
Line 9256: Function ecomwrapperCheckCustomerPointsValid(customerNumber As String, program As String, employeeID As String) As Object
Line 9257: Dim ecomWrap As EcommWrapper = New EcommWrapper()
Line 9258: Dim checkCustPointsValid As Object
Line 9259:
Line 9260: Try
Line 9261: checkCustPointsValid = ecomWrap.CheckCustomerPointsValid(customerNumber, program, employeeID)
Line 9262: 'Session("TEMPDebug_checkCustPointsValid") = checkCustPointsValid(1)
Line 9263: Catch ex As Exception
Line 9264:
Line 9265: End Try
Line 9266:
Line 9267: Return checkCustPointsValid
Line 9268: End Function
Line 9269:
Line 9270: Function QuizTriesLeft(ByVal dept As String, ByVal login As String, ByVal quiz As String) As Integer
Line 9271: Dim triesLeft As Integer = 0
Line 9272: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9273: Dim getQuizzes As Array = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetQuizzesAvailableForEmployee", Session("dept"), getxmlval("quizdeptspecific"))
Line 9274:
Line 9275: Dim retakesperquiz As Integer = CInt(getxmlval("retakesperquiz"))
Line 9276: If Not getQuizzes Is Nothing AndAlso getQuizzes.Rank = 2 Then
Line 9277:
Line 9278: For x As Integer = LBound(getQuizzes) To UBound(getQuizzes)
Line 9279:
Line 9280: If Trim(quiz) = Trim(getQuizzes(x, 1)) Then
Line 9281: Dim quizAttempts As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetQuizResults", quiz, Session("dept"), Session("empid"))
Line 9282: 'THE CONSUMER HAS TAKEN THIS TEST BEFORE
Line 9283: If quizAttempts(1) <> "ERROR Employee/dept/quiz does not exist in Quizrslt" Then
Line 9284:
Line 9285: If Trim(quizAttempts(1)) = Trim(quiz) AndAlso Trim(quizAttempts(5)) = "Fail" AndAlso quizAttempts(6) = 0 Then
Line 9286: triesLeft = retakesperquiz + 1 - quizAttempts(4)
Line 9287: End If
Line 9288: 'THE CONSUMER HAS NOT TAKEN THIS TEST BEFORE, THEY CAN TAKE IT NOW
Line 9289: Else
Line 9290: triesLeft = retakesperquiz + 1
Line 9291: End If
Line 9292: Exit For
Line 9293: End If
Line 9294: Next
Line 9295: End If
Line 9296:
Line 9297: Return triesLeft
Line 9298: End Function
Line 9299:
Line 9300: Public Shared Function FindControlRecursive(container As Control, name As String) As Control
Line 9301: If (container.ID IsNot Nothing) AndAlso (container.ID.Equals(name)) Then
Line 9302:
Line 9303: Return container
Line 9304: End If
Line 9305:
Line 9306: For Each ctrl As Control In container.Controls
Line 9307: Dim foundCtrl As Control = FindControlRecursive(ctrl, name)
Line 9308: If foundCtrl IsNot Nothing Then
Line 9309: Return foundCtrl
Line 9310: End If
Line 9311: Next
Line 9312: Return Nothing
Line 9313: End Function
Line 9314: Sub getHighQuestion()
Line 9315: Dim highQ As Integer = 0
Line 9316: For Each x As String In Session.Contents
Line 9317: Dim xLength As Integer = x.Length
Line 9318: If Not (Session.Contents(x) Is Nothing) And xLength > 8 Then
Line 9319:
Line 9320: Dim possNum As String = Right(x, xLength - 8)
Line 9321: If Left(x, 8) = "question" And Session("qanswer" & possNum) <> String.Empty Then
Line 9322:
Line 9323: If CInt(possNum) > highQ Then
Line 9324: highQ = CInt(possNum)
Line 9325: End If
Line 9326:
Line 9327: End If
Line 9328: End If
Line 9329: Next
Line 9330:
Line 9331: Session("highQ") = highQ
Line 9332: End Sub
Line 9333: 'SIG stands for Selectable Image Matrix
Line 9334: Function updateSIMfolder(ByVal simPath As String) As Boolean
Line 9335: Dim success As Boolean = True
Line 9336: If simPath <> String.Empty Then
Line 9337:
Line 9338: Dim pdfnogroups As Integer = getxmlval("pdfnogroups")
Line 9339: Dim grouplist As New List(Of String)
Line 9340: Dim pdfnoimagelocs As Integer = getxmlval("pdfnoimagelocs")
Line 9341: Dim loclist As New List(Of String)
Line 9342: Dim folderlist As New List(Of String)
Line 9343: Try
Line 9344:
Line 9345: For gr As Integer = 1 To pdfnogroups
Line 9346: If getxmlval("pdfgrouplabel" & gr) <> String.Empty Then
Line 9347: grouplist.Add(getxmlval("pdfgrouplabel" & gr))
Line 9348: End If
Line 9349: Next
Line 9350:
Line 9351: For lc As Integer = 1 To pdfnoimagelocs
Line 9352: If getxmlval("pdfimagelocname" & lc) <> String.Empty Then
Line 9353: loclist.Add(getxmlval("pdfimagelocname" & lc))
Line 9354: End If
Line 9355: Next
Line 9356:
Line 9357: For Each Group As String In grouplist
Line 9358: For Each Loc As String In loclist
Line 9359: folderlist.Add(UCase(Group & "_" & Loc))
Line 9360: Next
Line 9361: Next
Line 9362:
Line 9363: Dim di As New IO.DirectoryInfo(simPath)
Line 9364: If di.Exists = False Then
Line 9365: di.Create()
Line 9366: End If
Line 9367:
Line 9368: For Each Group As String In grouplist
Line 9369: For Each Loc As String In loclist
Line 9370: di.CreateSubdirectory(UCase(Group & "_" & Loc))
Line 9371: Next
Line 9372: Next
Line 9373: Catch ex As Exception
Line 9374: success = False
Line 9375: Session("eBuildererror") = "The value for 'Selectable Image Matrix Folder' was not valid. Check permissions on the folder."
Line 9376: End Try
Line 9377: Else
Line 9378: success = False
Line 9379: End If
Line 9380: Return success
Line 9381:
Line 9382: End Function
Line 9383:
Line 9384: Function getImageAttribute(ByVal imagePath As String, ByVal attrib As String) As String
Line 9385: Dim retval As String = String.Empty
Line 9386: Try
Line 9387: Dim i As Image = Image.FromFile(Server.MapPath(imagePath), False)
Line 9388: If attrib = "height" Then
Line 9389: retval = i.Height
Line 9390: ElseIf attrib = "width" Then
Line 9391: retval = i.Width
Line 9392: End If
Line 9393: Catch ex As Exception
Line 9394:
Line 9395: End Try
Line 9396:
Line 9397:
Line 9398:
Line 9399: Return retval
Line 9400: End Function
Line 9401:
Line 9402: Function isFirstOrder(ByVal loginid As String, ByVal program As String) As Boolean
Line 9403: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9404: Dim firstOrder As Boolean = False
Line 9405:
Line 9406: 'check EORDER for any orders
Line 9407: Dim CheckIfFirstOrder As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "CheckIfFirstOrder", Session("login"), program, getxmlval("svspecialon"))
Line 9408:
Line 9409: If CheckIfFirstOrder = "Y" Then
Line 9410: firstOrder = True
Line 9411: End If
Line 9412:
Line 9413: dbservermanager = Nothing
Line 9414:
Line 9415: Return firstOrder
Line 9416: End Function
Line 9417:
Line 9418: Function specialOn(ByVal dots As String, ByVal code As String) As Boolean
Line 9419: Dim pdfselectableimageson As Boolean = False
Line 9420:
Line 9421: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9422: Dim strSpecialOn As String = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(dots), "CheckECommerceSpecial", code)
Line 9423: If strSpecialOn = "T" Then
Line 9424: pdfselectableimageson = True
Line 9425: End If
Line 9426: dbservermanager = Nothing
Line 9427:
Line 9428: Return pdfselectableimageson
Line 9429:
Line 9430: End Function
Line 9431:
Line 9432: Sub delmc(ByVal itemstring As String)
Line 9433:
Line 9434: Dim st As System.Diagnostics.StackTrace
Line 9435: Dim sf As System.Diagnostics.StackFrame
Line 9436:
Line 9437:
Line 9438: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9439: Dim orderid As String = Session("orderid")
Line 9440: Dim itemcustno = Session("itemcust")
Line 9441: Dim aP As Object
Line 9442: Dim itemno As String
Line 9443: Dim arItems As String() = {itemstring}
Line 9444: If InStr(itemstring, ",") > 0 Then
Line 9445: arItems = itemstring.Split(",")
Line 9446: End If
Line 9447: For Each itemno In arItems
Line 9448: If itemno <> String.Empty Then
Line 9449: If (getxmlval("freeitem") <> String.Empty And itemno = getxmlval("freeitem")) Then
Line 9450: st = New StackTrace(New StackFrame(True))
Line 9451: aP = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "DeleteThisItem", orderid, itemno, itemcustno, "0.001", "N")
Line 9452: ElseIf (getxmlval("firstfreeitem") <> String.Empty And itemno = getxmlval("firstfreeitem")) Then
Line 9453: st = New StackTrace(New StackFrame(True))
Line 9454: aP = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "DeleteThisItem", orderid, itemno, itemcustno, "0.001", "N")
Line 9455: ElseIf itemno = "SH" And (Session("UpdateCreditCardInfoStatus") = "success" Or Session("CCProcessed") = True) Then
Line 9456: Session("SHDeleteAttempted") = True
Line 9457: Dim storesessionsresult As Boolean = storesessions()
Line 9458: Else
Line 9459: st = New StackTrace(New StackFrame(True))
Line 9460: aP = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "DeleteThisItem", orderid, itemno, itemcustno, , "N")
Line 9461: End If
Line 9462: End If
Line 9463: Next
Line 9464: dbservermanager = Nothing
Line 9465: End Sub
Line 9466:
Line 9467: Function asiec5AddItemsToCart(ByVal cAction As String, ByVal cOrderID As String, ByVal cProgNo As String, ByVal cItemNo As String, ByVal cSubNo As String, ByVal cITCustNo As String, ByVal iLineNo As String, ByVal iOrderQty As String, ByVal cPersonalization As String, ByVal cFreightType As String, ByVal iCatNo As String, ByVal iSubCatNo As String, ByVal iMCPoints As String, ByVal fItemPrice As String, ByVal cLoginProgNo As String, ByVal cEndQPCustNo As String, ByVal cCombinedPrice As String, ByVal cDelGC As String, ByVal cFreeItem As String, ByVal cCategoryList As String, ByVal cAllowFreeItem As String, ByVal fDiscPct As String, ByVal cUseProgOnLine As String, ByVal cUpdateExistingLine As String, ByVal cRestrictToOnHand As String, ByVal cLimitMatrixCalc As String) As String
Line 9468: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9469: Dim result As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "additemstocart", cAction, cOrderID, cProgNo, cItemNo, cSubNo, cITCustNo, iLineNo, iOrderQty, cPersonalization, cFreightType, iCatNo, iSubCatNo, iMCPoints, fItemPrice, cLoginProgNo, cEndQPCustNo, cCombinedPrice, cDelGC, cFreeItem, cCategoryList, cAllowFreeItem, fDiscPct, cUseProgOnLine, cUpdateExistingLine, cRestrictToOnHand, cLimitMatrixCalc)
Line 9470: dbservermanager = Nothing
Line 9471:
Line 9472: End Function
Line 9473: Function AddRangedHandlingCharge(ByVal dotdot As String) As String
Line 9474: Dim result As String = "failed"
Line 9475: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9476: Dim ranges As Integer = 0
Line 9477: Dim AddThisItem As String = String.Empty
Line 9478:
Line 9479: If IsNumeric(getxmlval("numrnghandling")) Then
Line 9480: ranges = countAndDeleteRangedHandlingCharges()
Line 9481: If ranges > 0 Then
Line 9482:
Line 9483:
Line 9484: Dim GetOrderItemInfo As Object(,)
Line 9485:
Line 9486:
Line 9487: GetOrderItemInfo = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "GetOrderItemInfo", "ELINITM", Session("orderid"))
Line 9488: If GetOrderItemInfo.Rank = 2 Then
Line 9489: Dim totalitems As Integer = 0
Line 9490: Session.Remove("subtotalnopoints")
Line 9491: For thisItem As Integer = LBound(GetOrderItemInfo) To UBound(GetOrderItemInfo) - 1
Line 9492: Dim itemname As String = GetOrderItemInfo(thisItem, 3)
Line 9493: Dim itemtype As String = GetOrderItemInfo(thisItem, 23)
Line 9494: Dim itemquantity As String = GetOrderItemInfo(thisItem, 9)
Line 9495: Dim itemextendedprice As String = GetOrderItemInfo(thisItem, 11)
Line 9496: If IsNumeric(itemquantity) AndAlso CInt(itemquantity) > 0 Then
Line 9497: If IsNumeric(itemextendedprice) And UCase(itemname) <> UCase(getxmlval("pointitemno")) And UCase(itemname) <> UCase(getxmlval("pointbuyback")) Then
Line 9498: Session("subtotalnopoints") += CDbl(itemextendedprice)
Line 9499: End If
Line 9500:
Line 9501: Select Case itemtype
Line 9502: Case "DS"
Line 9503: If getxmlval("rnghandlinginclds") = True Then
Line 9504: totalitems += CInt(itemquantity)
Line 9505: End If
Line 9506: Case "FG"
Line 9507: If getxmlval("rnghandlinginclfg") = True Then
Line 9508: totalitems += CInt(itemquantity)
Line 9509: End If
Line 9510: Case "LB"
Line 9511: If getxmlval("rnghandlingincllb") = True Then
Line 9512: totalitems += CInt(itemquantity)
Line 9513: End If
Line 9514: Case "MC"
Line 9515: If getxmlval("rnghandlinginclmc") = True Then
Line 9516: totalitems += CInt(itemquantity)
Line 9517: End If
Line 9518: Case "OP"
Line 9519: If getxmlval("rnghandlinginclop") = True Then
Line 9520: totalitems += CInt(itemquantity)
Line 9521: End If
Line 9522: Case "PS"
Line 9523: If getxmlval("rnghandlinginclps") = True Then
Line 9524: totalitems += CInt(itemquantity)
Line 9525: End If
Line 9526: Case "RG"
Line 9527: If getxmlval("rnghandlinginclrg") = True Then
Line 9528: totalitems += CInt(itemquantity)
Line 9529: End If
Line 9530: Case "RS"
Line 9531: If getxmlval("rnghandlinginclrs") = True Then
Line 9532: totalitems += CInt(itemquantity)
Line 9533: End If
Line 9534: End Select
Line 9535: End If
Line 9536: Next
Line 9537: For r As Integer = 1 To ranges
Line 9538: If getxmlval("lvl" & r & "rnghandlingminitems") <= totalitems Then
Line 9539: AddThisItem = getxmlval("lvl" & r & "rnghandlingitem")
Line 9540:
Line 9541: Else
Line 9542: Exit For
Line 9543: End If
Line 9544: Next
Line 9545:
Line 9546: 'Dim result As Object = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "additemstocart", "add", Session("orderid"), getxmlval("sprogram"), "HND1", "", Session("itemcust"), "1", "1", "", getxmlval("freighttype"), , , , , , , , , checkprogram())
Line 9547: If AddThisItem <> String.Empty Then
Line 9548: 'DISCOUNT ON THE RANGED HANDLING ITEM, IF APPLICABLE
Line 9549: Dim discperc As Double = 0
Line 9550: Dim isDiscountedItem As Boolean = False
Line 9551: If Session("discountItems") <> String.Empty Then
Line 9552: Dim arDiscount As String() = Split(Session("discountItems"), ",")
Line 9553: For y As Integer = LBound(arDiscount) To UBound(arDiscount)
Line 9554: If AddThisItem = arDiscount(y) Then
Line 9555: isDiscountedItem = True
Line 9556: Exit For
Line 9557: End If
Line 9558: Next
Line 9559: End If
Line 9560:
Line 9561: If Not Session("discountgood") Is Nothing AndAlso Not Session("discountScope") Is Nothing AndAlso (Trim(Session("discountScope")) = "ENTIRE" Or isDiscountedItem) Then
Line 9562: discperc = Session("discountgood")
Line 9563: End If
Line 9564:
Line 9565: result = asiec5AddItemsToCart("add", Session("orderid"), getxmlval("sprogram"), AddThisItem, String.Empty, Session("itemcust"), "1", "1", String.Empty, getxmlval("freighttype"), String.Empty, String.Empty, String.Empty, String.Empty, String.Empty, String.Empty, String.Empty, String.Empty, String.Empty, String.Empty, String.Empty, discperc, String.Empty, String.Empty, String.Empty, String.Empty)
Line 9566:
Line 9567: If getxmlval("pointson") = "points" Or getxmlval("pointson") = "dollars" Then
Line 9568: Dim rangedHandDetails As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(""), "GetItemPricInfo", getxmlval("sprogram"), AddThisItem, String.Empty, Session("itemcust"), String.Empty)
Line 9569:
Line 9570: Dim rangedHandPrice As String = rangedHandDetails(1, 28)
Line 9571: If IsNumeric(CDbl(rangedHandPrice)) Then
Line 9572: AddPointsItems(CDbl(rangedHandPrice))
Line 9573: End If
Line 9574: Dim tmp As Object = getcarttotals()
Line 9575:
Line 9576: End If
Line 9577:
Line 9578: End If
Line 9579:
Line 9580: End If
Line 9581: End If
Line 9582: End If
Line 9583:
Line 9584: dbservermanager = Nothing
Line 9585: Return result
Line 9586:
Line 9587: End Function
Line 9588: Function countAndDeleteRangedHandlingCharges() As Integer
Line 9589: Dim ranges As Integer = 0
Line 9590: For rng As Integer = 1 To CInt(getxmlval("numrnghandling"))
Line 9591: If getxmlval("lvl" & rng & "rnghandlingminitems") <> String.Empty AndAlso getxmlval("lvl" & rng & "rnghandlingitem") <> String.Empty Then
Line 9592: ranges = rng
Line 9593: delmc(getxmlval("lvl" & rng & "rnghandlingitem"))
Line 9594: End If
Line 9595: Next
Line 9596: delmc(UCase(getxmlval("pointitemno")))
Line 9597:
Line 9598: delmc(UCase(getxmlval("pointbuyback")))
Line 9599: Return ranges
Line 9600: End Function
Line 9601: Function AddPointsItems(ByVal Amount As Double) As Boolean
Line 9602: Dim qty As String = "-1"
Line 9603: Dim line As String = "1"
Line 9604: Dim personalize As String = String.Empty
Line 9605: Dim catno As String = String.Empty
Line 9606: Dim subcatno As String = String.Empty
Line 9607: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9608: Dim additem As Object
Line 9609: Dim pointsprg As String
Line 9610: If (getxmlval("pointstaxfreight") = "Y" Or Session("taxfreight") = 0) And getxmlval("pointson") = "dollars" Then
Line 9611:
Line 9612: qty = "-1"
Line 9613:
Line 9614: 'MC ITEM
Line 9615: Dim gtotal As String = CStr(CDbl(Session("subtotalnopoints")) + Amount)
Line 9616:
Line 9617: additem = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "additemstocart", "add", Session("orderid"), Session("progno"), UCase(getxmlval("pointitemno")), String.Empty, Session("itemcust"), line, qty, personalize, getxmlval("freighttype"), catno, subcatno, "", Amount, checkProgram())
Line 9618: Amount = Amount * getxmlval("pointconversion")
Line 9619: pointsprg = Amount * -1
Line 9620: 'END TRYING
Line 9621: qty = "1"
Line 9622:
Line 9623: 'Z ITEM
Line 9624: additem = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "additemstocart", "add", Session("orderid"), Session("progno"), UCase(getxmlval("pointbuyback")), String.Empty, Session("itemcust"), line, qty, personalize, getxmlval("freighttype"), catno, subcatno, pointsprg, "0", checkProgram())
Line 9625:
Line 9626: ElseIf getxmlval("pointson") = "dollars" Or getxmlval("pointson") = "points" Then
Line 9627: If getxmlval("pointitemno") <> String.Empty Then
Line 9628: Dim mcpoints, mcprice, zpoints, zprice
Line 9629: qty = "-1"
Line 9630: mcpoints = "0"
Line 9631: mcprice = Session("gtotal") - Session("diffamount")
Line 9632: 'MC ITEM
Line 9633: additem = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "additemstocart", "add", Session("orderid"), Session("progno"), UCase(getxmlval("pointitemno")), String.Empty, Session("itemcust"), line, qty, personalize, getxmlval("freighttype"), catno, subcatno, mcpoints, mcprice, checkProgram())
Line 9634:
Line 9635: zpoints = (Session("diffamount") - Session("taxfreight")) * getxmlval("pointconversion")
Line 9636: zpoints = zpoints * -1
Line 9637: qty = 1
Line 9638: zprice = "0"
Line 9639:
Line 9640: 'Z ITEM
Line 9641: additem = dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "additemstocart", "add", Session("orderid"), Session("progno"), UCase(getxmlval("pointbuyback")), String.Empty, Session("itemcust"), line, qty, personalize, getxmlval("freighttype"), catno, subcatno, zpoints, zprice, checkProgram())
Line 9642: Else
Line 9643: formerror("Point MC Item number required")
Line 9644: End If
Line 9645: End If
Line 9646: Return True
Line 9647: End Function
Line 9648:
Line 9649: Sub RunVerifyLoginCheck(ByVal loginid As String, ByVal pwd As String, ByVal todaydate As String)
Line 9650: If getxmlval("verifylogincheckon") = "Y" Then
Line 9651: Dim loginstate As String = "Wrong"
Line 9652: Dim pwdstate As String = "Wrong"
Line 9653: Dim tdatestate As String = "Wrong"
Line 9654:
Line 9655: If loginid = String.Empty Then
Line 9656: loginstate = "Missing"
Line 9657: ElseIf loginid = Session("login") Then
Line 9658: loginstate = "OK"
Line 9659: End If
Line 9660:
Line 9661: If pwd = String.Empty Then
Line 9662: pwdstate = "Missing"
Line 9663: ElseIf pwd = Session("pwd") Then
Line 9664: pwdstate = "OK"
Line 9665: End If
Line 9666:
Line 9667: If todaydate = String.Empty Then
Line 9668: tdatestate = "Missing"
Line 9669: ElseIf IsDate(todaydate) Then
Line 9670: If Year(CDate(todaydate)) = Year(Now) And Month(CDate(todaydate)) = Month(Now) And Day(CDate(todaydate)) = Day(Now) Then
Line 9671: tdatestate = "OK"
Line 9672: End If
Line 9673:
Line 9674: End If
Line 9675: If loginstate = "Missing" Or pwdstate = "Missing" Or tdatestate = "Missing" Or tdatestate = "Wrong" Then
Line 9676: r1.Response.Redirect("default.aspx?p=verifyorder&message=verifylogincheckmissingmsg")
Line 9677: ElseIf loginstate = "Wrong" Or pwdstate = "Wrong" Then
Line 9678: If Session("verifyloginwrong") Is Nothing Then
Line 9679: Session("verifyloginwrong") = 1
Line 9680: ElseIf Session("verifyloginwrong") = 2 Then
Line 9681: logtofile("PromoPayment", "session abandoned 6800", False)
Line 9682: Session.Abandon()
Line 9683: r1.Response.Redirect("default.aspx?p=login&message=verifylogincheckfailuremsg")
Line 9684: ElseIf Session("verifyloginwrong") = 1 Then
Line 9685: Session("verifyloginwrong") = 2
Line 9686: End If
Line 9687: r1.Response.Redirect("default.aspx?p=verifyorder&message=verifyloginchecktryagainmsg")
Line 9688: End If
Line 9689:
Line 9690: End If
Line 9691: End Sub
Line 9692:
Line 9693: Function PMVersion() As Integer
Line 9694: Dim iVersion As Integer = 0
Line 9695:
Line 9696: Try
Line 9697: Dim f1 As New functions
Line 9698:
Line 9699: Dim softwareProductType As String = f1.getSoftwareProductType()
Line 9700:
Line 9701: If softwareProductType <> "ASISB" Then
Line 9702: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 9703: Dim getversion As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(".."), "GetVersion")
Line 9704: dbservermanager = Nothing
Line 9705: Dim ver_maker As String
Line 9706: If getversion.Length > 5 Then
Line 9707: ver_maker = getversion(6)
Line 9708: Dim prefix As String = Left(ver_maker, 2)
Line 9709: Dim strVersion As String = Right(ver_maker, ver_maker.Length - 2)
Line 9710: If prefix = "PM" And IsNumeric(strVersion) Then
Line 9711: iVersion = CInt(strVersion)
Line 9712: End If
Line 9713: End If
Line 9714: End If
Line 9715: Catch ex As Exception
Line 9716: End Try
Line 9717: Return iVersion
Line 9718: End Function
Line 9719: Sub SetShippingLabels()
Line 9720: Session("shippingcompanynamelabel") = "Company Name"
Line 9721: Session("shippingcontactnamelabel") = "Contact Name"
Line 9722: Session("shippingaddress1label") = "Address 1"
Line 9723: Session("shippingaddress2label") = "Address 2"
Line 9724: Session("shippingcitylabel") = "City"
Line 9725: Session("shippingstatelabel") = "State/Province"
Line 9726: Session("shippingziplabel") = "Zip"
Line 9727: Session("shippingcountrylabel") = "Country"
Line 9728: Session("shippingphonelabel") = "Phone"
Line 9729: If getxmlval("shippingcompanynamelabel") <> String.Empty Then
Line 9730: Session("shippingcompanynamelabel") = getxmlval("shippingcompanynamelabel")
Line 9731: End If
Line 9732: If getxmlval("shippingcontactnamelabel") <> String.Empty Then
Line 9733: Session("shippingcontactnamelabel") = getxmlval("shippingcontactnamelabel")
Line 9734: End If
Line 9735: If getxmlval("shippingaddress1label") <> String.Empty Then
Line 9736: Session("shippingaddress1label") = getxmlval("shippingaddress1label")
Line 9737: End If
Line 9738: If getxmlval("shippingaddress2label") <> String.Empty Then
Line 9739: Session("shippingaddress2label") = getxmlval("shippingaddress2label")
Line 9740: End If
Line 9741: If getxmlval("shippingcitylabel") <> String.Empty Then
Line 9742: Session("shippingcitylabel") = getxmlval("shippingcitylabel")
Line 9743: End If
Line 9744: If getxmlval("shippingstatelabel") <> String.Empty Then
Line 9745: Session("shippingstatelabel") = getxmlval("shippingstatelabel")
Line 9746: End If
Line 9747: If getxmlval("shippingziplabel") <> String.Empty Then
Line 9748: Session("shippingziplabel") = getxmlval("shippingziplabel")
Line 9749: End If
Line 9750: If getxmlval("shippingcountrylabel") <> String.Empty Then
Line 9751: Session("shippingcountrylabel") = getxmlval("shippingcountrylabel")
Line 9752: End If
Line 9753: If getxmlval("shippingphonelabel") <> String.Empty Then
Line 9754: Session("shippingphonelabel") = getxmlval("shippingphonelabel")
Line 9755: End If
Line 9756: Session("ShippingLabelsSet") = True
Line 9757: End Sub
Line 9758: Sub checkAllShippingHidden()
Line 9759: If (getxmlval("hideshippingcompanyname") = "Y" AndAlso getxmlval("hideshippingcontactname") = "Y" AndAlso getxmlval("hideshippingaddress1") = "Y" AndAlso getxmlval("hideshippingaddress2") = "Y" AndAlso getxmlval("hideshippingcity") = "Y" AndAlso getxmlval("hideshippingstate") = "Y" AndAlso getxmlval("hideshippingzip") = "Y" AndAlso getxmlval("hideshippingcountry") = "Y" AndAlso getxmlval("hideshippingphone") = "Y") Then
Line 9760: Session("ShippingInfoAllHidden") = True
Line 9761: Else
Line 9762: Session.Remove("ShippingInfoAllHidden")
Line 9763: End If
Line 9764: End Sub
Line 9765:
Line 9766: Function getASISBXMLOrderImportIPPort() As String
Line 9767: Dim port As String = ""
Line 9768: Dim asiAspIniPath As String = getAsiAspIniPath()
Line 9769:
Line 9770: If Not asiAspIniPath = "file not found" Then
Line 9771: Dim startingPosition As Integer = 0
Line 9772: Dim reader As StreamReader = New StreamReader(asiAspIniPath)
Line 9773: Do While Not reader.EndOfStream
Line 9774: Dim dataLine As String = reader.ReadLine()
Line 9775: If dataLine.StartsWith("ASISBXMLOrderImportIPPort") Then
Line 9776: startingPosition = dataLine.IndexOf("=")
Line 9777: port = Right(dataLine, (dataLine.Length - startingPosition - 1))
Line 9778: Exit Do
Line 9779: End If
Line 9780: Loop
Line 9781: reader.Close()
Line 9782: End If
Line 9783:
Line 9784: Return port
Line 9785: End Function
Line 9786:
Line 9787:
Line 9788: Function getASISBXMLOrderImportIPAddress() As String
Line 9789: Dim ip As String = ""
Line 9790: Dim asiAspIniPath As String = getAsiAspIniPath()
Line 9791:
Line 9792: If Not asiAspIniPath = "file not found" Then
Line 9793: Dim startingPosition As Integer = 0
Line 9794: Dim reader As StreamReader = New StreamReader(asiAspIniPath)
Line 9795: Do While Not reader.EndOfStream
Line 9796: Dim dataLine As String = reader.ReadLine()
Line 9797: If dataLine.StartsWith("ASISBXMLOrderImportIPAddress") Then
Line 9798: startingPosition = dataLine.IndexOf("=")
Line 9799: ip = Right(dataLine, (dataLine.Length - startingPosition - 1))
Line 9800: Exit Do
Line 9801: End If
Line 9802: Loop
Line 9803: reader.Close()
Line 9804: End If
Line 9805:
Line 9806: Return ip
Line 9807: End Function
Line 9808:
Line 9809:
Line 9810: Function getSoftwareProductType() As String
Line 9811: Dim softwareProductType As String = "ProfitMaker"
Line 9812: Dim asiAspIniPath As String = getAsiAspIniPath()
Line 9813:
Line 9814: If Not asiAspIniPath = "file not found" Then
Line 9815: Dim startingPosition As Integer = 0
Line 9816: Dim reader As StreamReader = New StreamReader(asiAspIniPath)
Line 9817: Do While Not reader.EndOfStream
Line 9818: Dim dataLine As String = reader.ReadLine()
Line 9819: If dataLine.StartsWith("SoftwareProductType") Then
Line 9820: startingPosition = dataLine.IndexOf("=")
Line 9821: softwareProductType = Right(dataLine, (dataLine.Length - startingPosition - 1))
Line 9822: Exit Do
Line 9823: End If
Line 9824: Loop
Line 9825: reader.Close()
Line 9826: End If
Line 9827:
Line 9828: Return softwareProductType
Line 9829: End Function
Line 9830:
Line 9831: Function getAsiAspIniSettings(sectionNames As Array, settingNames As Array, defaultSetting As Array) As Array
Line 9832: Dim asiAspIniSettings As New List(Of String)
Line 9833: Dim asiAspIniPath As String = getAsiAspIniPath()
Line 9834: Dim thisSetting As String
Line 9835:
Line 9836: If Not asiAspIniPath = "file not found" Then
Line 9837: Dim startOfSection As Boolean = False
Line 9838: Dim startingPosition As Integer = 0
Line 9839: Dim stream As StreamReader = New StreamReader(asiAspIniPath)
Line 9840:
Line 9841: For i As Integer = 0 To sectionNames.Length - 1
Line 9842: Dim defaultNeeded As Boolean = True
Line 9843:
Line 9844: Do While Not stream.EndOfStream
Line 9845: Dim dataLine As String = UCase(Trim(stream.ReadLine()))
Line 9846: If startOfSection Then
Line 9847: If dataLine.StartsWith(UCase(settingNames(i))) Then
Line 9848: startingPosition = dataLine.IndexOf("=")
Line 9849: thisSetting = Right(dataLine, (dataLine.Length - startingPosition - 1))
Line 9850: startOfSection = False
Line 9851: defaultNeeded = False
Line 9852: asiAspIniSettings.Add(thisSetting)
Line 9853: Exit Do
Line 9854: ElseIf dataLine.StartsWith("[") Then 'when reach the first "[", you're at the EOF the Section
Line 9855: Exit Do
Line 9856: End If
Line 9857: End If
Line 9858:
Line 9859: If UCase(dataLine) = "[" + UCase(sectionNames(i)) + "]" Then
Line 9860: startOfSection = True
Line 9861: End If
Line 9862: Loop
Line 9863:
Line 9864: If defaultNeeded Then
Line 9865: If i <= UBound(defaultSetting) Then
Line 9866: asiAspIniSettings.Add(defaultSetting(i))
Line 9867: Else
Line 9868: asiAspIniSettings.Add("")
Line 9869: End If
Line 9870: End If
Line 9871:
Line 9872: stream = New StreamReader(asiAspIniPath)
Line 9873: Next
Line 9874: stream.Close()
Line 9875: End If
Line 9876:
Line 9877: Dim myArray() As String = asiAspIniSettings.ToArray()
Line 9878: Return myArray
Line 9879: End Function
Line 9880:
Line 9881: Function getAsiAspIniPath() As String
Line 9882: 'try up to 2 folders deep
Line 9883: Dim asiAspIniPath As String = "file not found"
Line 9884:
Line 9885: If File.Exists(Server.MapPath("") & "\asi_asp.ini") Then
Line 9886: asiAspIniPath = Server.MapPath("") & "\asi_asp.ini"
Line 9887: ElseIf File.Exists(Server.MapPath("..") & "\asi_asp.ini") Then
Line 9888: asiAspIniPath = Server.MapPath("..") & "\asi_asp.ini"
Line 9889: End If
Line 9890:
Line 9891: Return asiAspIniPath
Line 9892: End Function
Line 9893:
Line 9894: Function testASISBServerConnection() As Integer
Line 9895: Dim connectiontStatus As String
Line 9896: Dim vers As String = getASISBSoftwareVersion()
Line 9897: If vers.StartsWith("Server error") Then
Line 9898: connectiontStatus = 1
Line 9899: Else
Line 9900: connectiontStatus = 0
Line 9901: End If
Line 9902: Session("versioninfo") = vers
Line 9903:
Line 9904: Return connectiontStatus
Line 9905: End Function
Line 9906:
Line 9907:
Line 9908: Function authorizenetgetpayids() As List(Of String)
Line 9909: Dim strreq As New StringBuilder()
Line 9910: Dim objResponse As XmlDocument
Line 9911: Dim payids As New List(Of String)()
Line 9912:
Line 9913: strreq.Append("<?xml version=""1.0"" encoding=""utf-8""?><getCustomerProfileRequest xmlns=""AnetApi/xml/v1/schema/AnetApiSchema.xsd"">")
Line 9914: strreq.Append(MerchantAuthentication())
Line 9915: strreq.Append("<customerProfileId>" + Session("authorizenetprofileid") + "</customerProfileId>")
Line 9916: strreq.Append("</getCustomerProfileRequest>")
Line 9917:
Line 9918:
Line 9919:
Line 9920: objResponse = SendApiRequest(strreq.ToString())
Line 9921:
Line 9922: Dim xmlns1 As XmlNamespaceManager
Line 9923:
Line 9924: xmlns1 = New XmlNamespaceManager(objResponse.NameTable)
Line 9925: xmlns1.AddNamespace("api", "AnetApi/xml/v1/schema/AnetApiSchema.xsd")
Line 9926:
Line 9927: Dim newitem As ListItem
Line 9928:
Line 9929:
Line 9930: If IsApiResponseSuccess(objResponse) Then
Line 9931: ' paymentprofileidtext.Text = objResponse.SelectSingleNode("/*/api:profile/api:paymentProfiles/api:customerPaymentProfileId", xmlns1).InnerText
Line 9932: Dim pp As XmlNodeList
Line 9933: pp = objResponse.SelectNodes("/*/api:profile/api:paymentProfiles", xmlns1)
Line 9934: If pp.Count < 1 Then
Line 9935: Else
Line 9936:
Line 9937: For i As Integer = 0 To pp.Count - 1
Line 9938: Dim pp1a As XmlNode
Line 9939: pp1a = pp(i).SelectSingleNode("api:customerPaymentProfileId", xmlns1)
Line 9940: Dim pp2a As XmlNode
Line 9941: pp2a = pp(i).SelectSingleNode("api:payment/api:creditCard/api:cardNumber", xmlns1)
Line 9942: payids.Add(pp1a.InnerText + "~~~" + pp2a.InnerText)
Line 9943: Next
Line 9944: End If
Line 9945: Else
Line 9946: End If
Line 9947: Return payids
Line 9948: End Function
Line 9949:
Line 9950: Function SendApiRequest(strReq As String) As XmlDocument
Line 9951:
Line 9952: Dim xmlns1 As XmlNamespaceManager
Line 9953: Dim gstrApiUrltest As String
Line 9954: Dim gstrApiUrllive As String
Line 9955: Dim gstrAPIUrl As String ' set this before call SendApiRequest (based on test or live setting in "authorizenetpunchmode")
Line 9956: gstrApiUrltest = "https://apitest.authorize.net/xml/v1/request.api"
Line 9957: gstrApiUrllive = "https://api.authorize.net/xml/v1/request.api"
Line 9958:
Line 9959: If getxmlval("authorizenetpunchmode") = "live" Then
Line 9960: gstrAPIUrl = gstrApiUrllive
Line 9961: Else
Line 9962: gstrAPIUrl = gstrApiUrltest
Line 9963: End If
Line 9964:
Line 9965: Dim ba As Byte() = Encoding.UTF8.GetBytes(strReq)
Line 9966: ' web request to endpoint at asicshost.com
Line 9967: Dim w As WebRequest = WebRequest.Create(gstrAPIUrl)
Line 9968: w.Method = "POST"
Line 9969: w.ContentType = "text/xml"
Line 9970: w.ContentLength = ba.Length
Line 9971: ' write out the Post info (guid=guid)
Line 9972: Dim ds2 As Stream = w.GetRequestStream()
Line 9973: ds2.Write(ba, 0, ba.Length)
Line 9974: ds2.Close()
Line 9975:
Line 9976: Dim response2 As WebResponse = w.GetResponse()
Line 9977: Dim dsr2 As Stream = response2.GetResponseStream
Line 9978: Dim reader2 As New StreamReader(dsr2)
Line 9979:
Line 9980: Dim res As String = reader2.ReadToEnd()
Line 9981: 'Session("TempDEBUG_SendApiRequest_res") = res
Line 9982:
Line 9983: reader2.Close()
Line 9984: dsr2.Close()
Line 9985: response2.Close()
Line 9986:
Line 9987: Dim xmldom As New XmlDocument
Line 9988: xmldom.LoadXml(res)
Line 9989:
Line 9990: xmlns1 = New XmlNamespaceManager(xmldom.NameTable)
Line 9991: xmlns1.AddNamespace("api", "AnetApi/xml/v1/schema/AnetApiSchema.xsd")
Line 9992:
Line 9993: Return xmldom
Line 9994: End Function
Line 9995:
Line 9996: Function MerchantAuthentication() As String
Line 9997: Dim gstrLoginName As String
Line 9998: Dim gstrTransactionKey As String
Line 9999:
Line 10000: ' Dim gstrLoginName As String = "3Dz4kDG79"
Line 10001: gstrLoginName = getxmlval("authorizenetusr")
Line 10002: ' Dim gstrTransactionKey As String = "53rL2CsX75c2tjLY"
Line 10003: gstrTransactionKey = getxmlval("authorizenetkey")
Line 10004: Return "<merchantAuthentication>" + " <name>" + gstrLoginName + "</name>" + " <transactionKey>" + gstrTransactionKey + "</transactionKey>" + "</merchantAuthentication>"
Line 10005: End Function
Line 10006:
Line 10007: Function IsApiResponseSuccess(objResponse As XmlDocument) As Boolean
Line 10008: Dim isApiResponseASuccess As Boolean
Line 10009: Dim xmlns1 As XmlNamespaceManager
Line 10010:
Line 10011: xmlns1 = New XmlNamespaceManager(objResponse.NameTable)
Line 10012: xmlns1.AddNamespace("api", "AnetApi/xml/v1/schema/AnetApiSchema.xsd")
Line 10013:
Line 10014: If objResponse.SelectSingleNode("/*/api:messages/api:resultCode", xmlns1).InnerText = "Ok" Then
Line 10015: isApiResponseASuccess = True
Line 10016: Else
Line 10017: isApiResponseASuccess = False
Line 10018: End If
Line 10019:
Line 10020: Return isApiResponseASuccess
Line 10021: End Function
Line 10022:
Line 10023: Function PrintErrors(objResponse As XmlDocument) As String
Line 10024: Dim objMessages As XmlNodeList
Line 10025: Dim objMsg As XmlNode
Line 10026: Dim returnval As New StringBuilder
Line 10027: Dim xmlns1 As XmlNamespaceManager
Line 10028:
Line 10029: xmlns1 = New XmlNamespaceManager(objResponse.NameTable)
Line 10030: xmlns1.AddNamespace("api", "AnetApi/xml/v1/schema/AnetApiSchema.xsd")
Line 10031:
Line 10032: objMessages = objResponse.SelectNodes("/*/api:messages/api:message", xmlns1)
Line 10033: For Each objMsg In objMessages
Line 10034: returnval.Append("[" & Server.HtmlEncode(objMsg.SelectSingleNode("api:code", xmlns1).InnerText) & "] " _
Line 10035: & Server.HtmlEncode(objMsg.SelectSingleNode("api:text", xmlns1).InnerText) & "<br" & vbCrLf)
Line 10036: Next
Line 10037: Return returnval.ToString()
Line 10038: End Function
Line 10039: 'This is a wrapper for the VB.NET's built-in HMACMD5 functionality
Line 10040: 'This function takes the data and key as strings and returns the hash as a hexadecimal value
Line 10041: Function HMAC_MD5(ByVal Key, ByVal Value) As String
Line 10042: ' The first two lines take the input values and convert them from strings to Byte arrays
Line 10043: Dim HMACkey() As Byte = (New ASCIIEncoding()).GetBytes(Key)
Line 10044: Dim HMACdata() As Byte = (New ASCIIEncoding()).GetBytes(Value)
Line 10045:
Line 10046: ' create a HMACMD5 object with the key set
Line 10047: Dim myhmacMD5 As New HMACMD5(HMACkey)
Line 10048:
Line 10049: ' calculate the hash (returns a byte array)
Line 10050: Dim HMAChash() As Byte = myhmacMD5.ComputeHash(HMACdata)
Line 10051:
Line 10052: ' loop through the byte array and add append each piece to a string to obtain a hash string
Line 10053: Dim fingerprint = ""
Line 10054: For i = 0 To HMAChash.Length - 1
Line 10055: fingerprint &= HMAChash(i).ToString("x").PadLeft(2, "0")
Line 10056: Next
Line 10057:
Line 10058: Return fingerprint
Line 10059: End Function
Line 10060:
Line 10061:
Line 10062: Function ecomwrapperGetMatrixRowColumn(item As String, Type As String) As Object
Line 10063: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10064: Dim dwo As Object
Line 10065:
Line 10066: dwo = dw1.GetMatrixRowColumn(item, Type)
Line 10067:
Line 10068: Return dwo
Line 10069: End Function
Line 10070:
Line 10071: Function ecomwrapperGetSuggestedItems(baseitem As String, programname As String) As Object
Line 10072: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10073: Dim dwo As Object
Line 10074:
Line 10075: dwo = dw1.GetSuggestedItems(baseitem, programname)
Line 10076: Return dwo
Line 10077: End Function
Line 10078: Function ecomwrapperHandlingChargesByProgram(program As String) As Object
Line 10079: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10080: Dim dwo As Object
Line 10081:
Line 10082: dwo = dw1.HandlingChargesByProgram(program)
Line 10083: Return dwo
Line 10084: End Function
Line 10085: Function ecomwrapperCalculateFreight(costval As Decimal, program As String) As Object
Line 10086: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10087: Dim dwo As Object
Line 10088:
Line 10089: dwo = dw1.CalculateFreight(costval, program)
Line 10090: Return dwo
Line 10091: End Function
Line 10092: Function ecomwrapperGetOrderItemInfo(OrderNumber As String) As Object
Line 10093: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10094: Dim dwo As Object
Line 10095:
Line 10096: dwo = dw1.GetOrderItemInfo(OrderNumber)
Line 10097: Return dwo
Line 10098: End Function
Line 10099: Function ecomwrapperGetOrderInfo(OrderNumber As String) As Object
Line 10100: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10101: Dim dwo As Object
Line 10102:
Line 10103: dwo = dw1.GetOrderInfo(OrderNumber)
Line 10104: Return dwo
Line 10105: End Function
Line 10106: Function ecomwrapperGetCustomersBySelectedID(custlist As String) As Object
Line 10107: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10108: Dim dwo As Object
Line 10109:
Line 10110: dwo = dw1.GetCustomersBySelectedID(custlist)
Line 10111: Return dwo
Line 10112: End Function
Line 10113: Function ecomwrapperGetContactsByCustomer(customerNumber As String, ContactType As String) As Object
Line 10114: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10115: Dim dwo As Object
Line 10116:
Line 10117: dwo = dw1.GetContactsByCustomer(customerNumber, ContactType)
Line 10118: Return dwo
Line 10119: End Function
Line 10120: Function ecomwrapperGetItemInfo(item As String, program As String, customerNumber As String, loginprogram As String) As Object
Line 10121: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10122: Dim dwo As Object
Line 10123:
Line 10124: Dim asisbSessionAItem As String = "Functions_GetItemInfoForASISB: " & Trim(item) & "|" & program & "|" & customerNumber & "|" & loginprogram
Line 10125: Session(asisbSessionAItem) = "These are the values sent in to ecomwrapperGetItemInfo"
Line 10126:
Line 10127: dwo = dw1.GetItemInfo(item, program, customerNumber, loginprogram)
Line 10128:
Line 10129: ' NOTE - removed this and will move the call to _Viewitem.ascx so it is only done there
Line 10130: 'Dim filterfilename As String = Server.MapPath("") & "\SBItemMatrixFilter.xml"
Line 10131: 'If Not File.Exists(filterfilename) Then
Line 10132: ' Return dwo
Line 10133: 'Else
Line 10134: ' dwo = SBItemMatrixFilter(dwo, filterfilename, program)
Line 10135: 'End If
Line 10136:
Line 10137: Return dwo
Line 10138: End Function
Line 10139: Function SBItemMatrixFilter(dwo As Object, filterfilename As String, program As String) As Object
Line 10140: Dim c As Integer
Line 10141: Dim s As String
Line 10142:
Line 10143: c = UBound(dwo)
Line 10144:
Line 10145: Dim doc As New XmlDocument
Line 10146: doc.Load(filterfilename)
Line 10147:
Line 10148: Dim progs As XmlNodeList
Line 10149:
Line 10150: s = "program[programname = """ + program + """]"
Line 10151: progs = doc.DocumentElement.SelectNodes("program")
Line 10152:
Line 10153: Dim prog As XmlNode
Line 10154: For Each prog In progs
Line 10155: If prog.SelectSingleNode("programname").FirstChild.Value = program Then
Line 10156: Exit For
Line 10157: End If
Line 10158: Next
Line 10159:
Line 10160: Dim filterstring As New StringBuilder
Line 10161:
Line 10162: If Not prog Is Nothing Then
Line 10163: Dim products As XmlNodeList
Line 10164: Dim product As XmlNode
Line 10165:
Line 10166: s = "product[productcode = """ + dwo(1, 1) + """]"
Line 10167: products = prog.SelectNodes(s)
Line 10168:
Line 10169: If products.Count > 0 Then
Line 10170: For Each product In products
Line 10171: filterstring.Append("~|" + product.SelectSingleNode("productcode").FirstChild.Value + "|" + product.SelectSingleNode("row").FirstChild.Value + "|" + product.SelectSingleNode("column").FirstChild.Value + "|~")
Line 10172: Next
Line 10173: End If
Line 10174: End If
Line 10175:
Line 10176: Dim filterstr As String
Line 10177: filterstr = filterstring.ToString()
Line 10178:
Line 10179: Dim dwo_2(c, 64) As Object
Line 10180:
Line 10181: Dim i, ii, o As Integer
Line 10182: o = 0
Line 10183: Dim teststr As String
Line 10184:
Line 10185: For i = 1 To c
Line 10186: teststr = "|" + dwo(i, 1) + "|" + dwo(i, 46) + "|" + dwo(i, 47) + "|"
Line 10187: If filterstr.IndexOf(teststr) = -1 Then
Line 10188: o = o + 1
Line 10189: For ii = 1 To 64
Line 10190: dwo_2(o, ii) = dwo(i, ii)
Line 10191: Next
Line 10192: 'o = o + 1
Line 10193: End If
Line 10194: Next
Line 10195:
Line 10196: Dim dwo_3(o, 64) As Object
Line 10197: For i = 1 To o
Line 10198: For ii = 1 To 64
Line 10199: dwo_3(i, ii) = dwo_2(i, ii)
Line 10200: Next
Line 10201: Next
Line 10202:
Line 10203: Return dwo_3
Line 10204:
Line 10205: End Function
Line 10206:
Line 10207: Private Function GetExtendedDescriptionFrom(ByVal extDescFrom As String) As String
Line 10208: Select Case extDescFrom
Line 10209: Case "1"
Line 10210: extDescFrom = "ProductGeneral"
Line 10211: Case "2"
Line 10212: extDescFrom = "OrderPurchaseOrder"
Line 10213: Case "3"
Line 10214: extDescFrom = "OrderAcknowledgement"
Line 10215: Case "4"
Line 10216: extDescFrom = "OrderAllForms"
Line 10217: Case Else
Line 10218: extDescFrom = "ProductGeneral"
Line 10219: End Select
Line 10220:
Line 10221: Return extDescFrom
Line 10222: End Function
Line 10223:
Line 10224: Function ecomwrapperItemSearch(siteProgram As String, orderby As String, searchtext As String, categoriesToSearch As String, qtyForPrice As String, lowPrice As String, hiPrice As String, loginProgram As String, extDescFrom As String) As Object
Line 10225:
Line 10226: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10227: Dim dwo As Object
Line 10228:
Line 10229: Dim search As String
Line 10230: search = HttpUtility.HtmlEncode(searchtext)
Line 10231:
Line 10232: extDescFrom = GetExtendedDescriptionFrom(extDescFrom)
Line 10233:
Line 10234: dwo = dw1.ItemSearch(siteProgram, orderby, searchtext, categoriesToSearch, 0, 0.0, 0.0, loginProgram, extDescFrom)
Line 10235:
Line 10236: Return dwo
Line 10237: End Function
Line 10238:
Line 10239: Function ecomwrapperDisplayAllOrders(sortcolumn As String, sortdirection As String, customernumber As String, login As String, programname As String, pagenumber As Integer, ordersperpage As Integer, returnmanifestfreight As String, searchby As String, searchtext As String) As Object
Line 10240:
Line 10241: Dim ecomWrap As EcommWrapper = New EcommWrapper()
Line 10242: Dim dwo As Object
Line 10243:
Line 10244: Dim returnmanifest As Boolean = returnmanifestfreight = "Y"
Line 10245:
Line 10246: Try
Line 10247:
Line 10248: dwo = ecomWrap.DisplayAllOrders(sortcolumn, sortdirection, customernumber, login, programname, pagenumber, ordersperpage, returnmanifest, searchby, searchtext)
Line 10249: Catch ex As Exception
Line 10250:
Line 10251: End Try
Line 10252: Return dwo
Line 10253: End Function
Line 10254:
Line 10255:
Line 10256: Function ecomwrapperSetGraphicNameForItem(graphicName As String, itemNumber As String, program As String) As String
Line 10257: Dim ecomWrap As EcommWrapper = New EcommWrapper()
Line 10258: Dim statusMssg As String
Line 10259:
Line 10260: Try
Line 10261: statusMssg = ecomWrap.SetGraphicForItemProgramPricingByItem(graphicName, itemNumber, program)
Line 10262: Catch ex As Exception
Line 10263:
Line 10264: End Try
Line 10265: Return statusMssg
Line 10266: End Function
Line 10267:
Line 10268: Function ecomwrapperGetEcomNextOrderNumber() As Integer
Line 10269: ' left this wrapper to call this here but all this now happens in the COM (so it can update eOrder.dbf)
Line 10270: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10271: Dim dwo As Integer
Line 10272:
Line 10273:
Line 10274: dwo = dw1.GetEcomNextOrderNumber()
Line 10275: Return dwo
Line 10276: End Function
Line 10277: Function ecomwrapperExportXMLOrder(ipaddress As String, portNumber As String, xmlstring As String) As String
Line 10278:
Line 10279: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10280: Dim dwo As String
Line 10281:
Line 10282: Dim xmlstring1 As String
Line 10283: xmlstring1 = xmlstring
Line 10284:
Line 10285: If xmlstring1.IndexOf(" encoding=""utf-16""") > -1 Then
Line 10286: xmlstring1 = xmlstring1.Replace(" encoding=""utf-16""", "")
Line 10287: End If
Line 10288:
Line 10289:
Line 10290: dwo = dw1.ExportXMLOrder(ipaddress, portNumber, xmlstring1)
Line 10291: Return dwo
Line 10292: End Function
Line 10293: Function ecomwrapperListItemsForCategory(program As String, category As String, CustomerNumber As String, SecondProgram As String, ItemsPerPage As String, PageNumber As String, Sort As String, excludenostocktxt As String, includesaletxt As String, includenewtxt As String) As Object
Line 10294: Dim dw1 As EcommWrapper = New EcommWrapper()
Line 10295: Dim dwo As Object
Line 10296:
Line 10297: Dim interval As Integer
Line 10298: Dim pagenum As Integer
Line 10299:
Line 10300: If Not Integer.TryParse(ItemsPerPage, interval) Then
Line 10301: ItemsPerPage = 0
Line 10302: End If
Line 10303:
Line 10304: If Not Integer.TryParse(PageNumber, pagenum) Then
Line 10305: pagenum = 1
Line 10306: End If
Line 10307:
Line 10308:
Line 10309: Dim excludenostock As Boolean = excludenostocktxt = "Y"
Line 10310: Dim includesale As Boolean = includesaletxt = "Y"
Line 10311: Dim includenew As Boolean = includenewtxt = "Y"
Line 10312: Dim showlowprice As Boolean = False
Line 10313: If getxmlval("showlowprice") <> "" Then
Line 10314: showlowprice = True
Line 10315: End If
Line 10316:
Line 10317: dwo = dw1.ListItemsForCategory(interval, pagenum, Sort, program, category, CustomerNumber, SecondProgram, excludenostock, includesale, includenew, showlowprice)
Line 10318:
Line 10319: Return dwo
Line 10320: End Function
Line 10321:
Line 10322: Function getASISBXMLOrderImportSoftwareVersion() As String
Line 10323: Dim vers As New List(Of String)
Line 10324:
Line 10325: Try
Line 10326: Dim ecwa As GetASISBSoftwareVersionWinService = New GetASISBSoftwareVersionWinService(getASISBXMLOrderImportIPAddress, getASISBXMLOrderImportIPPort)
Line 10327: vers = ecwa.GetVersionNumber()
Line 10328:
Line 10329: If vers.Count = 0 Then
Line 10330: vers.Add("Server error, possibly invalid IP/Port Setting")
Line 10331: End If
Line 10332:
Line 10333: Catch ex As Exception
Line 10334: vers.Add("Server error, possibly missing IP/Port Setting")
Line 10335: End Try
Line 10336:
Line 10337: Return vers(0)
Line 10338: End Function
Line 10339: Function getASISBSoftwareVersion() As String
Line 10340: Dim vers As New List(Of String)
Line 10341:
Line 10342: Try
Line 10343: Dim ecwa As GetASISBSoftwareVersionWebApi = New GetASISBSoftwareVersionWebApi()
Line 10344: vers = ecwa.GetVersionNumber()
Line 10345:
Line 10346: If vers.Count = 0 Then
Line 10347: vers.Add("Server error, possibly invalid IP/Port Setting")
Line 10348: End If
Line 10349:
Line 10350: Catch ex As Exception
Line 10351: vers.Add("Server error, possibly missing IP/Port Setting")
Line 10352: End Try
Line 10353:
Line 10354: Return vers(0)
Line 10355: End Function
Line 10356:
Line 10357: Function PunchOutGetNewOrderID(ByVal requestType As String, ByVal startDateTime As DateTime, punchOutName As String) As String
Line 10358: Dim orderID As String
Line 10359: Dim fromID As String
Line 10360:
Line 10361: fromID = PunchOutGetFromID(requestType)
Line 10362: orderID = punchOutName & fromID & startDateTime.ToString("yyyyMMddHHmmss")
Line 10363:
Line 10364: Return orderID
Line 10365: End Function
Line 10366:
Line 10367: Function PunchOutGetFromID(ByVal requestType As String) As String
Line 10368: Dim fromID As String
Line 10369: Dim punchOutSetupRequestXML As New XmlDocument()
Line 10370: Dim node As XmlNode
Line 10371: punchOutSetupRequestXML.LoadXml(requestType)
Line 10372: node = punchOutSetupRequestXML.SelectSingleNode("cXML/Header/From/Credential/Identity")
Line 10373: fromID = node.InnerText
Line 10374:
Line 10375: Dim noMatches As MatchCollection
Line 10376: Dim alphanumRegex As New Regex("[^0-9a-zA-Z/ ]")
Line 10377:
Line 10378: noMatches = alphanumRegex.Matches(fromID)
Line 10379: ' Search for all unacceptable characters in a string
Line 10380: Dim successfulMatch As Match
Line 10381: For Each successfulMatch In noMatches
Line 10382: fromID = fromID.Replace(successfulMatch.ToString, "")
Line 10383: Next
Line 10384:
Line 10385: fromID = Mid(fromID, 1, 13)
Line 10386:
Line 10387: Return fromID.Trim
Line 10388:
Line 10389: End Function
Line 10390:
Line 10391: Function PunchOutGetBuyerCookie(ByVal requestType As String) As String
Line 10392: Dim buyerCookie As String
Line 10393: Dim punchOutSetupRequestXML As New XmlDocument()
Line 10394: Dim node As XmlNode
Line 10395: punchOutSetupRequestXML.LoadXml(requestType)
Line 10396: node = punchOutSetupRequestXML.SelectSingleNode("cXML/Request/PunchOutSetupRequest/BuyerCookie")
Line 10397: buyerCookie = node.InnerText
Line 10398:
Line 10399: Return buyerCookie
Line 10400: End Function
Line 10401:
Line 10402: Function PunchOutGetBrowserFormPost(ByVal requestType As String) As String
Line 10403: Dim browserformpost As String
Line 10404: Dim punchOutSetupRequestXML As New XmlDocument()
Line 10405: Dim node As XmlNode
Line 10406: punchOutSetupRequestXML.LoadXml(requestType)
Line 10407: node = punchOutSetupRequestXML.SelectSingleNode("cXML/Request/PunchOutSetupRequest/BrowserFormPost/URL")
Line 10408: browserformpost = node.InnerText
Line 10409:
Line 10410: Return browserformpost
Line 10411: End Function
Line 10412:
Line 10413: Public Function PunchOutGetPayloadID(startDateTime As DateTime, punchoutDomainName As String) As String
Line 10414: Dim payloadID As String
Line 10415: Dim f1 As New functions
Line 10416: Dim domainName As String = f1.getxmlval(punchoutDomainName)
Line 10417:
Line 10418: payloadID = startDateTime.ToString("yyyyMMddHHmmss") & "@" & domainName
Line 10419:
Line 10420: Return payloadID
Line 10421: End Function
Line 10422:
Line 10423: Function PunchOutCreateErrorResponseCXML(ByVal requestType As String) As XmlDocument
Line 10424: Dim f1 As New functions
Line 10425: Dim startDateTime As DateTime = Now()
Line 10426: Dim response As XmlDocument
Line 10427: Dim Doc As New XmlDocument()
Line 10428: Dim newAttribute As XmlAttribute
Line 10429: Dim newElement As XmlElement
Line 10430: Dim doctype As XmlDocumentType
Line 10431: doctype = Doc.CreateDocumentType("cXML", "SYSTEM", "http://xml.cxml.org/schemas/cXML/1.2.021/cXML.dtd", Nothing)
Line 10432: Doc.AppendChild(doctype)
Line 10433:
Line 10434: ' Create the root node.
Line 10435: Dim Root As XmlElement
Line 10436: Root = Doc.CreateElement("cXML")
Line 10437:
Line 10438: ' Add an attribute to the root node.
Line 10439: Dim payloadID As String = f1.GetPayloadID(startDateTime)
Line 10440: Dim Attr As XmlAttribute
Line 10441: Attr = Doc.CreateAttribute("payloadID")
Line 10442: Attr.Value = payloadID
Line 10443: Root.Attributes.Append(Attr)
Line 10444:
Line 10445: ' Add another attribute to the root node.
Line 10446: Dim timeStamp As String = startDateTime.ToString("yyyy-MM-ddTHH:mm:sszzz")
Line 10447: Dim Attr2 As XmlAttribute
Line 10448: Attr2 = Doc.CreateAttribute("timestamp")
Line 10449: Attr2.Value = timeStamp
Line 10450: Root.Attributes.Append(Attr2)
Line 10451:
Line 10452: Dim Child As XmlElement
Line 10453: Child = Doc.CreateElement("Response")
Line 10454: Child.InnerText = ""
Line 10455:
Line 10456: Dim Child2 As XmlElement
Line 10457: Child2 = Doc.CreateElement("Status")
Line 10458: Child2.InnerText = "Particular Request could not be determined"
Line 10459:
Line 10460: Dim Attr3 As XmlAttribute
Line 10461: Attr3 = Doc.CreateAttribute("code")
Line 10462: Attr3.Value = "450"
Line 10463: Child2.Attributes.Append(Attr3)
Line 10464:
Line 10465: Dim Attr4 As XmlAttribute
Line 10466: Attr4 = Doc.CreateAttribute("text")
Line 10467: Attr4.Value = "Not Implemented"
Line 10468: Child2.Attributes.Append(Attr4)
Line 10469:
Line 10470: Child.AppendChild(Child2)
Line 10471:
Line 10472: Root.AppendChild(Child)
Line 10473:
Line 10474: Doc.AppendChild(Root)
Line 10475: response = Doc
Line 10476:
Line 10477: Return response
Line 10478: End Function
Line 10479:
Line 10480: Function createLawsonOrder() As String
Line 10481:
Line 10482: Try
Line 10483: Dim responseString As String
Line 10484: Dim dotdot As String = ""
Line 10485: Dim orderid As String = Session("orderid")
Line 10486:
Line 10487: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 10488:
Line 10489: Dim eord As Object = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_createLawsonOrder", Server.MapPath(dotdot), "getorderinfo", "EORDER", orderid, getxmlval("boxlimit"))
Line 10490:
Line 10491: Dim elines As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getorderiteminfo", "ELINITM", orderid)
Line 10492:
Line 10493: If eord(3) <> orderid Then
Line 10494: formerror("Order was not found.")
Line 10495: r1.Response.End()
Line 10496: End If
Line 10497:
Line 10498: Dim startDateTime As DateTime = Now()
Line 10499: Dim response As XmlDocument
Line 10500: Dim Doc As New XmlDocument()
Line 10501: Dim Doc2 As New XmlDocument()
Line 10502: Dim nodeAttribute As XmlAttribute
Line 10503: Dim Child As XmlElement
Line 10504: Dim Child2 As XmlElement
Line 10505: Dim Child3 As XmlElement
Line 10506: Dim Child4 As XmlElement
Line 10507: Dim Child5 As XmlElement
Line 10508: Dim Child6 As XmlElement
Line 10509: Dim doctype As XmlDocumentType
Line 10510: doctype = Doc.CreateDocumentType("cXML", "SYSTEM", "http://xml.cxml.org/schemas/cXML/1.2.021/cXML.dtd", Nothing)
Line 10511: Doc.AppendChild(doctype)
Line 10512:
Line 10513: ' Create the root node.
Line 10514: Dim Root As XmlElement
Line 10515: Root = Doc.CreateElement("cXML")
Line 10516:
Line 10517: ' Add an attribute to the root node.
Line 10518: Dim payloadID As String = PunchOutGetPayloadID(startDateTime, "lawsondomainname")
Line 10519: Dim Attr As XmlAttribute
Line 10520: Attr = Doc.CreateAttribute("payloadID")
Line 10521: Attr.Value = payloadID
Line 10522: Root.Attributes.Append(Attr)
Line 10523:
Line 10524: nodeAttribute = Doc.CreateAttribute("payloadID")
Line 10525: nodeAttribute.Value = payloadID
Line 10526: Root.Attributes.Append(nodeAttribute)
Line 10527:
Line 10528: ' Add an attribute to the root node.
Line 10529: Dim timeStamp As String = startDateTime.ToString("yyyy-MM-ddTHH:mm:sszzz")
Line 10530: nodeAttribute = Doc.CreateAttribute("timestamp")
Line 10531: nodeAttribute.Value = timeStamp
Line 10532: Root.Attributes.Append(nodeAttribute)
Line 10533:
Line 10534: 'bring in the holdback "Header" file
Line 10535: Doc2.Load(Server.MapPath("Lawson/punchOutOrderMessageHeaderTemplate.xml"))
Line 10536: Dim doc2ChildNode As XmlNode
Line 10537: For Each doc2ChildNode In Doc2.DocumentElement.ChildNodes
Line 10538: Dim doc2MergeNode As XmlNode = Doc.ImportNode(doc2ChildNode, True)
Line 10539: Root.AppendChild(doc2MergeNode)
Line 10540: Next
Line 10541:
Line 10542: Child = Doc.CreateElement("Message")
Line 10543: Child.InnerText = ""
Line 10544:
Line 10545: Child2 = Doc.CreateElement("Status")
Line 10546: nodeAttribute = Doc.CreateAttribute("text")
Line 10547: nodeAttribute.Value = "Success"
Line 10548: Child2.Attributes.Append(nodeAttribute)
Line 10549: nodeAttribute = Doc.CreateAttribute("code")
Line 10550: nodeAttribute.Value = "200"
Line 10551: Child2.Attributes.Append(nodeAttribute)
Line 10552: Child2.InnerText = "Success"
Line 10553: Child.AppendChild(Child2)
Line 10554:
Line 10555: Child2 = Doc.CreateElement("PunchOutOrderMessage")
Line 10556: Child2.InnerText = ""
Line 10557:
Line 10558: Child3 = Doc.CreateElement("BuyerCookie")
Line 10559: Child3.InnerText = Session("lawsonbuyercookie")
Line 10560: Child2.AppendChild(Child3)
Line 10561:
Line 10562: Child3 = Doc.CreateElement("PunchOutOrderMessageHeader")
Line 10563: Child3.InnerText = ""
Line 10564: nodeAttribute = Doc.CreateAttribute("quoteStatus")
Line 10565: nodeAttribute.Value = "final"
Line 10566: Child3.Attributes.Append(nodeAttribute)
Line 10567: nodeAttribute = Doc.CreateAttribute("operationAllowed")
Line 10568: nodeAttribute.Value = "edit"
Line 10569: Child3.Attributes.Append(nodeAttribute)
Line 10570: Child2.AppendChild(Child3)
Line 10571:
Line 10572: Child4 = Doc.CreateElement("Total")
Line 10573: Child4.InnerText = ""
Line 10574:
Line 10575: Child5 = Doc.CreateElement("Money")
Line 10576: Child5.InnerText = eord(21)
Line 10577: nodeAttribute = Doc.CreateAttribute("currency")
Line 10578: nodeAttribute.Value = "USD"
Line 10579: Child5.Attributes.Append(nodeAttribute)
Line 10580: Child4.AppendChild(Child5)
Line 10581: 'close out money
Line 10582:
Line 10583: 'close out total
Line 10584: Child3.AppendChild(Child4)
Line 10585:
Line 10586: 'close out PunchOutOrderMessage>PunchOutOrderMessageHeader nodes
Line 10587: Child2.AppendChild(Child3)
Line 10588:
Line 10589: 'Bring in items
Line 10590: Dim lineItemCount As Integer
Line 10591: Dim icount As Integer
Line 10592: lineItemCount = UBound(elines)
Line 10593: If lineItemCount > 0 Then
Line 10594: For icount = 1 To lineItemCount - 1
Line 10595:
Line 10596: Child3 = Doc.CreateElement("ItemIn")
Line 10597: Child3.InnerText = ""
Line 10598: nodeAttribute = Doc.CreateAttribute("quantity")
Line 10599: nodeAttribute.Value = elines(icount, 9)
Line 10600: Child3.Attributes.Append(nodeAttribute)
Line 10601:
Line 10602: Child4 = Doc.CreateElement("ItemID")
Line 10603: Child4.InnerText = ""
Line 10604:
Line 10605: Child5 = Doc.CreateElement("SupplierPartID")
Line 10606: Dim subNo As String = Trim(elines(icount, 4))
Line 10607: If subNo <> "" Then
Line 10608: Dim slashitem As String = ""
Line 10609: If Trim(elines(icount, 26)) <> "__" And Trim(elines(icount, 26)) <> "" And Trim(elines(icount, 27)) <> "__" And Trim(elines(icount, 27)) <> "" Then
Line 10610: slashitem = "/"
Line 10611: End If
Line 10612:
Line 10613: subNo = IIf(Trim(elines(icount, 26)) <> "__", Trim(elines(icount, 26)), "") & slashitem & IIf(Trim(elines(icount, 27)) <> "__", Trim(elines(icount, 27)), "")
Line 10614: End If
Line 10615:
Line 10616: Dim itemSubNo As String = elines(icount, 3) + IIf(subNo <> "", "~" + subNo, "")
Line 10617: Child5.InnerText = itemSubNo
Line 10618: Child4.AppendChild(Child5)
Line 10619:
Line 10620: Child5 = Doc.CreateElement("SupplierPartAuxiliaryID")
Line 10621: Child5.InnerText = ""
Line 10622: Child4.AppendChild(Child5)
Line 10623:
Line 10624: 'close out itemid
Line 10625: Child3.AppendChild(Child4)
Line 10626:
Line 10627: Child4 = Doc.CreateElement("ItemDetail")
Line 10628: Child4.InnerText = ""
Line 10629:
Line 10630: Child5 = Doc.CreateElement("UnitPrice")
Line 10631: Child5.InnerText = ""
Line 10632:
Line 10633: Child6 = Doc.CreateElement("Money")
Line 10634: Child6.InnerText = elines(icount, 10)
Line 10635: nodeAttribute = Doc.CreateAttribute("currency")
Line 10636: nodeAttribute.Value = "USD"
Line 10637: Child6.Attributes.Append(nodeAttribute)
Line 10638: Child5.AppendChild(Child6)
Line 10639:
Line 10640: 'closeout UnitPrice
Line 10641: Child4.AppendChild(Child5)
Line 10642:
Line 10643: Child5 = Doc.CreateElement("Description")
Line 10644: Child5.InnerText = elines(icount, 6)
Line 10645: nodeAttribute = Doc.CreateAttribute("xml:lang")
Line 10646: nodeAttribute.Value = "en"
Line 10647: Child5.Attributes.Append(nodeAttribute)
Line 10648: Child4.AppendChild(Child5)
Line 10649:
Line 10650: Dim per As Integer = elines(icount, 12)
Line 10651: Child5 = Doc.CreateElement("UnitOfMeasure")
Line 10652: Child5.InnerText = IIf(per = 1, "EA", IIf(per = 12, "DZN", per))
Line 10653: Child4.AppendChild(Child5)
Line 10654:
Line 10655: Child5 = Doc.CreateElement("Classification")
Line 10656: Child5.InnerText = "11223344"
Line 10657: nodeAttribute = Doc.CreateAttribute("domain")
Line 10658: nodeAttribute.Value = "UNSPSC"
Line 10659: Child5.Attributes.Append(nodeAttribute)
Line 10660: Child4.AppendChild(Child5)
Line 10661:
Line 10662: 'closeout ItemDetail
Line 10663: Child3.AppendChild(Child4)
Line 10664:
Line 10665: Child4 = Doc.CreateElement("SupplierID")
Line 10666: Child4.InnerText = "839549904"
Line 10667: nodeAttribute = Doc.CreateAttribute("domain")
Line 10668: nodeAttribute.Value = "DUNS"
Line 10669: Child4.Attributes.Append(nodeAttribute)
Line 10670:
Line 10671: 'closeout SupplierID
Line 10672: Child3.AppendChild(Child4)
Line 10673:
Line 10674: 'closeout ItemIn
Line 10675: Child2.AppendChild(Child3)
Line 10676: Next
Line 10677: End If
Line 10678:
Line 10679: 'close out PunchOutOrderMessage node
Line 10680: Child.AppendChild(Child2)
Line 10681:
Line 10682: 'close out Message nodes
Line 10683: Root.AppendChild(Child)
Line 10684:
Line 10685: Doc.AppendChild(Root)
Line 10686: response = Doc
Line 10687:
Line 10688: responseString = response.OuterXml
Line 10689:
Line 10690: 'post it back to what was sent in for the original PunchOutSetupRequest
Line 10691: 'not sure this is needed here so comment out for now
Line 10692: 'Dim browserformposturl As String = Session("browserformpost")
Line 10693:
Line 10694: ''TODO BOF Temp DEBUG write this Back To Lawson file out
Line 10695: 'Dim testStartDateTime As String = startDateTime.ToString("yyyyMMddHHmmss")
Line 10696: 'Context.Trace.Write(responseString)
Line 10697: 'Dim tempMapPath As String = Server.MapPath("Lawson/Templates/Response_mssgs_BackTo_Lawson/")
Line 10698: 'My.Computer.FileSystem.WriteAllText(tempMapPath + "PunchOutOrderMessageResponse" + testStartDateTime + ".xml", responseString, True)
Line 10699: ''TODO EOF Temp DEBUG write this Back To Lawson file out
Line 10700:
Line 10701: Return responseString
Line 10702:
Line 10703: Catch ex As Exception
Line 10704: ' context.trace.write("Threw Punchout Exception - " + ex.message)
Line 10705: Session("DWException") = "dwexception=" + ex.Message
Line 10706: Return "error"
Line 10707: End Try
Line 10708:
Line 10709: End Function
Line 10710:
Line 10711: Function setupPunchOutVerifyOrderBtns() As String
Line 10712: Dim buttons As String
Line 10713: Dim editButtonRedirectPage As String
Line 10714: Dim ordertype As String = getxmlval("ordertype")
Line 10715: Dim isAribaOrder As Boolean = IIf(ordertype = "ariba" Or ordertype = "aribasplitorderxmls", True, False)
Line 10716: Dim isLawsonOrder As Boolean = IIf(ordertype = "lawson", True, False)
Line 10717: Dim isBaswareOrder As Boolean = IIf(ordertype = "basware", True, False)
Line 10718: Dim isCoupaOrder As Boolean = IIf(ordertype = "coupa", True, False)
Line 10719: Dim punchoutProcessOrderBtnLabel As String = getxmlval("punchoutprocessorderbtnlabel")
Line 10720:
Line 10721: If getxmlval("backbuttonverifyorder") = "Y" Then
Line 10722: buttons &= "<input type=""button"" value=""Back"" onclick=""location.href='javascript: history.back(1)';"" /> "
Line 10723: End If
Line 10724: buttons &= "<input type=""button"" name=""viewcart"" value=""View Cart"" onclick=""javascript:location.href='default.aspx?p=showcart';""></td>"
Line 10725:
Line 10726: For z As Integer = 1 To getxmlval("numberofforms")
Line 10727: Dim formno As String = z
Line 10728: If z = 1 Then
Line 10729: formno = String.Empty
Line 10730: End If
Line 10731: If getxmlval("form" & formno & "showverifyorder") = "3" Then
Line 10732: buttons = formtext("verifyorder", "3", "", " " & buttons)
Line 10733: ElseIf getxmlval("form" & formno & "showverifyorder") = "4" Then
Line 10734: buttons &= formtext("verifyorder", "4", "", " ")
Line 10735: End If
Line 10736: Next
Line 10737:
Line 10738: If getxmlval("bypasscheckout1") = "Y" And getxmlval("bypasscheckout2") = "Y" Then
Line 10739: editButtonRedirectPage = "showcart"
Line 10740: ElseIf getxmlval("bypasscheckout1") = "Y" Then
Line 10741: editButtonRedirectPage = "checkout2"
Line 10742: Else
Line 10743: editButtonRedirectPage = "checkout1"
Line 10744: End If
Line 10745: buttons &= "<td><input type=""button"" name=""editinfo"" value=""Edit Information"" onclick=""javascript:location.href='default.aspx?p=" & editButtonRedirectPage & "';""></td>"
Line 10746:
Line 10747: For u As Integer = 1 To getxmlval("numberofforms")
Line 10748: Dim formno As String = u
Line 10749: If u = 1 Then
Line 10750: formno = String.Empty
Line 10751: End If
Line 10752: If getxmlval("form" & formno & "showverifyorder") = "5" Then
Line 10753: buttons &= formtext("verifyorder", "5", "", " ")
Line 10754: End If
Line 10755: Next
Line 10756:
Line 10757: buttons &= "<td><input type=""button"" name=""cancelorder"" value=""Cancel Order"" onclick=""clearit();""></td>"
Line 10758:
Line 10759: For r As Integer = 1 To getxmlval("numberofforms")
Line 10760: Dim formno As String = r
Line 10761: If r = 1 Then
Line 10762: formno = String.Empty
Line 10763: End If
Line 10764: If getxmlval("form" & formno & "showverifyorder") = "6" Then
Line 10765: buttons &= formtext("verifyorder", "6", "", " ")
Line 10766: End If
Line 10767: Next
Line 10768:
Line 10769: If punchoutProcessOrderBtnLabel <> "" Then
Line 10770: buttons &= "<td><input type=""submit"" value=""" & punchoutProcessOrderBtnLabel & """ /></td>"
Line 10771: Else
Line 10772: If isAribaOrder Then
Line 10773: buttons &= "<td><input type=""submit"" value=""Send to Ariba"" /></td>"
Line 10774: ElseIf isLawsonOrder Then
Line 10775: buttons &= "<td><input type=""submit"" value=""Send to Lawson"" /></td>"
Line 10776: ElseIf isBaswareOrder Then
Line 10777: buttons &= "<td><input type=""submit"" value=""Send to Basware"" /></td>"
Line 10778: ElseIf isCoupaOrder Then
Line 10779: buttons &= "<td><input type=""submit"" value=""Send to Coupa"" /></td>"
Line 10780: End If
Line 10781: End If
Line 10782:
Line 10783: For n As Integer = 1 To getxmlval("numberofforms")
Line 10784: Dim formno As String = n
Line 10785: If n = 1 Then
Line 10786: formno = String.Empty
Line 10787: End If
Line 10788: If getxmlval("form" & formno & "showverifyorder") = "7" Then
Line 10789: buttons &= formtext("verifyorder", "7", "", " ")
Line 10790: End If
Line 10791: Next
Line 10792:
Line 10793: Return buttons
Line 10794: End Function
Line 10795:
Line 10796: Function ParseFullNameToFirstLast(ByVal fullName As String) As Array
Line 10797: Dim aFirstLastNames(1) As String
Line 10798: Dim firstName As String
Line 10799: Dim lastName As String
Line 10800: Dim nameSpc As Integer = 0
Line 10801: Dim remainingName As String
Line 10802: Dim tempLastName As String
Line 10803:
Line 10804: fullName = fullName.Trim
Line 10805: If fullName.Contains(" ") Then
Line 10806: nameSpc = fullName.LastIndexOf(" ")
Line 10807: lastName = fullName.Substring(nameSpc + 1)
Line 10808: remainingName = fullName.Substring(0, nameSpc)
Line 10809:
Line 10810: If NameIsSuffix(lastName) Then
Line 10811: nameSpc = remainingName.LastIndexOf(" ")
Line 10812: lastName = remainingName.Substring(nameSpc + 1) + " " + lastName
Line 10813: remainingName = remainingName.Substring(0, nameSpc)
Line 10814: End If
Line 10815:
Line 10816: nameSpc = remainingName.LastIndexOf(" ")
Line 10817:
Line 10818: If nameSpc > -1 Then
Line 10819: tempLastName = remainingName.Substring(nameSpc + 1)
Line 10820:
Line 10821: If NameIsPrefix(tempLastName) Then
Line 10822: lastName = tempLastName + " " + lastName
Line 10823: remainingName = remainingName.Substring(0, nameSpc)
Line 10824:
Line 10825: nameSpc = remainingName.LastIndexOf(" ")
Line 10826: tempLastName = remainingName.Substring(nameSpc + 1)
Line 10827:
Line 10828: 'check for a second Prefix
Line 10829: If NameIsPrefix(tempLastName) Then
Line 10830: lastName = tempLastName + " " + lastName
Line 10831: remainingName = remainingName.Substring(0, nameSpc)
Line 10832: End If
Line 10833:
Line 10834: End If
Line 10835: End If
Line 10836:
Line 10837: aFirstLastNames(0) = remainingName 'firstName
Line 10838: aFirstLastNames(1) = lastName
Line 10839:
Line 10840: Else
Line 10841: aFirstLastNames(0) = "" 'firstName
Line 10842: aFirstLastNames(1) = fullName 'if only one name given, set all as Last name
Line 10843: End If
Line 10844:
Line 10845: Return aFirstLastNames
Line 10846: End Function
Line 10847:
Line 10848: Function NameIsSuffix(lastName As String) As Boolean
Line 10849: Dim nameIsASuffix As Boolean = False
Line 10850:
Line 10851: Select Case UCase(lastName)
Line 10852: Case "JR", "JR.", "SR", "SR.", "I", "II", "III"
Line 10853: nameIsASuffix = True
Line 10854:
Line 10855: End Select
Line 10856:
Line 10857: Return nameIsASuffix
Line 10858: End Function
Line 10859:
Line 10860: Function NameIsPrefix(lastName As String) As Boolean
Line 10861: Dim nameIsAPrefix As Boolean = False
Line 10862:
Line 10863: Select Case UCase(lastName)
Line 10864: Case "D'", "DE", "DEN", "DER", "DU", "L'", "LA", "LE", "MC", "MAC", "O'", "SAN", "ST.", "ST", "VAN", "VANDER", "VER", "VON"
Line 10865: nameIsAPrefix = True
Line 10866:
Line 10867: End Select
Line 10868:
Line 10869: Return nameIsAPrefix
Line 10870: End Function
Line 10871:
Line 10872: Sub SetBillAndShipSessionVars()
Line 10873:
Line 10874: ' BILLING SESSIONS
Line 10875: Session("bcompany") = Session("b_company")
Line 10876: Session("bname") = Session("b_name")
Line 10877: Session("baddr1") = Session("b_addr1")
Line 10878: Session("baddr2") = Session("b_addr2")
Line 10879: Session("bcity") = Session("b_city")
Line 10880: Session("bstate") = Session("b_state")
Line 10881: Session("bzip") = Session("b_zip")
Line 10882: Session("bcountry") = Session("b_country")
Line 10883: Session("bphone") = Session("b_phone")
Line 10884:
Line 10885: If RegExpEmail(Session("email")) And getxmlval("singleitemon") <> "Y" Then
Line 10886: Session("bemail") = Session("email")
Line 10887: Else
Line 10888: Session("bemail") = ""
Line 10889: End If
Line 10890:
Line 10891: If getxmlval("shipblank") <> "Y" Then
Line 10892: ' SHIPPING SESSIONS
Line 10893: Session("scompany") = Session("s_company")
Line 10894: Session("sname") = Session("s_name")
Line 10895: Session("saddr1") = Session("s_addr1")
Line 10896: Session("saddr2") = Session("s_addr2")
Line 10897: Session("scity") = Session("s_city")
Line 10898: Session("sstate") = Session("s_state")
Line 10899: Session("szip") = Session("s_zip")
Line 10900: Session("scountry") = Session("s_country")
Line 10901: Session("sphone") = Session("s_phone")
Line 10902: End If
Line 10903:
Line 10904: End Sub
Line 10905:
Line 10906: Function getBaswareInputStream(inputStreamEncoded As String, testStartDateTime As DateTime) As String
Line 10907: Dim tempMapPath = Server.MapPath("Basware/Templates/Request_mssgs_From_Basware/")
Line 10908:
Line 10909: ''BOF Temp for testing
Line 10910: 'My.Computer.FileSystem.WriteAllText(tempMapPath + "requestINITIALInputStream" + testStartDateTime.ToString("yyyyMMddHHmmss") + ".txt", inputStreamEncoded, True)
Line 10911: ''EOF Temp
Line 10912:
Line 10913: Dim inputStreamDecoded As String
Line 10914: inputStreamDecoded = Server.UrlDecode(inputStreamEncoded)
Line 10915:
Line 10916: 'BOF Temp for testing
Line 10917: If getxmlval("baswaresiteidentifier") = "TEST" Then
Line 10918: inputStreamDecoded = "~TARGET=_top&~OkCode=ADDI&~CALLER=CTLG&HOOK_URL=http://spgppwebdev.simon.com/pmclient/WebForms/PunchOutParse.aspx?sid=653205&sname=OMNISOURCE+MARKETING+GROUP+INC&sounid=SPG&pimpco=643BC56F5D394B028419&abs_id=653205&abs_oun_id=SPG&http_content_charset=utf-8"
Line 10919: End If
Line 10920: 'EOF Temp
Line 10921:
Line 10922: ''BOF Temp for testing
Line 10923: 'My.Computer.FileSystem.WriteAllText(tempMapPath + "requestINITIALInputStreamDecoded" + testStartDateTime.ToString("yyyyMMddHHmmss") + ".txt", inputStreamDecoded, True)
Line 10924: ''EOF Temp
Line 10925:
Line 10926: Return inputStreamDecoded
Line 10927: End Function
Line 10928:
Line 10929: Sub parseBaswareInputStreamParms(inputStreamEncoded As String, testStartDateTime As DateTime)
Line 10930:
Line 10931: Dim inputStream As String = getBaswareInputStream(inputStreamEncoded, testStartDateTime)
Line 10932:
Line 10933: Dim aInputStreamParms As Array = inputStream.ToString.Split("&")
Line 10934: Dim iPosEquals As Integer
Line 10935:
Line 10936: For Each inputStreamParm As String In aInputStreamParms
Line 10937: If InStr(inputStreamParm, "HOOK_URL") > 0 Then
Line 10938: If InStr(inputStreamParm, "=") > 0 Then
Line 10939: iPosEquals = InStr(inputStreamParm, "=")
Line 10940: Session("browserformpost") = inputStreamParm.Substring(iPosEquals)
Line 10941: End If
Line 10942:
Line 10943: ElseIf InStr(inputStreamParm, "sname") > 0 Then
Line 10944: If InStr(inputStreamParm, "=") > 0 Then
Line 10945: iPosEquals = InStr(inputStreamParm, "=")
Line 10946: Session("basware_sname") = inputStreamParm.Substring(iPosEquals)
Line 10947: End If
Line 10948:
Line 10949: ElseIf InStr(inputStreamParm, "sounid") > 0 Then
Line 10950: If InStr(inputStreamParm, "=") > 0 Then
Line 10951: iPosEquals = InStr(inputStreamParm, "=")
Line 10952: Session("basware_sounid") = inputStreamParm.Substring(iPosEquals)
Line 10953: End If
Line 10954:
Line 10955: ElseIf InStr(inputStreamParm, "pimpco") > 0 Then
Line 10956: If InStr(inputStreamParm, "=") > 0 Then
Line 10957: iPosEquals = InStr(inputStreamParm, "=")
Line 10958: Session("basware_pimpco") = inputStreamParm.Substring(iPosEquals)
Line 10959: End If
Line 10960:
Line 10961: ElseIf InStr(inputStreamParm, "abs_id") > 0 Then
Line 10962: If InStr(inputStreamParm, "=") > 0 Then
Line 10963: iPosEquals = InStr(inputStreamParm, "=")
Line 10964: Session("basware_abs_id") = inputStreamParm.Substring(iPosEquals)
Line 10965: End If
Line 10966:
Line 10967: ElseIf InStr(inputStreamParm, "abs_oun_id") > 0 Then
Line 10968: If InStr(inputStreamParm, "=") > 0 Then
Line 10969: iPosEquals = InStr(inputStreamParm, "=")
Line 10970: Session("basware_abs_oun_id") = inputStreamParm.Substring(iPosEquals)
Line 10971: End If
Line 10972:
Line 10973: ElseIf InStr(inputStreamParm, "http_content_charset") > 0 Then
Line 10974: If InStr(inputStreamParm, "=") > 0 Then
Line 10975: iPosEquals = InStr(inputStreamParm, "=")
Line 10976: Session("basware_http_content_charset") = inputStreamParm.Substring(iPosEquals)
Line 10977: End If
Line 10978:
Line 10979: End If
Line 10980:
Line 10981: Next
Line 10982:
Line 10983: End Sub
Line 10984:
Line 10985: Function GetNewOrderIDBasware(ByVal startDateTime As DateTime) As String
Line 10986: Dim orderID As String
Line 10987:
Line 10988: orderID = "Basware" & getxmlval("baswaresiteidentifier") & startDateTime.ToString("yyyyMMddHHmmss")
Line 10989:
Line 10990: Return orderID
Line 10991: End Function
Line 10992:
Line 10993: Function createBaswareOrder() As String
Line 10994: 'return information that Basware needs and an xml file for the extra information that Basware can't accept
Line 10995:
Line 10996: Dim returnInputFields As String = ""
Line 10997: Dim responseDoc As XmlDocument
Line 10998: Dim Doc As New XmlDocument()
Line 10999: Dim nodeAttribute As XmlAttribute
Line 11000: Dim Child As XmlElement
Line 11001: Dim Child2 As XmlElement
Line 11002: Dim doctype As XmlDocumentType
Line 11003: Dim responseString As String
Line 11004:
Line 11005: Try
Line 11006: Dim dotdot As String = String.Empty
Line 11007: Dim orderid As String = Session("orderid")
Line 11008: Dim baswareOrderID As String = ""
Line 11009:
Line 11010: Dim dbservermanager As Object = Server.CreateObject(getcomname())
Line 11011:
Line 11012: If Session("getno") = String.Empty Then
Line 11013: Dim st As System.Diagnostics.StackTrace
Line 11014: st = New StackTrace(New StackFrame(True))
Line 11015: Session("getno") = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "UpdateLastOrderNo", Session("orderid"), "Y", , , )
Line 11016: End If
Line 11017: baswareOrderID = Trim(Session("getno"))
Line 11018:
Line 11019: Dim eord As Object = dbservermanager.ecomcall_array(Me.ToString() + " / function_is_createBaswareOrder", Server.MapPath(dotdot), "getorderinfo", "EORDER", orderid, getxmlval("boxlimit"))
Line 11020:
Line 11021: Dim elines As Object = dbservermanager.ecomcall_array(Me.ToString(), Server.MapPath(dotdot), "getorderiteminfo", "ELINITM", orderid)
Line 11022:
Line 11023: Session("TEMPDebug_Session_OrderID") = orderid
Line 11024: Session("TEMPDebug_getorderinfo_OrdNo") = eord(3)
Line 11025:
Line 11026: If Trim(eord(3)) <> Trim(orderid) Then
Line 11027: Session("TEMPDebug_Session_OrderID_NotFound") = orderid
Line 11028: Session("TEMPDebug_getorderinfo_OrdNo_NotFound") = eord(3)
Line 11029: Session("BaswareOrderNotFound") = True
Line 11030: formerror("Basware Order was not found.")
Line 11031: Response.End()
Line 11032: Else
Line 11033: Session("TEMPDebug_Session_OrderID_Found") = orderid
Line 11034: Session("TEMPDebug_getorderinfo_OrdNo_Found") = eord(3)
Line 11035: Session("BaswareOrderFound") = True
Line 11036: End If
Line 11037:
Line 11038: returnInputFields &= "<input type=""hidden"" name=""sname"" value=""" & Session("basware_sname") & """ />"
Line 11039: returnInputFields &= "<input type=""hidden"" name=""sounid"" value=""" & Session("basware_sounid") & """ />"
Line 11040: returnInputFields &= "<input type=""hidden"" name=""pimpco"" value=""" & Session("basware_pimpco") & """ />"
Line 11041: returnInputFields &= "<input type=""hidden"" name=""abs_id"" value=""" & Session("basware_abs_id") & """ />"
Line 11042: returnInputFields &= "<input type=""hidden"" name=""abs_oun_id"" value=""" & Session("basware_abs_oun_id") & """ />"
Line 11043: returnInputFields &= "<input type=""hidden"" name=""http_content_charset"" value=""" & Session("basware_http_content_charset") & """ />"
Line 11044:
Line 11045: 'for Personalization, etc. XML file
Line 11046: doctype = Doc.CreateDocumentType("cXML", "SYSTEM", "http://xml.cxml.org/schemas/cXML/1.2.021/cXML.dtd", Nothing)
Line 11047: Doc.AppendChild(doctype)
Line 11048:
Line 11049: ' Create the root node.
Line 11050: Dim Root As XmlElement
Line 11051: Root = Doc.CreateElement("Order")
Line 11052:
Line 11053: Child = Doc.CreateElement("OrderID")
Line 11054: Child.InnerText = orderid
Line 11055: Root.AppendChild(Child)
Line 11056:
Line 11057: Child = Doc.CreateElement("BaswareOrderID")
Line 11058: Child.InnerText = baswareOrderID
Line 11059: Root.AppendChild(Child)
Line 11060:
Line 11061: Child = Doc.CreateElement("InHandDate")
Line 11062: Child.InnerText = eord(52)
Line 11063: Root.AppendChild(Child)
Line 11064:
Line 11065: Child = Doc.CreateElement("SpecialInstructions")
Line 11066: Child.InnerText = eord(43)
Line 11067: Root.AppendChild(Child)
Line 11068:
Line 11069: Child = Doc.CreateElement("LineItems")
Line 11070: Child.InnerText = ""
Line 11071:
Line 11072: 'Bring in items
Line 11073: Dim lineItemCount As Integer
Line 11074: Dim icount As Integer
Line 11075: Dim iRealItemCount As Integer = 1
Line 11076:
Line 11077: lineItemCount = UBound(elines)
Line 11078: If lineItemCount > 0 Then
Line 11079: Dim maxDescriptionLength As Integer = 1
Line 11080: Dim itemDescription As String = ""
Line 11081: Dim itemDescriptionLength As Integer = 0
Line 11082: Dim itemNo As String = ""
Line 11083: Dim itemSubNo As String
Line 11084: Dim subNo As String
Line 11085: Dim Child3 As XmlElement
Line 11086:
Line 11087: For icount = 1 To lineItemCount - 1
Line 11088: itemNo = elines(icount, 3)
Line 11089: subNo = Trim(elines(icount, 4))
Line 11090: itemSubNo = itemNo + IIf(subNo <> "", "~" + subNo, "")
Line 11091:
Line 11092: If itemSubNo = "SH" Then
Line 11093: returnInputFields &= "<input type=""hidden"" name=""NEW_ITEM-CUST_FIELD1[1]"" value=""" & elines(icount, 10) & """ />"
Line 11094: Else
Line 11095: returnInputFields &= "<input type=""hidden"" name=""NEW_ITEM-EXT_PRODUCT_ID[" & iRealItemCount & "]"" value=""" & itemNo & """ />"
Line 11096:
Line 11097: If iRealItemCount = 1 Then
Line 11098: itemDescription = Trim(elines(icount, 6))
Line 11099: itemDescriptionLength = itemDescription.Length
Line 11100: maxDescriptionLength = (40 - (baswareOrderID.Length + 1))
Line 11101:
Line 11102: If itemDescriptionLength <= maxDescriptionLength Then
Line 11103: maxDescriptionLength = itemDescriptionLength
Line 11104: End If
Line 11105:
Line 11106: returnInputFields &= "<input type=""hidden"" name=""NEW_ITEM-DESCRIPTION[" & iRealItemCount & "]"" value=""" & itemDescription.Substring(0, maxDescriptionLength) & "~" & baswareOrderID & """ />"
Line 11107: Else
Line 11108: returnInputFields &= "<input type=""hidden"" name=""NEW_ITEM-DESCRIPTION[" & iRealItemCount & "]"" value=""" & elines(icount, 6) & """ />"
Line 11109: End If
Line 11110:
Line 11111: returnInputFields &= "<input type=""hidden"" name=""NEW_ITEM-QUANTITY[" & iRealItemCount & "]"" value=""" & elines(icount, 9) & """ />"
Line 11112: returnInputFields &= "<input type=""hidden"" name=""NEW_ITEM-PRICE[" & iRealItemCount & "]"" value=""" & elines(icount, 10) & """ />"
Line 11113:
Line 11114: Dim per As Integer = elines(icount, 12)
Line 11115: Dim perUnitDescription As String = IIf(per = 1, "EA", IIf(per = 12, "DZN", per))
Line 11116: returnInputFields &= "<input type=""hidden"" name=""NEW_ITEM-UNIT[" & iRealItemCount & "]"" value=""" & perUnitDescription & """ />"
Line 11117:
Line 11118: ' for Line Item Personalization, etc. XML file
Line 11119: Child2 = Doc.CreateElement("LineItem")
Line 11120: Child2.InnerText = ""
Line 11121:
Line 11122: Child3 = Doc.CreateElement("LineItemIndexNo")
Line 11123: Child3.InnerText = iRealItemCount.ToString
Line 11124: Child2.AppendChild(Child3)
Line 11125:
Line 11126: Child3 = Doc.CreateElement("LineItemProductID")
Line 11127: Child3.InnerText = itemNo
Line 11128: Child2.AppendChild(Child3)
Line 11129:
Line 11130: Child3 = Doc.CreateElement("ItemSubNo")
Line 11131: Child3.InnerText = itemSubNo
Line 11132: Child2.AppendChild(Child3)
Line 11133:
Line 11134: Child3 = Doc.CreateElement("MatrixRowDescription")
Line 11135: Child3.InnerText = elines(icount, 26)
Line 11136: Child2.AppendChild(Child3)
Line 11137:
Line 11138: Child3 = Doc.CreateElement("MatrixColumnDescription")
Line 11139: Child3.InnerText = elines(icount, 27)
Line 11140: Child2.AppendChild(Child3)
Line 11141:
Line 11142: Child3 = Doc.CreateElement("Personalization")
Line 11143: Child3.InnerText = elines(icount, 13)
Line 11144: Child2.AppendChild(Child3)
Line 11145:
Line 11146: 'close out LineItem node
Line 11147: Child.AppendChild(Child2)
Line 11148:
Line 11149: iRealItemCount += 1
Line 11150: End If
Line 11151:
Line 11152: Next
Line 11153:
Line 11154: End If
Line 11155:
Line 11156: 'close out LineItems node for XML file
Line 11157: Root.AppendChild(Child)
Line 11158:
Line 11159: 'close out Root (Order node) for XML file
Line 11160: Doc.AppendChild(Root)
Line 11161: responseDoc = Doc
Line 11162:
Line 11163: responseString = responseDoc.OuterXml
Line 11164:
Line 11165: ''BOF Temp DEBUG write this Back To Basware file out
Line 11166: ''Context.Trace.Write(responseString)
Line 11167: 'Dim tempMapPath As String = Server.MapPath("Basware/Templates/Response_mssgs_BackTo_Basware/")
Line 11168: 'My.Computer.FileSystem.WriteAllText(tempMapPath + "PunchOutOrderMessageResponse" + orderid + ".txt", returnInputFields & vbCrLf & vbCrLf, True)
Line 11169: ''EOF Temp DEBUG write this Back To Basware file out
Line 11170:
Line 11171: 'Write out Basware Personalization, etc. XML file
Line 11172: Dim tempMapPath2 As String = Server.MapPath("Basware/Templates/Orders/")
Line 11173: My.Computer.FileSystem.WriteAllText(tempMapPath2 + baswareOrderID + ".xml", responseString, False)
Line 11174:
Line 11175: Return returnInputFields
Line 11176:
Line 11177: Catch ex As Exception
Line 11178: Return returnInputFields
Line 11179: End Try
Line 11180:
Line 11181: End Function
Line 11182:
Line 11183: Sub setFreightTableAmountForPunchOut()
Line 11184:
Line 11185: If getSoftwareProductType() = "ASISB" Then
Line 11186: Dim dbservermanagerComName As String = getcomname()
Line 11187: Dim fshipmth
Line 11188: Dim freightamount As String
Line 11189: Dim itemnumbershipping As String
Line 11190: Dim orderid As String = Session("orderid")
Line 11191: Dim siteprogram As String = getxmlval("sprogram")
Line 11192: Dim st As System.Diagnostics.StackTrace
Line 11193:
Line 11194: fshipmth = getxmlval("shipvia")
Line 11195: Session("freightamount") = freightamount
Line 11196: Session("fShipmth") = fshipmth
Line 11197: itemnumbershipping = "SH"
Line 11198: Session("SBFRTITEM") = "SH"
Line 11199:
Line 11200: Dim dbservermanager = Server.CreateObject(dbservermanagerComName)
Line 11201:
Line 11202: Try
Line 11203: st = New StackTrace(New StackFrame(True))
Line 11204: Dim freighttableamount As String = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "GetFreightTableAmount", orderid, siteprogram)
Line 11205: st = New StackTrace(New StackFrame(True))
Line 11206: freightamount = freighttableamount
Line 11207: Dim afrt As Object
Line 11208: afrt = ecomwrapperCalculateFreight(1.0, siteprogram)
Line 11209: Session("SBFRTITEM") = afrt(1, 5)
Line 11210:
Line 11211: delmc("SH")
Line 11212:
Line 11213: st = New StackTrace(New StackFrame(True))
Line 11214: Dim additem = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "additemstocart", "add", orderid, siteprogram, itemnumbershipping, "", Session("itemcust"), "1", "1", "", getxmlval("freighttype"), , , , freightamount, , , , , checkProgram())
Line 11215: st = New StackTrace(New StackFrame(True))
Line 11216: Session("SHadded") = freightamount
Line 11217:
Line 11218: 'Since we don't call UpdateOrderPayShip, we need to call UpdateEorderField.
Line 11219: dbservermanager.ecomcall_single(Me.ToString(), Server.MapPath(""), "UpdateEorderField", orderid, "Shipmth", fshipmth)
Line 11220:
Line 11221: Finally
Line 11222: System.Runtime.InteropServices.Marshal.ReleaseComObject(dbservermanager)
Line 11223: dbservermanager = Nothing
Line 11224: End Try
Line 11225:
Line 11226: End If
Line 11227:
Line 11228: End Sub
Line 11229:
Line 11230: Function acctcreatedemail(ByVal email As String, ByVal id As String, ByVal pwd As String, ByVal awardManager As String, ByVal awardTitle As String, ByVal awardReason As String) As String
Line 11231: Dim sendto As String = email
Line 11232: Dim subject As String = getxmlval("acctaddemailsubject")
Line 11233: Dim body As String = getxmlval("acctaddemailbody")
Line 11234: If InStr(body, "[") > 0 And InStr(body, "]") > 0 Then
Line 11235:
Line 11236: body = Replace(body, "[Login ID]", id)
Line 11237: body = Replace(body, "[Login Password]", pwd)
Line 11238:
Line 11239: If InStr(body, "[Award") > 0 Then
Line 11240: body = Replace(body, "[Award Manager]", awardManager)
Line 11241: body = Replace(body, "[Award]", awardTitle)
Line 11242: body = Replace(body, "[Award Reason]", awardReason)
Line 11243: End If
Line 11244:
Line 11245: End If
Line 11246: Dim sendfrom As String = getxmlval("acctaddemailsendfrom")
Line 11247: Dim sendfromname As String = getxmlval("acctaddemailsendfromname")
Line 11248: Dim bcc As String = getxmlval("acctaddemailbcc")
Line 11249: Dim mailserver As String = getxmlval("emailserver")
Line 11250: Dim authenticate As String = getxmlval("authenticateon")
Line 11251: Dim authusr As String = getxmlval("emailusr")
Line 11252: Dim authpwd As String = getxmlval("emailpwd")
Line 11253: Dim ems As Object = emailsend(sendto, subject, sendfrom, sendfromname, body, "", bcc, mailserver, authenticate, authusr, authpwd, Nothing)
Line 11254:
Line 11255: Return ems
Line 11256: End Function
Line 11257:
Line 11258: Function getUPSRates(ByVal serviceCodeType As String, PERR As String) As String
Line 11259: Dim dbservermanagerComName As String = getcomname()
Line 11260: Dim dbservermanager As Object
Line 11261: Dim RequestXMLstring, strResult As String
Line 11262: Dim contsize, filesys, filetxt, anXMLhttpObject, TransactionURL, UPSxmlResult
Line 11263: Dim nodelist3, ccount3, node3, ErrorCodeUPS, ErrorDescriptionUPS
Line 11264: Dim st As System.Diagnostics.StackTrace
Line 11265: Dim fileTextDesc As String
Line 11266: Dim isSurePostRequest As Boolean = serviceCodeType = "code92Rate" Or serviceCodeType = "code93Rate"
Line 11267:
Line 11268: If isSurePostRequest Then
Line 11269: fileTextDesc = "UPSSurePost"
Line 11270: Else
Line 11271: fileTextDesc = "UPS"
Line 11272: End If
Line 11273:
Line 11274: 'Choose UPS URL
Line 11275: If getxmlval("upsliveortest") <> "test" Then
Line 11276: TransactionURL = "https://onlinetools.ups.com/ups.app/xml/Rate"
Line 11277: Else
Line 11278: TransactionURL = "https://wwwcie.ups.com/ups.app/xml/Rate"
Line 11279: End If
Line 11280:
Line 11281: Dim getpath, lResolve, lConnect, lSend, lReceive, inixmlhttp
Line 11282: st = New StackTrace(New StackFrame(True))
Line 11283: Dim getinisettings As String
Line 11284: dbservermanager = Server.CreateObject(dbservermanagerComName)
Line 11285: Try
Line 11286: getinisettings = dbservermanager.ecomcall_single(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString(), Server.MapPath(""), "GetINISettings", "ECOMMERCE,ECOMMERCE,ECOMMERCE,ECOMMERCE,ECOMMERCE,ECOMMERCE", "TIMEOUTRESOLVE,TIMEOUTCONNECT,TIMEOUTSEND,TIMEOUTRECEIVE,DATAPATH,XMLHTTP", "5000,5000,5000,5000,c:\ecommerce\orders,MSXML2.ServerXMLHTTP")
Line 11287: st = New StackTrace(New StackFrame(True))
Line 11288: Finally
Line 11289: System.Runtime.InteropServices.Marshal.ReleaseComObject(dbservermanager)
Line 11290: dbservermanager = Nothing
Line 11291: End Try
Line 11292:
Line 11293: Dim getiniarray As Array = Split(getinisettings, ",")
Line 11294: lResolve = Trim(getiniarray(0))
Line 11295: lConnect = Trim(getiniarray(1))
Line 11296: lSend = Trim(getiniarray(2))
Line 11297: lReceive = Trim(getiniarray(3))
Line 11298: getpath = addwack(Trim(getiniarray(4)))
Line 11299: inixmlhttp = Trim(getiniarray(5))
Line 11300:
Line 11301: RequestXMLstring = PERR
Line 11302: contsize = Len(Trim(RequestXMLstring))
Line 11303:
Line 11304: filesys = CreateObject("Scripting.FileSystemObject")
Line 11305:
Line 11306: Try
Line 11307: If isSurePostRequest Then
Line 11308: filetxt = filesys.CreateTextFile(getpath & "UPSSurePost.txt", True)
Line 11309: Else
Line 11310: filetxt = filesys.CreateTextFile(getpath & "UPS.txt", True)
Line 11311: End If
Line 11312:
Line 11313: filetxt.WriteLine("-----" & fileTextDesc & " REQUEST-----")
Line 11314: filetxt.WriteLine(RequestXMLstring)
Line 11315: Trace.Write(fileTextDesc & ".TXT create try #1")
Line 11316: Catch
Line 11317: Trace.Write(fileTextDesc & ".TXT create catch #1")
Line 11318: Session("caught") += fileTextDesc & ".txt not created #1 "
Line 11319: End Try
Line 11320:
Line 11321: anXMLhttpObject = Server.CreateObject(inixmlhttp)
Line 11322:
Line 11323: Try
Line 11324: st = New StackTrace(New StackFrame(True))
Line 11325: anXMLhttpObject.open("POST", TransactionURL, False)
Line 11326: st = New StackTrace(New StackFrame(True))
Line 11327:
Line 11328: anXMLhttpObject.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Line 11329: anXMLhttpObject.setRequestHeader("Content-Length", contsize)
Line 11330:
Line 11331: ' SEND REQUEST AND PUT RESPONSE IN TO A STRING AND A DOM
Line 11332: anXMLhttpObject.setTimeouts(lResolve, lConnect, lSend, lReceive)
Line 11333:
Line 11334: Try
Line 11335: anXMLhttpObject.send((RequestXMLstring))
Line 11336:
Line 11337: If isSurePostRequest Then
Line 11338: Session("TempDEBUGCheckout2UPSSurePostResponseText") = anXMLhttpObject.responseText
Line 11339: Else
Line 11340: Session("TempDEBUGCheckout2UPSResponseText") = anXMLhttpObject.responseText
Line 11341: End If
Line 11342:
Line 11343: strResult = anXMLhttpObject.responseText
Line 11344:
Line 11345: If anXMLhttpObject.Status = 200 Then
Line 11346: ' RESPONSE FROM SERVER WAS A SUCCESS!!
Line 11347: strResult = anXMLhttpObject.responseText
Line 11348: End If
Line 11349:
Line 11350: System.Runtime.InteropServices.Marshal.ReleaseComObject(anXMLhttpObject)
Line 11351: anXMLhttpObject = Nothing
Line 11352:
Line 11353: Trace.Write("strResult=" + strResult)
Line 11354:
Line 11355: Try
Line 11356: Trace.Write(fileTextDesc & ".TXT create try #2")
Line 11357: filetxt.WriteBlankLines(3)
Line 11358: filetxt.WriteLine("-----" & fileTextDesc & " RESPONSE-----")
Line 11359: filetxt.WriteLine(strResult)
Line 11360: filetxt.Close()
Line 11361: Catch
Line 11362: Trace.Write(fileTextDesc & ".TXT create catch #2")
Line 11363: Session("caught") += fileTextDesc & ".txt not created #2"
Line 11364: End Try
Line 11365:
Line 11366: Trace.Write("After catch")
Line 11367:
Line 11368: System.Runtime.InteropServices.Marshal.ReleaseComObject(filesys)
Line 11369: filesys = Nothing
Line 11370:
Line 11371: ' IF IT SUCCESSFULLY CREATED A DOM THEN DISPLAY IT AND PUT ITEMS IN SESSION VARIABLES
Line 11372: Trace.Write("before createobject")
Line 11373: UPSxmlResult = Server.CreateObject("Microsoft.XMLDOM")
Line 11374: UPSxmlResult.async = False
Line 11375: UPSxmlResult.validateonparse = False
Line 11376: Trace.Write("before loadxml")
Line 11377: UPSxmlResult.loadxml(strResult)
Line 11378:
Line 11379: ' CHECK FOR ERRORS IN ZIP
Line 11380: nodelist3 = UPSxmlResult.documentElement.selectNodes("Response")
Line 11381: ccount3 = nodelist3.length
Line 11382:
Line 11383: ' For Each Node In Nodelist3
Line 11384: For i3 = 0 To ccount3 - 1
Line 11385: node3 = nodelist3(i3)
Line 11386:
Line 11387: ErrorCodeUPS = node3.selectSingleNode("Error/ErrorCode")
Line 11388: ErrorDescriptionUPS = node3.selectSingleNode("Error/ErrorDescription")
Line 11389:
Line 11390: If Not ErrorCodeUPS Is Nothing Then
Line 11391:
Line 11392: If ErrorCodeUPS.text = "110971" Then ' Your invoice may vary from the displayed reference rates
Line 11393:
Line 11394: If isSurePostRequest Then
Line 11395: Session("upssurepostok") = "yes"
Line 11396: Else
Line 11397: Session("upsok") = "yes"
Line 11398: End If
Line 11399:
Line 11400: Else
Line 11401: Session("badrealtime") = "T"
Line 11402: Session("errors") += 1
Line 11403:
Line 11404: ' RETURN TO CHECKOUT1 WITH ERROR
Line 11405: Dim upserror As String = ErrorDescriptionUPS.Text
Line 11406:
Line 11407: If upserror = "The XML document is well formed but the document is not valid" Or upserror = "No packages in shipment" Then
Line 11408: upserror = "weight8446930-"
Line 11409: End If
Line 11410:
Line 11411: strResult = "upserror~" + upserror
Line 11412: End If
Line 11413:
Line 11414: Else
Line 11415: If isSurePostRequest Then
Line 11416: Session("upssurepostok") = "yes"
Line 11417: Else
Line 11418: Session("upsok") = "yes"
Line 11419: End If
Line 11420: End If
Line 11421: Next
Line 11422:
Line 11423: Catch ex As Exception
Line 11424: Trace.Write("Catch Error - message=" + ex.Message)
Line 11425:
Line 11426: If isSurePostRequest Then
Line 11427: Trace.Write("UPS SurePost Realtime error #1")
Line 11428: strResult = "formerror~UPS SurePost Realtime Shipping Connection is down. Please try again later.<br /><br />"
Line 11429: Else
Line 11430: Trace.Write("UPS Realtime error #1")
Line 11431: strResult = "formerror~UPS Realtime Shipping Connection is down. Please try again later.<br /><br />"
Line 11432: End If
Line 11433: End Try
Line 11434:
Line 11435: Catch
Line 11436: If isSurePostRequest Then
Line 11437: strResult = "formerror~UPS SurePost Realtime Shipping Connection cannot be established. Please try again later.<br /><br />"
Line 11438: Else
Line 11439: strResult = "formerror~UPS Realtime Shipping Connection cannot be established. Please try again later.<br /><br />"
Line 11440: End If
Line 11441: End Try
Line 11442:
Line 11443: Return strResult
Line 11444: End Function
Line 11445:
Line 11446: Function FedexRatingRequest(ByVal orderid As String, ByVal splitOrderFFLineItemCode As String) As FedExRateResponse
Line 11447: Dim fedexRateRequest As New FedExRateRequest()
Line 11448: Dim rateResponse As New FedExRateResponse()
Line 11449: Dim dbservermanagerComName As String = getcomname()
Line 11450: Dim dbservermanager As Object
Line 11451: Dim st As System.Diagnostics.StackTrace
Line 11452: st = New StackTrace(New StackFrame(True))
Line 11453: Dim wOrder As Object
Line 11454: Dim currencyCode As String
Line 11455: Dim packageValue As Decimal
Line 11456: Dim numberOfBoxes As Integer
Line 11457: Dim shipdate, shipday, shipmonth, boxlimit
Line 11458:
Line 11459: boxLimit = 1000
Line 11460: If getxmlval("boxlimit") <> String.Empty And getxmlval("boxlimit") <> "0" Then
Line 11461: boxLimit = getxmlval("boxlimit")
Line 11462: End If
Line 11463:
Line 11464: dbservermanager = Server.CreateObject(dbservermanagerComName)
Line 11465: Try
Line 11466: wOrder = dbservermanager.ecomcall_array(Me.ToString() + ":" + st.GetFrame(0).GetFileLineNumber().ToString() + " / processing_FedEx", Server.MapPath(""), "GetOrderInfo", "EORDER", orderid, boxLimit, splitOrderFFLineItemCode)
Line 11467: st = New StackTrace(New StackFrame(True))
Line 11468: Finally
Line 11469: System.Runtime.InteropServices.Marshal.ReleaseComObject(dbservermanager)
Line 11470: dbservermanager = Nothing
Line 11471: End Try
Line 11472:
Line 11473: Dim totalweight As String = wOrder(50)
Line 11474: Dim fTotalWeight As Decimal = wOrder(50)
Line 11475: packageValue = wOrder(21)
Line 11476: numberOfBoxes = wOrder(51)
Line 11477:
Line 11478: shipday = CStr(Day(Now())).PadLeft(2, "0")
Line 11479: shipmonth = CStr(Month(Now())).PadLeft(2, "0")
Line 11480: shipdate = Year(Now()) & "-" & shipmonth & "-" & shipday
Line 11481:
Line 11482: 'until needed and can test, continue to just use USD
Line 11483: 'If shipfromctry = "CA" And Session("scountry") = "CA" Then
Line 11484: 'currencyCode = "CAD"
Line 11485: 'Else
Line 11486: currencyCode = "USD"
Line 11487: 'End If
Line 11488:
Line 11489: Dim rateService As New RateServiceClient
Line 11490:
Line 11491: If getxmlval("fedexmode") = "test" Then
Line 11492: fedexRateRequest.Key = getxmlval("fedexkeytest")
Line 11493: fedexRateRequest.Password = getxmlval("fedexpasswordtest")
Line 11494: fedexRateRequest.AccountNumber = getxmlval("fedexidtest")
Line 11495: fedexRateRequest.MeterNumber = getxmlval("fedexmetertest")
Line 11496: Else
Line 11497: fedexRateRequest.Key = getxmlval("fedexkey")
Line 11498: fedexRateRequest.Password = getxmlval("fedexpassword")
Line 11499: fedexRateRequest.AccountNumber = getxmlval("fedexid")
Line 11500: fedexRateRequest.MeterNumber = getxmlval("fedexmeter")
Line 11501: End If
Line 11502:
Line 11503: fedexRateRequest.CustomerTransactionId = orderid
Line 11504: fedexRateRequest.FedExDropoffType = EnmFedExDropoffType.REGULAR_PICKUP
Line 11505: fedexRateRequest.FedExPackagingType = EnmFedExPackagingType.YOUR_PACKAGING
Line 11506:
Line 11507: fedexRateRequest.ShipperAddress.StreetLines = New String(0) {""}
Line 11508: fedexRateRequest.ShipperAddress.City = getxmlval("shipfrmcity")
Line 11509: fedexRateRequest.ShipperAddress.StateOrProvinceCode = getxmlval("shipfrmstate")
Line 11510: fedexRateRequest.ShipperAddress.PostalCode = getxmlval("upsshipfrom")
Line 11511: fedexRateRequest.ShipperAddress.CountryCode = getxmlval("shipfrmctry")
Line 11512:
Line 11513: fedexRateRequest.RecipientAddress.StreetLines = New String(0) {Session("saddr1").ToString()}
Line 11514: fedexRateRequest.RecipientAddress.City = Session("scity")
Line 11515: fedexRateRequest.RecipientAddress.StateOrProvinceCode = Session("sstate")
Line 11516: fedexRateRequest.RecipientAddress.PostalCode = Session("szip")
Line 11517: fedexRateRequest.RecipientAddress.CountryCode = Session("scountry")
Line 11518:
Line 11519: If getxmlval("resshipmc") <> String.Empty And Session("residential_ck") = "Y" Then
Line 11520: fedexRateRequest.RecipientAddress.Residential = 1
Line 11521: Else
Line 11522: fedexRateRequest.RecipientAddress.Residential = 0
Line 11523: End If
Line 11524:
Line 11525: If getxmlval("logfedex") = "Y" Then
Line 11526: fedexRateRequest.IsLogToFile = True
Line 11527: Else
Line 11528: fedexRateRequest.IsLogToFile = False
Line 11529: End If
Line 11530:
Line 11531: Dim fRemainingWeight As Decimal = fTotalWeight
Line 11532:
Line 11533: If fRemainingWeight > boxLimit Then
Line 11534: Dim distributedPackageValue As Decimal = packageValue
Line 11535:
Line 11536: If numberOfBoxes = 0 Then
Line 11537: numberOfBoxes = 1
Line 11538: End If
Line 11539: If packageValue > 0 Then
Line 11540: distributedPackageValue = packageValue / numberOfBoxes
Line 11541: End If
Line 11542:
Line 11543: Do While fRemainingWeight > boxLimit
Line 11544: fRemainingWeight = fRemainingWeight - boxLimit
Line 11545: fedexRateRequest.FedExLineItems.Add(New FedExLineItem(EnmFedExWeightUnits.LB, boxLimit, currencyCode, distributedPackageValue))
Line 11546: Loop
Line 11547:
Line 11548: If fRemainingWeight <> 0 Then
Line 11549: fedexRateRequest.FedExLineItems.Add(New FedExLineItem(EnmFedExWeightUnits.LB, fRemainingWeight, currencyCode, distributedPackageValue))
Line 11550: End If
Line 11551: Else
Line 11552: fedexRateRequest.FedExLineItems.Add(New FedExLineItem(EnmFedExWeightUnits.LB, fTotalWeight, currencyCode, packageValue))
Line 11553: End If
Line 11554:
Line 11555: 'call new FedEx Rate service
Line 11556: rateResponse = rateService.GetShippingRate(fedexRateRequest)
Line 11557:
Line 11558: Return rateResponse
Line 11559: End Function
Line 11560: Function GetFedExErrorDescription(ByVal fedExNotification As String) As String
Line 11561: Dim fedExErrorDescription As String = ""
Line 11562:
Line 11563: Select Case True
Line 11564:
Line 11565: Case fedExNotification.Contains("Weight is missing or invalid")
Line 11566: fedExErrorDescription = "weight8446930-"
Line 11567:
Line 11568: Case fedExNotification.Contains("Authentication Failed")
Line 11569: fedExErrorDescription = "FedEx Authentication Failed."
Line 11570:
Line 11571: Case fedExNotification.Contains("Client access denied")
Line 11572: fedExErrorDescription = "FedEx Client access denied."
Line 11573:
Line 11574: Case Else
Line 11575: fedExErrorDescription = "Unable to process FedEx Realtime Shipping rates. Please try again and contact " & getxmlval("compname") & " at " & getxmlval("compphone") & " for assistance if still have issues."
Line 11576: End Select
Line 11577:
Line 11578: Return fedExErrorDescription
Line 11579: End Function
Line 11580:End Class
Line 11581:
|