The Code that I gave you in Command1_Click was merely a "testbed" for a test of PKToBin. For your input file, how is the end of a record determined, by length? It can't be CrLF because a packed number like x'10130C' would cause a premature "end of record". You are going to have to use a BINARY OPEN and use the Get statement to read the
UNTRANSALATED binary data from the file, downloaded from the mainframe. Define fixed length arrays "as Byte" for every field that you will read. You will need to use LOF(intFileNo) to know the length of the file.
Sample Open
intFileNo = FreeFile
Open wTempFile For Binary Access Read As #intFileNo
Sample byte arrays for fields.
Dim bytPriority(0) As Byte ' SDR-PRIORITY PIC 9(01).
Dim bytUsage(3) As Byte ' SDR-USAGE PIC 9(08) COMP.
Dim bytAcctStatus(0) As Byte ' SDR-ACCT-STATUS PIC X(01).
Dim bytLastModDate(3) As Byte ' SDR-LAST-MOD-DATE PIC S9(07) COMP-3.
Dim bytLastModTime(3) As Byte ' SDR-LAST-MOD-TIME PIC S9(07) COMP-3.
Dim bytLastModOper(7) As Byte ' SDR-LAST-MOD-OPER PIC X(08).
Dim bytExpirationDate(3) As Byte ' SDR-EXPIRATION-DATE PIC S9(07) COMP-3.
Dim bytNumberMessages(1) As Byte ' SDR-NUMBER-MESSAGES PIC S9(04) COMP.
Dim bytCustomerName(24) As Byte ' SDR-CUSTOMER-NAME PIC X(25).
Dim bytLengthOfSignature(1) As Byte ' SDR-LENGTH-OF-SIGNATURE PIC S9(04) COMP.
You will need to read each field individually.
Smple GETS for each field.
Get #intFileNo, , bytAcctStatus
Get #intFileNo, , bytLastModDate
Get #intFileNo, , bytAHRLocator
Get #intFileNo, , bytAHROfficer
Get #intFileNo, , bytAHRNumberSignature
Get #intFileNo, , bytAHRNextSignature
Get #intFileNo, , bytNumberMessages
wAHR.AHRBank = PDToLng(bytBank)
wAHR.AHRAppl = PDToLng(bytAppl)
wAHR.AHRAcct = PDToStr(bytAcct)
wAHR.AHRNumber = BytToLng(bytNumber)
wAHR.AHRPriority = BytEBCDICToAscii(bytPriority)
wAHR.AHRAcctStatus = BytEBCDICToAscii(bytAcctStatus)
wAHR.AHRLastModOper = BytEBCDICToAscii(bytLastModOper)
wAHR.AHROfficer = BytEBCDICToAscii(bytAHROfficer)
wAHR.AHRLocator = BytEBCDICToAscii(bytAHRLocator)
wAHR.AHRNumberMessages = BytToLng(bytNumberMessages)
wAHR.AHRMessages = ""
For I = 0 To wAHR.AHRNumberMessages - 1
Get #intFileNo, , bytMessage
wAHR.AHRMessages = wAHR.AHRMessages & _
BytEBCDICToAscii(bytMessage)
Next
Function PDToLng(pByt() As Byte) As Long
Dim I As Integer, L As Integer, lngR As Long, lngW As Long
L = UBound(pByt)
For I = 0 To L - 1
lngR = lngR * 100 + (pByt(I) \ 16) * 10 + (pByt(I) And &HF)
Next
lngR = lngR * 10 + (pByt(I) \ 16)
lngW = pByt(I) And &HF
If lngW = 11 Or lngW = 13 Or lngW = 14 Then
lngR = -lngR
End If
PDToLng = lngR
End Function
Function BytToLng(pByt() As Byte) As Long
Dim L As Integer, lngR As Long
L = UBound(pByt)
lngR = pByt(0) * 256 + pByt(1)
If L > 1 Then
lngR = lngR * 65536 + pByt(2) * 256 + pByt(3)
End If
BytToLng = lngR
End Function
Function PDToStr(pByt() As Byte) As String
Dim L As Integer, I As Integer, J As Integer
J = UBound(pByt)
L = (UBound(pByt) + 1) * 2 - 1
PDToStr = Space$(L)
For I = 0 To J
Mid$(PDToStr, 2 * I + 1, 1) = ChrW(pByt(I) \ 16 + 48)
Next
For I = 0 To J - 1
Mid$(PDToStr, 2 * I + 2, 1) = ChrW((pByt(I) And &HF) + 48)
Next
End Function
Function BytEBCDICToAscii(pByt() As Byte) As String
Static bytASCII(255) As Byte
Dim intEB As Integer, intAscii As Integer
' Check last byte for 0; allows for re-entrancy
If bytASCII(&HFF) = 0 Then
bytASCII(&H40) = 32
bytASCII(&H5A) = 33 ' !
bytASCII(&H7F) = 34 ' "
bytASCII(&H7B) = 35 ' #
bytASCII(&H5B) = 36 ' $
bytASCII(&H6C) = 37 ' %
bytASCII(&H50) = 38 ' &
bytASCII(&H7D) = 39 ' '
bytASCII(&H4D) = 40 ' (
bytASCII(&H5D) = 41 ' )
bytASCII(&H5C) = 42 ' *
bytASCII(&H4E) = 43 ' +
bytASCII(&H6B) = 44 ' ,
bytASCII(&H60) = 45 ' -
bytASCII(&H4B) = 46 ' .
bytASCII(&H61) = 47 ' /
intAscii = 48
For intEB = &HF0 To &HF9
bytASCII(intEB) = intAscii
intAscii = intAscii + 1
Next
bytASCII(&H7A) = 58 ' :
bytASCII(&H5E) = 59 ' ;
bytASCII(&H4C) = 60 ' <
bytASCII(&H7E) = 61 ' =
bytASCII(&H6E) = 62 ' >
bytASCII(&H6F) = 63 ' ?
bytASCII(&H7C) = 64 ' @
intAscii = 65
For intEB = &HC1 To &HC9
bytASCII(intEB) = intAscii
intAscii = intAscii + 1
Next
For intEB = &HD1 To &HD9
bytASCII(intEB) = intAscii
intAscii = intAscii + 1
Next
For intEB = &HE2 To &HE9
bytASCII(intEB) = intAscii
intAscii = intAscii + 1
Next
bytASCII(&HAD) = 91 ' [
bytASCII(&HE0) = 92 ' bytASCII(&HBD) = 93 ' ]
' bytASCII(&Hxx) = 94 ' ^
bytASCII(&H6D) = 95 ' _'
bytASCII(&H79) = 96 ' `
intAscii = 97
For intEB = &H81 To &H89
bytASCII(intEB) = intAscii
intAscii = intAscii + 1
Next
For intEB = &H91 To &H99
bytASCII(intEB) = intAscii
intAscii = intAscii + 1
Next
For intEB = &HA2 To &HA9
bytASCII(intEB) = intAscii
intAscii = intAscii + 1
Next
bytASCII(&HC0) = 123 ' {
bytASCII(&H4F) = 124 ' `|
bytASCII(&HD0) = 125 ' }
bytASCII(&HA1) = 126 ' ~
bytASCII(&HFF) = 255
End If
Dim I As Integer, J As Integer, K As Integer
J = UBound(pByt)
BytEBCDICToAscii = Space$(J + 1)
For I = 0 To J
K = I + 1
Mid$(BytEBCDICToAscii, K, 1) = ChrW(bytASCII(pByt(I)))
Next
End Function
Forms/Controls Resizing/Tabbing Control
Compare Code (Text)
Generate Sort Class in VB or VBScript