Convert to COMP-3 using VB

Step 1: Convert the time value into a double
Step 2: Convert the Double into a Packed Decimal String (COMP-3)
Step 3: Convert the string into a byte array.

For Example:
'------------
Dim tDouble As Double
Dim tStr As String
Dim tByteArray() as Byte
Dim tTimeStr As String
Dim i As Long

tTimeStr = "12:04:03"
tDouble = 120403
tStr = DoubleToPackedString(tDouble, 7, 0) 'function defined below...

'allocate the bytes needed for the resulting string
ReDim tByteArray(0 To Len(tStr) - 1)

For i = 0 To Len(tStr) - 1
tByteArray(i) = Asc(Mid(tStr, i + 1, 1))
Next i
'------------

Public Function DoubleToPackedString(pDouble As Double, pLength As Long, pFraction As Long) As String
Dim tDouble As Double
Dim tDecimalStr As String

Dim tLen As Long
Dim tChar As String
Dim tHiBits As Byte
Dim tLoBits As Byte
Dim tPChar As String
Dim i As Long
Dim tPackStr As String
Dim tSignChar As Byte

Dim tFormatStr As String

tPackStr = ""

tFormatStr = String(pLength - pFraction, "0") & "." & String(pFraction, "0")

'format it to the size desired
tDecimalStr = Format(pDouble, tFormatStr)

'if negative remove the leading sign
If pDouble < 0 Then
tDecimalStr = Mid(tDecimalStr, 2)
End If

'remove the decimal place
tDecimalStr = Left(tDecimalStr, InStr(tDecimalStr, ".") - 1) & Mid(tDecimalStr, InStr(tDecimalStr, ".") + 1)

'make sure we only convert the correct overall length expected
'example problem: pDouble=1.0, pLength=7, pFraction=7 (i.e. PIC V9(7) ) resulting formated string = 1.0000000
tDecimalStr = Right(tDecimalStr, pLength)

'if its an even length, we need to add a leading zero to even out
'the result when adding the sign character
' If (pLength - pFraction) Mod 2 = 0 Then
If Len(tDecimalStr) Mod 2 = 0 Then
'add a leading 0
tDecimalStr = "0" & tDecimalStr
End If

tLen = Len(tDecimalStr)

For i = 1 To tLen - 1
tChar = Mid(tDecimalStr, i, 1)
'even number are the "LoBits", odd are the "HiBits"
If i Mod 2 <> 0 Then
'get the value and shift it 4 bits
tHiBits = Val(tChar) * 16
Else
'get the value
tLoBits = Val(tChar)

'add them together and get the resulting character
tPChar = Chr(tHiBits + tLoBits)
tPackStr = tPackStr & tPChar
tHiBits = 0
tLoBits = 0
End If
Next i

'add the sign character
tChar = Mid(tDecimalStr, i, 1)
'get the value of the last character and shift it 4 bits
tHiBits = Val(tChar) * 16

'add the sign character
If pDouble >= 0 Then
tLoBits = 12
Else
tLoBits = 13
End If

'add them together and get the resulting character
tPChar = Chr(tHiBits + tLoBits)
tPackStr = tPackStr & tPChar

DoubleToPackedString = tPackStr

End Function

How did you determine what to input as length to the function? I need to write something to convert a file to ftp up to the mainframe and it contains comp-3 fields so I would like to understand exactly how this would work.

Thanks!!!

Do you have the copy book that defines the file layout ? The comp-3 definitions define the length, for example,

05 MyCompField Pic S9(10)V9(2) Comp-3.

Where:

V = decimal place
9 = a numeric digit
10 = Length (number digits to the left of the decimal place)
2 = Fraction (number of digits to the right of the decimal place)

So each comp-3 field will be a different length depending on its definition.

so given your example, would the length be 12? I do have to layout that I need for the file and it contains all the cobol definitions for the fields. Do implied decimals count for the length parameter or do I just sum the digits to the left and right of the decimal?

The function calculates the length of the field as follows:

FieldLength = (Length + Fraction)

If FieldLength Mod 2 = 0 Then
'add 1 to the field length
FieldLength = FieldLength + 1
End If

So that in the given the example above, the length of the data is:

If (10 + 2) Mod 2 = 0 Then
FieldLength = 10 + 2 + 1
Else
FieldLength = 10 + 2
End If

Do you know how packed decimal (i.e. comp-3) fields are stored internally ?

I am taking a text file and converting it to EBCDIC to use on the mainframe. Many of the fields that I need to populate contain leading and trailing 0's which seem to be truncated during the function. Any suggestions on how to modify so it will not lose the zeros. I am feeding a COBOL program so I need to have them for placeholders.
thanks,

Thanks I will give this a try. I have a combination of fields to read that are converted to comp-3 or just picx and I write out three different layouts for each line that read in.