home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / database / pk4pak.zip / PACKMAN.SC < prev    next >
Text File  |  1993-02-05  |  17KB  |  452 lines
  1. ;============================================================================
  2. ; (c) Copyright Elect Software International Inc., 1992, Toronto. Anyone can
  3. ; use this code for anything as long as it is not resold as a software
  4. ; development resource, as long as the copyright notice isn't removed, as
  5. ; long as changes are clearly marked as to authorship, and as long as users
  6. ; indemnify Elect from any liability.
  7. ; Comments welcome. Henrik Bechmann, CIS:72701,3717; Tel:416-534-8176.
  8. ;============================================================================
  9.  
  10. ; PackMan Version 1.11 January, 1993
  11.  
  12. ;==============================================================================
  13. ;                             PACKMAN DESCRIPTION
  14. ;==============================================================================
  15. ; PackMan is a generic array packing utility. It packs arrays or dyanarrays into
  16. ; strings (blobs), and unpacks them.
  17. ;
  18. ; PackMan converts arrays or dynarrays into packed strings for convenient
  19. ; storage (in other arrays or dynarrays for instance). It also unpacks them
  20. ; back to specified arrays or dynarrays for subsequent access.
  21. ;
  22. ; Arrays are expected to be initialized when packed, and properly dimensioned
  23. ; when targeted for unpacking.
  24. ;
  25. ; Data types handled:
  26. ; -------------------
  27. ;   D = Date
  28. ;   L = Logical (True or False)
  29. ;   A = Alphanumeric (length 1 to 255)
  30. ;   M = Memo (length > 255)
  31. ;   Z = Zero length string (length = 0, ie. blank) (type converted internally)
  32. ;   B = Blank $,N,S or D: type kept in value slot
  33. ;   N = Numeric
  34. ;
  35. ; Packed string format:
  36. ; ---------------------
  37. ; Description               length          Conversion/notes
  38. ;-------------              -------         ----------------
  39. ; HEADER:
  40. ; Array type                2               (none) (AY or DY)
  41. ; Next conversion type      1               Asc() (1 = Numval(), 2 = Asc())
  42. ; Number of elements        5               Asc() on first char, or NumVal()
  43. ; Next conversion type      1               Asc() (1 = Numval(), 2 = Asc())
  44. ; Spec list length          5               Asc() on first char, or NumVal()
  45. ; SPECIFICATIONS FOR ELEMENTS:
  46. ; Spec list:                ?               concatenated spec packets
  47. ;   Spec packet:            ?               depends on contents
  48. ;   Element type            1               (none) D,L,A,M,N,Z
  49. ;   Element index length    1               Asc()  (for DY only)
  50. ;   Element index string    ?               (none) (for DY only)
  51. ;   Value string length     1, or ? for M/Z Asc(), or Numval() for M or Z
  52. ;                                           For M or Z the length is
  53. ;                                           StrVal(Length) + ","
  54. ; ELEMENT VALUES:
  55. ; Element value list        ?               data types above, in StrVal() form
  56. ;
  57. ; NOTE: Roughly 10% speed improvement can be gained by exploding
  58. ; PackMan!PackValue() and PackMan!UnpackValue() inline.
  59. ;==============================================================================
  60. ;                             PACKMAN INTERFACE
  61. ;==============================================================================
  62. ; PackMan.Constructor()
  63. ; Packman.Destructor()
  64. ; PackMan.PackAnyArrayFrom(AnyArray) ; returns AnyArrayVar
  65. ; PackMan.UnPackAnyArrayFrom(AnyArrayVar,AnyArray) ; must dimension AnyArray first
  66. ; PackMan.GetArrayType(AnyArrayVar) ; returns "AY" or "DY"
  67. ; PackMan.GetArraySize(AnyArrayVar) ; returns number of elements
  68. ; PackMan.AddArrayElementTo(AnyArrayVar,ElementValue)
  69. ; PackMan.AddDynarrayElementTo(AnyArrayVar,ElementIndex,ElementValue)
  70. ; PackMan.GetElementValueFrom(AnyArrayVar,ElementIndex) ; returns ElementValue
  71.  
  72. ;==============================================================================
  73. ;                             PACKMAN IMPLEMENTATION
  74. ;==============================================================================
  75. Proc PackMan.Constructor()
  76.    PackMan.IsActive = True
  77. EndProc ; PackMan.Constructor
  78.  
  79. Proc PackMan.Destructor()
  80.    Release Vars
  81.       PackMan.IsActive
  82. EndProc ; PackMan.Destructor
  83.  
  84. Proc PackMan.PackAnyArrayFrom(AnyArray)
  85.    Private
  86.       ArrayType,
  87.       nElements,
  88.       SpecListLength,
  89.       SpecList,
  90.       ValueList,
  91.       Element,
  92.       ElementType,
  93.       ElementValue,
  94.       ElementLength
  95.  
  96.    ArrayType = Type(AnyArray) ; "AY" or "DY"
  97.    If ArrayType = "AY" Then
  98.       nElements = ArraySize(AnyArray)
  99.    Else
  100.       nElements = DynarraySize(AnyArray)
  101.    Endif
  102.    SpecList = ""
  103.    ValueList = ""
  104.    If ArrayType = "AY" Then
  105.       For Element From 1 to nElements
  106.          ElementValue = AnyArray[Element]
  107.          PackMan!PackValue()
  108.          SpecList =
  109.             SpecList +
  110.             ElementType +
  111.             IIf(Search(ElementType,"MZ") > 0,
  112.                Strval(ElementLength) + ",",
  113.                Chr(ElementLength))
  114.       EndFor
  115.    Else
  116.       ForEach Element in AnyArray
  117.          ElementValue = AnyArray[Element]
  118.          PackMan!PackValue()
  119.          SpecList =
  120.             SpecList +
  121.             ElementType +
  122.             Chr(Len(Element)) +
  123.             Element +
  124.             IIf(Search(ElementType,"MZ") > 0,
  125.                Strval(ElementLength) + ",",
  126.                Chr(ElementLength))
  127.       EndForEach
  128.    Endif
  129.    SpecListLength = Len(SpecList)
  130.    Return ArrayType +
  131.       IIf(nElements < 1 or nElements > 255,
  132.       Chr(1) + Format("W5",nElements),Chr(2) + Chr(nElements) + Spaces(4)) +
  133.       IIf(SpecListLength < 1 or SpecListLength > 255,
  134.       Chr(1) + Format("W5",SpecListLength),Chr(2) +
  135.       Chr(SpecListLength) + Spaces(4)) +
  136.       SpecList +
  137.       ValueList
  138. EndProc ; PackMan.PackAnyArrayFrom(AnyArray)
  139.  
  140. ; Called by PackMan.PackAnyArrayFrom() and PackMan.AddArrayElementTo()
  141. Proc PackMan!PackValue()
  142.    ElementType = Substr(Type(ElementValue),1,1)
  143.    If Search(ElementType,"AM") = 0 Then
  144.       ElementValue = StrVal(ElementValue)
  145.       ElementLength = Len(ElementValue)
  146.       If ElementLength = 0 And Search(ElementType,"N$SD") > 0 Then
  147.          ElementValue = ElementType
  148.          ElementType = "B"
  149.          ElementLength = 1
  150.       Endif
  151.    Else
  152.       ElementLength = Len(ElementValue)
  153.       If ElementLength = 0 Then
  154.          ElementType = "Z"
  155.       Endif
  156.    Endif
  157.    ValueList = ValueList + ElementValue
  158. EndProc ; PackMan!PackValue
  159.  
  160. Proc PackMan.UnPackAnyArrayFrom(AnyArrayVar,AnyArray)
  161.    Private
  162.       ArrayType,
  163.       nElements,
  164.       SpecListLength,
  165.       SpecList,
  166.       SpecListPointer,
  167.       SpecListSeparator,
  168.       ValueList,
  169.       ValueListPointer,
  170.       ValueLength,
  171.       Element,
  172.       ElementLength,
  173.       ElementType,
  174.       i
  175.    ArrayType = Substr(AnyArrayVar,1,2)
  176.    nElements = IIf(Asc(Substr(AnyArrayVar,3,1)) = 1,
  177.                    NumVal(Substr(AnyArrayVar,4,5)),
  178.                    Asc(Substr(AnyArrayVar,4,1)))
  179.    SpecListLength = IIf(Asc(Substr(AnyArrayVar,9,1)) = 1,
  180.                    NumVal(Substr(AnyArrayVar,10,5)),
  181.                    Asc(Substr(AnyArrayVar,10,1)))
  182.    SpecList = Substr(AnyArrayVar,15,SpecListLength)
  183.    SpecListPointer = 1
  184.    ValueListPointer = 14 + SpecListLength + 1
  185.    If ArrayType = "AY" Then
  186.       For Element From 1 To nElements
  187.          ElementType = Substr(SpecList,SpecListPointer,1)
  188.          SpecListPointer = SpecListPointer + 1
  189.          PackMan!UnpackValue()
  190.       EndFor
  191.    Else
  192.       For i From 1 To nElements
  193.          ElementType = Substr(SpecList,SpecListPointer,1)
  194.          ElementLength = Asc(Substr(SpecList,SpecListPointer + 1,1))
  195.          Element = Substr(SpecList,SpecListPointer + 2,ElementLength)
  196.          SpecListPointer = SpecListPointer + 2 + ElementLength
  197.          PackMan!UnpackValue()
  198.       EndFor
  199.    Endif
  200. EndProc ; PackMan.UnPackAnyArrayFrom(AnyArrayVar,AnyArray)
  201.  
  202. Proc PackMan!UnpackValue()
  203.    If Search(ElementType,"MZ") > 0 Then
  204.       SpecListSeparator = SearchFrom(",",SpecList,SpecListPointer)
  205.       ValueLength = NumVal(Substr(SpecList,SpecListPointer,
  206.          SpecListSeparator - SpecListPointer))
  207.       SpecListPointer = SpecListSeparator + 1
  208.       If ElementType = "Z" Then
  209.          ElementType = "A"
  210.       EndIf
  211.    Else
  212.       ValueLength = Asc(Substr(SpecList,SpecListPointer,1))
  213.       SpecListPointer = SpecListPointer + 1
  214.    Endif
  215.    Switch
  216.       Case ElementType = "A" or ElementType = "M":
  217.          AnyArray[Element] =
  218.             Substr(AnyArrayVar,ValueListPointer,ValueLength)
  219.       Case ElementType = "N":
  220.          AnyArray[Element] =
  221.             NumVal(Substr(AnyArrayVar,ValueListPointer,ValueLength))
  222.       Case ElementType = "B":
  223.          ElementType = Substr(AnyArrayVar,ValueListPointer,ValueLength)
  224.          If ElementType = "D" Then
  225.             AnyArray[Element] = BlankDate()
  226.          Else
  227.             AnyArray[Element] = BlankNum()
  228.          Endif
  229.       Case ElementType = "L":
  230.          AnyArray[Element] =
  231.             IIf(Substr(AnyArrayVar,ValueListPointer,ValueLength) = "True",
  232.                True,False)
  233.       Case ElementType = "D":
  234.          AnyArray[Element] =
  235.             DateVal(Substr(AnyArrayVar,ValueListPointer,ValueLength))
  236.       OtherWise:
  237.          Debug ; Unexpected data type in unpack
  238.    EndSwitch
  239.    ValueListPointer = ValueListPointer + ValueLength
  240. EndProc ; PackMan!UnpackValue
  241.  
  242. Proc PackMan.GetArrayType(AnyArrayVar)
  243.    Return Substr(AnyArrayVar,1,2)
  244. EndProc ; PackMan.GetArrayType
  245.  
  246. Proc PackMan.GetArraySize(AnyArrayVar)
  247.    Return IIf(Asc(Substr(AnyArrayVar,3,1)) = 1,
  248.              NumVal(Substr(AnyArrayVar,4,5)),
  249.              Asc(Substr(AnyArrayVar,4,1)))
  250. EndProc ; PackMan.GetArraySize(AnyArrayVar)
  251.  
  252. Proc PackMan.AddArrayElementTo(AnyArrayVar,ElementValue)
  253.    Private
  254.       ArrayType,
  255.       SpecList,
  256.       SpecListLength,
  257.       ValueList,
  258.       ValuePointer,
  259.       ElementType,
  260.       ElementLength,
  261.       nElements
  262.  
  263.    If Substr(AnyArrayVar,1,2) <> "AY" Then
  264.       Return AnyArrayVar
  265.    Endif
  266.    ArrayType = Substr(AnyArrayVar,1,2)
  267.    nElements = IIf(Asc(Substr(AnyArrayVar,3,1)) = 1,
  268.                    NumVal(Substr(AnyArrayVar,4,5)),
  269.                    Asc(Substr(AnyArrayVar,4,1)))
  270.    nElements = nElements + 1
  271.    SpecListLength = IIf(Asc(Substr(AnyArrayVar,9,1)) = 1,
  272.                    NumVal(Substr(AnyArrayVar,10,5)),
  273.                    Asc(Substr(AnyArrayVar,10,1)))
  274.    SpecList = Substr(AnyArrayVar,15,SpecListLength)
  275.    ValuePointer = 14 + SpecListLength + 1
  276.    ValueList = Substr(AnyArrayVar,ValuePointer,
  277.       Len(AnyArrayVar) - ValuePointer + 1)
  278.    PackMan!PackValue()
  279.    SpecList =
  280.       SpecList +
  281.       ElementType +
  282.       IIf(Search(ElementType,"MZ") > 0,
  283.          Strval(ElementLength) + ",",
  284.          Chr(ElementLength))
  285.    SpecListLength = Len(SpecList)
  286.    Return ArrayType +
  287.       IIf(nElements < 1 or nElements > 255,
  288.       Chr(1) + Format("W5",nElements),Chr(2) + Chr(nElements) + Spaces(4)) +
  289.       IIf(SpecListLength < 1 or SpecListLength > 255,
  290.       Chr(1) + Format("W5",SpecListLength),Chr(2) +
  291.       Chr(SpecListLength) + Spaces(4)) +
  292.       SpecList +
  293.       ValueList
  294. EndProc ; PackMan.AddArrayElementTo
  295.  
  296. Proc PackMan.AddDynarrayElementTo(AnyArrayVar,ElementIndex,ElementValue)
  297.    Private
  298.       ArrayType,
  299.       SpecList,
  300.       SpecListLength,
  301.       ValueList,
  302.       ValuePointer,
  303.       ElementType,
  304.       ElementLength,
  305.       nElements
  306.  
  307.    If Substr(AnyArrayVar,1,2) <> "DY" Then
  308.       Return AnyArrayVar
  309.    Endif
  310.    ArrayType = Substr(AnyArrayVar,1,2)
  311.    nElements = IIf(Asc(Substr(AnyArrayVar,3,1)) = 1,
  312.                    NumVal(Substr(AnyArrayVar,4,5)),
  313.                    Asc(Substr(AnyArrayVar,4,1)))
  314.    nElements = nElements + 1
  315.    SpecListLength = IIf(Asc(Substr(AnyArrayVar,9,1)) = 1,
  316.                    NumVal(Substr(AnyArrayVar,10,5)),
  317.                    Asc(Substr(AnyArrayVar,10,1)))
  318.    SpecList = Substr(AnyArrayVar,15,SpecListLength)
  319.    ValuePointer = 14 + SpecListLength + 1
  320.    ValueList = Substr(AnyArrayVar,ValuePointer,
  321.       Len(AnyArrayVar) - ValuePointer + 1)
  322.    PackMan!PackValue()
  323.    ElementIndex = StrVal(ElementIndex)
  324.    SpecList =
  325.       SpecList +
  326.       ElementType +
  327.       Chr(Len(ElementIndex)) +
  328.       ElementIndex +
  329.       IIf(Search(ElementType,"MZ") > 0,
  330.          Strval(ElementLength) + ",",
  331.          Chr(ElementLength))
  332.    SpecListLength = Len(SpecList)
  333.    Return ArrayType +
  334.       IIf(nElements < 1 or nElements > 255,
  335.       Chr(1) + Format("W5",nElements),Chr(2) + Chr(nElements) + Spaces(4)) +
  336.       IIf(SpecListLength < 1 or SpecListLength > 255,
  337.       Chr(1) + Format("W5",SpecListLength),Chr(2) +
  338.       Chr(SpecListLength) + Spaces(4)) +
  339.       SpecList +
  340.       ValueList
  341. EndProc ; PackMan.AddDynarrayElementTo
  342.  
  343. Proc PackMan.GetElementValueFrom(AnyArrayVar,ElementIndex)
  344.    Private
  345.       ArrayType,
  346.       TestIndex,
  347.       SpecPointer,
  348.       ValuePointer,
  349.       ValueLengthPointer,
  350.       ValueLength,
  351.       SpecListLength,
  352.       SeparatorPointer,
  353.       ElementIndexLength,
  354.       ElementType,
  355.       ElementValue
  356.  
  357.    ArrayType = Substr(AnyArrayVar,1,2)
  358.    SpecListLength = IIf(Asc(Substr(AnyArrayVar,9,1)) = 1,
  359.                    NumVal(Substr(AnyArrayVar,10,5)),
  360.                    Asc(Substr(AnyArrayVar,10,1)))
  361.    SpecPointer = 15
  362.    ValuePointer = 15 + SpecListLength
  363.    If ArrayType = "AY" Then
  364.       For i From 1 To ElementIndex - 1 ; Get next SpecPointer and ValuePointer
  365.          ElementType = Substr(AnyArrayVar,SpecPointer,1)
  366.          If Search(ElementType,"MZ") > 0 Then
  367.             SeparatorPointer = SearchFrom(",",AnyArrayVar,SpecPointer + 1)
  368.             ValuePointer = ValuePointer +
  369.                NumVal(Substr(AnyArrayVar,SpecPointer,
  370.                SeparatorPointer - SpecPointer))
  371.             SpecPointer = SeparatorPointer + 1
  372.          Else
  373.             ValuePointer = ValuePointer +
  374.                Asc(Substr(AnyArrayVar,SpecPointer + 1,1))
  375.             SpecPointer = SpecPointer + 2
  376.          Endif
  377.       EndFor
  378.       ElementType = Substr(AnyArrayVar,SpecPointer,1)
  379.       SpecPointer = SpecPointer + 1
  380.       If Search(ElementType,"MZ") > 0 Then
  381.          SeparatorPointer = SearchFrom(",",AnyArrayVar,SpecPointer)
  382.          ValueLength =
  383.             NumVal(Substr(AnyArrayVar,SpecPointer,
  384.             SeparatorPointer - SpecPointer))
  385.          If ElementType = "Z" Then
  386.             ElementType = "A"
  387.          Endif
  388.       Else
  389.          ValueLength = Asc(Substr(AnyArrayVar,SpecPointer,1))
  390.       Endif
  391.    Else
  392.       ElementIndex = Upper(StrVal(ElementIndex))
  393.       ElementIndexLength = Asc(Substr(AnyArrayVar,SpecPointer + 1,1))
  394.       ValueLengthPointer = SpecPointer + 2 + ElementIndexLength
  395.       TestIndex = Substr(AnyArrayVar,SpecPointer + 2,ElementIndexLength)
  396.       While ElementIndex <> TestIndex
  397.          ElementType = Substr(AnyArrayVar,SpecPointer,1)
  398.          If Search(ElementType,"MZ") > 0 Then
  399.             SeparatorPointer =
  400.                SearchFrom(",",AnyArrayVar,ValueLengthPointer)
  401.             ValuePointer = ValuePointer +
  402.                NumVal(Substr(AnyArrayVar,ValueLengthPointer,
  403.                SeparatorPointer - ValueLengthPointer))
  404.             SpecPointer = SeparatorPointer + 1
  405.          Else
  406.             ValuePointer = ValuePointer +
  407.                Asc(Substr(AnyArrayVar,ValueLengthPointer,1))
  408.             SpecPointer = ValueLengthPointer + 1
  409.          Endif
  410.          ElementIndexLength = Asc(Substr(AnyArrayVar,SpecPointer + 1,1))
  411.          ValueLengthPointer = SpecPointer + 2 + ElementIndexLength
  412.          TestIndex = Substr(AnyArrayVar,SpecPointer + 2,ElementIndexLength)
  413.       EndWhile
  414.       ElementType = Substr(AnyArrayVar,SpecPointer,1)
  415.       If Search(ElementType,"MZ") > 0 Then
  416.          SeparatorPointer = SearchFrom(",",AnyArrayVar,ValueLengthPointer)
  417.          ValueLength =
  418.             NumVal(Substr(AnyArrayVar,ValueLengthPointer,
  419.             SeparatorPointer - ValueLengthPointer))
  420.          If ElementType = "Z" Then
  421.             ElementType = "A"
  422.          Endif
  423.       Else
  424.          ValueLength = Asc(Substr(AnyArrayVar,ValueLengthPointer,1))
  425.       Endif
  426.    EndIf
  427.    Switch
  428.       Case ElementType = "A" or ElementType = "M":
  429.          ElementValue =
  430.            Substr(AnyArrayVar,ValuePointer,ValueLength)
  431.       Case ElementType = "N":
  432.          ElementValue =
  433.             NumVal(Substr(AnyArrayVar,ValuePointer,ValueLength))
  434.       Case ElementType = "B":
  435.          ElementType = Substr(AnyArrayVar,ValueListPointer,ValueLength)
  436.          If ElementType = "D" Then
  437.             AnyArray[Element] = BlankDate()
  438.          Else
  439.             AnyArray[Element] = BlankNum()
  440.          Endif
  441.       Case ElementType = "L":
  442.          ElementValue =
  443.             IIf(Substr(AnyArrayVar,ValuePointer,ValueLength) = "True",
  444.                True,False)
  445.       Case ElementType = "D":
  446.          ElementValue =
  447.             DateVal(Substr(AnyArrayVar,ValuePointer,ValueLength))
  448.       Otherwise:
  449.          Debug ; unknown data type in PackMan.GetElementValueFrom
  450.    EndSwitch
  451.    Return ElementValue
  452. EndProc ; PackMan.GetElementValueFrom