VB6 unpacking and packing decimals. 2

[moki]

Anyone out there have a routine to unpack and pack comp-3 EBCDIC fields.

I am trying to limit the modification required on our mainframe by FTPing mainframe files containing packed decimal fields by unpacking them via a VB6 project.

Currently, to read mainframe data with packed decimal fields I would have to unpack it and output the records to a text file then FTP it to VB6.

Your help is appreciated.

Moki

 

[RickSpr]

Make sure you do the FTP in binary mode. Otherwise, the file transfer program will attempt to convert the bytes of the packed number to equivalent ASCII characters. For example, X'81825F' will become "ab_".

I'm assuming you're reading the downloaded data as text, and you'll extract the packed numbers with Mid$(). The following procedure will convert it to a signed Long. Note that it checks for valid packed decimal data, with standard "C", "D", or "F" sign. If it finds bad data, it will raise an error.

Public Function UnpackComp3(Value As String) As Long
    Dim i As Integer, length As Integer
    Dim d As Integer, hi As Integer, lo As Integer
    Dim result As Long
    
    length = Len(Value)
    For i = 1 To length - 1
        d = Asc(Mid$(Value, i, 1))
        hi = d \ 16
        lo = d And 15
        If (hi > 9) Or (lo > 9) Then GoTo BadNumber
        result = (result * 10 + hi) * 10 + lo
    Next i
    d = Asc(Mid$(Value, length, 1))
    hi = d \ 16
    If hi > 9 Then GoTo BadNumber
    lo = d And 15
    result = result * 10 + hi
    Select Case lo
        Case &HC, &HF
        Case &HD
            result = -result
        Case Else
            GoTo BadNumber
    End Select
    UnpackComp3 = result
    Exit Function
BadNumber:
    ' "Value" is not a valid packed number
    Err.Raise 5, "UnpackComp3", "Passed value is not a valid COMP-3 number."
End Function

A Long data type will hold up to 9 digits. If that's not enough, change the function type and the 'result' variable to Double. Rick Sprague

 

[moki]

Hello Rick,

Thank you for the routine but I am having some difficulty getting it to work.

I have 292 150 bytes records = 43800 bytes in total.

I FTP in binary and get 42 1022 byte records pluse 995 in the last record = 43919 (42*1022+995).

When I Line Input below, I get 1 record containing 43137 bytes.

Tried parsing at 150 bytes but running into BadNumber err = 5.

The code I use to prep. for the call to your function:

Private Sub Command1_Click()
Dim strInput As String
Dim strValue As String
Dim lngExp As Long
Dim lngBc As Long
Dim intInput As Integer

Open "c:\csunpack.txt" For Input As #1
'Open "C:\CSunpack.txt" For Binary Access Read As #1

Do Until EOF(1)
Line Input #1, strInput
If Len(strInput) <> 0 Then
intInput = intInput + 1
strValue = Mid(strInput, 76, 3)
lngExp = lngExp + UnpackComp3(strValue)
strValue = Mid(strInput, 124, 3)
lngBc = lngBc + UnpackComp3(strValue)
End If
Loop
Label1.Caption = lngExp
Label2.Caption = lngBc
Label3.Caption = intInput
Close #1

End Sub

Much thanks for your help..after this works, do you have a packing routine?

Moki

 

[RickSpr]

Moki,

It's not going to do any good to run your data through my code until you can get it transferred as recognizable records. You're probably going to have to get some help with the FTP parameters. I figure you should transfer it as fixed length records, then maybe read 150 bytes at a time from the PC file. In any event, you should end up with a file of 43800 bytes. If it comes out larger, you might be able to use it, if you can account for the extra bytes. (One possibility would be CRLF at the end of each record, giving you 44384 bytes.)

I'll work on writing a pack routine for you and get back to you. Rick Sprague

 

[moki]

Hi Rick,

Got it now with open &quot;xxx&quot; for random as #1 len=150

My totals on the pack fields come out okay.

Any chance of getting the other side of the coin - packing?

Thank you Rick,

Mel

 

[RickSpr]

Glad you got it working. Here's your Pack routine:

Public Function PackComp3(Value As Long, Size As Long, _
                          Optional Signed As Boolean = True) As String
' Converts a value to an IBM packed decimal field of specified size.
' Use Signed:=False if you want positive values to have an 'F' sign.
    Dim s As String, length As Integer
    Dim v As Long, i As Integer, d As Integer

    If (Size < 1) Or (Size > 16) Then Err.Raise 5 'bad argument
    v = Value
    s = Space$(Size)
    For i = 1 To Size
        Mid$(s, i, 1) = Chr$(0)
    Next i
    i = Size
    If Value < 0 Then
        d = &HD
        v = -v
    ElseIf Signed Then
        d = &HC
    Else
        d = &HF
    End If
    d = d Or ((v Mod 10) * 16)
    Mid$(s, i, 1) = Chr$(Asc(Mid$(s, i, 1)) Or d)
    v = v \ 10
    If v <> 0 Then
        For i = Size - 1 To 1 Step -1
            d = (v Mod 10)
            v = v \ 10
            d = d Or ((v Mod 10) * 16)
            v = v \ 10
            Mid$(s, i, 1) = Chr$(d)
            If v = 0 Then Exit For
        Next i
    End If
    PackComp3 = s
End Function

Rick Sprague

 

[moki]

Much thanks Rick,

I have not tried it yet, but I just know it will work.

Mahalo (Thank you in Hawaiian),

Moki