home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD94128292000.psc / modAlgorithm.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-29  |  4.5 KB  |  135 lines
  1. Attribute VB_Name = "modAlgorithm"
  2. '------------------------------------------------------------
  3. ' Alex Skinner (deligon@yahoo.com)
  4. '
  5. ' Deligon Technologies, Inc. www.deligon.com / www.reapers.org
  6. ' CueCat BarCode Decoder Version 1.5
  7. ' This version of the source allows decoding of up to 24 Digit Barcodes
  8. ' Text and Special characters will be implemented in versions to come.
  9. '
  10. ' All information may not be accurate.  The "X" and "-" may not work
  11. ' on all barcodes.  I took this information from Microsoft and Some
  12. ' Radio Shack products. (Code 39)
  13. '
  14. ' This program is for use with the cuecat.  Get it for free at any
  15. ' Radio Shack or go to getcat.com or digitalconvergence.com.
  16. '
  17. ' Source was put together quickly and may not be 100% efficient or clean.
  18. '------------------------------------------------------------
  19. Global sCueBuffer
  20. Global sCueType
  21.  
  22.  
  23. Function cc_decode(sCueCode As String)
  24.     
  25.     sCueCatCode = sCueCode
  26.   Do
  27.     
  28.     nSpace = nSpace + 1
  29.     
  30.     Select Case nSpace
  31.     
  32.     Case 1, 4, 7, 10, 13, 16, 19, 22
  33.       
  34.       sCue = Mid$(sCueCatCode, 1, 2)
  35.       
  36.       If sCue = "C3" Then sBarNum = "0"
  37.       If sCue = "CN" Then sBarNum = "1"
  38.       If sCue = "Cx" Then sBarNum = "2"
  39.       If sCue = "Ch" Then sBarNum = "3"
  40.       If sCue = "D3" Then sBarNum = "4"
  41.       If sCue = "DN" Then sBarNum = "5"
  42.       If sCue = "Dx" Then sBarNum = "6"
  43.       If sCue = "Dh" Then sBarNum = "7"
  44.       If sCue = "E3" Then sBarNum = "8"
  45.       If sCue = "EN" Then sBarNum = "9"
  46.       
  47.       'Special Codes 'Alphanumeric barcodes only.
  48.       If sCue = "g3" Then sBarNum = "X"
  49.       If sCue = "BN" Then sBarNum = "-"
  50.  
  51.       
  52.       cc_decode = cc_decode & sBarNum
  53.       sCueCatCode = Right$(sCueCatCode, Len(sCueCatCode) - 2)
  54.  
  55.     Case 2, 5, 8, 11, 14, 17, 20, 23
  56.  
  57.       sCue = Mid$(sCueCatCode, 1, 1)
  58.       
  59.       If sCue = "n" Then sBarNum = "0"
  60.       If sCue = "j" Then sBarNum = "1"
  61.       If sCue = "f" Then sBarNum = "2"
  62.       If sCue = "b" Then sBarNum = "3"
  63.       If sCue = "D" Then sBarNum = "4"
  64.       If sCue = "z" Then sBarNum = "5"
  65.       If sCue = "v" Then sBarNum = "6"
  66.       If sCue = "r" Then sBarNum = "7"
  67.       If sCue = "T" Then sBarNum = "8"
  68.       If sCue = "P" Then sBarNum = "9"
  69.       
  70.       'Special Codes
  71.       If sCue = "U" Then sBarNum = "-"
  72.       
  73.       cc_decode = cc_decode & sBarNum
  74.       sCueCatCode = Right$(sCueCatCode, Len(sCueCatCode) - 1)
  75.     
  76.     Case 3, 6, 9, 12, 15, 18, 21, 24
  77.  
  78.       sCue = Mid$(sCueCatCode, 1, 1)
  79.       
  80.       If sCue = "Z" Then sBarNum = "0"
  81.       If sCue = "Y" Then sBarNum = "1"
  82.       If sCue = "X" Then sBarNum = "2"
  83.       If sCue = "W" Then sBarNum = "3"
  84.       If sCue = "3" Then sBarNum = "4"
  85.       If sCue = "2" Then sBarNum = "5"
  86.       If sCue = "1" Then sBarNum = "6"
  87.       If sCue = "0" Then sBarNum = "7"
  88.       If sCue = "7" Then sBarNum = "8"
  89.       If sCue = "6" Then sBarNum = "9"
  90.       
  91.       'Special Codes
  92.       If sCue = "U" Then sBarNum = "-"
  93.       
  94.       cc_decode = cc_decode & sBarNum
  95.       sCueCatCode = Right$(sCueCatCode, Len(sCueCatCode) - 1)
  96.     Case Else
  97.       sCueCatCode = ""
  98.     End Select
  99.  
  100.   Loop Until sCueCatCode = ""
  101.   
  102. End Function
  103.  
  104. Function cc_space(sCueString As String, sCodeType As String)
  105.   nBarCount = Len(sCueString)
  106.   
  107.   Select Case sCodeType
  108.     
  109.     Case "UPCA12"
  110.       cc_space = Mid$(sCueString, 1, 1) & " " & Mid$(sCueString, 2, 5) & " " & Mid$(sCueString, 7, 5) & " " & Mid$(sCueString, 12, 1)
  111.     Case "UPC518"
  112.       cc_space = Mid$(sCueString, 1, 1) & " " & Mid$(sCueString, 2, 6) & " " & Mid$(sCueString, 8, 6) & " [" & Mid$(sCueString, 14, 5) & "]"
  113.     Case "UPC513"
  114.       cc_space = Mid$(sCueString, 1, 1) & " " & Mid$(sCueString, 2, 6) & " " & Mid$(sCueString, 8, 6)
  115.     Case "CODE39"
  116.       cc_space = sCueString
  117.     Case "CODE128"
  118.       cc_space = sCueString
  119.       frmBarCode.lblData(3).Caption = "Only the numerical portion of CODE 128 can be deciphered at the moment."
  120.     Case "BESTBUY"
  121.       
  122.       sSale = Left$(sCueString, 2) 'Determine if this is a SALE or a RETURN
  123.       If sSale = "01" Then sSaleCode = "This is a SALE [01]"
  124.       If sSale = "02" Then sSaleCode = "This is a RETURN [02]"
  125.  
  126.       sReceiptCode = Mid$(sCueString, 3, 4) & " " & Mid$(sCueString, 7, 3) & " " & Mid$(sCueString, 10, 4)
  127.       sDate = Format$(Mid$(sCueString, 14, 8), "##/##/####")
  128.       cc_space = sSaleCode & vbCrLf & "Receipt ID: " & sReceiptCode & vbCrLf & "Date: " & sDate & vbCrLf & "Trailing Code: " & Mid$(sCueString, 22, 1)
  129.   
  130.     Case Else
  131.       cc_space = sCueString & " [ UNKNOWN ]"
  132.   End Select
  133.   
  134. End Function
  135.