Option Explicit


''  VisualBasic Code to read the Palm AddressBook



''      thanks to Scott Leighton:
''      http://www.geocities.com/helphand1/palmrecs.htm
''      helphand@pacbell.net


''  typical usage:


''Private Sub CommandReadFile_Click()
''    Dim myFileHeader As PalmAddressFileHeader
''    Dim myAddress As PalmAddressrec
''    Dim i As Integer
''    Dim myFilename As String
''    Dim myFilenum As Integer
''    myFilenum = 1
''    myFilename = "mydirectory    \address\address.dat"
''    Debug.Print Dir(myFilename)
''    Open myFilename For Binary As myFilenum
''    myFileHeader = PalmGetAddressFileHeader(myFilenum)
''    For i = 1 To myFileHeader.NumEntries
''            myAddress = PalmGetAddress(myFilenum)
''            If i < 10 Or i > 520 Then PalmPrintAddress myAddress
''    Next i
''    Close myFilenum
''End Sub




Public Type PalmCategoryRec
    Index As Long ''4*Byte Category Index
    ID As Long ''4*Byte Category ID
    DirtyFlag As Long ''4*Byte Category Dirty Flag
    LongName As String ''Cstring   Long Category Name
    ShortName  As String  ''Cstring Short Category Name
End Type


Public Type PalmAddressFileHeader
    Tag As String            ''Version Tag Char 4*Byte 0x00 0x01 0x42 0x41 (AB10) for Address
    Filename As String      ''File Name CString   Fully Qualified Filename of file on PC
    CustomNames As String   ''Table String CString   Custom Names followed by a Custom show header
    NextFree As Long        ''Next Free Long 4*Byte Next Free Category ID
    CategoryCount As Long   ''Category Count Long 4*Byte Count - 1 of the number of category entries (does not include Unfiled category)
    Categories() As PalmCategoryRec
    ResourceID As Long         ''Resource ID Long 4*Byte Schema Resource ID
    FieldsperRow As Long     ''Fields per Row Long 4*Byte Schema Fields per row. Will be 30 for address.
    RecIDPos As Long            ''Rec ID Pos Long 4*Byte Schema Record ID Position (index to field table entry that contains record id)
    RecStatusPos As Long        ''Rec Status Pos Long 4*Byte Schema Record Status Position (index to field table entry that contains record status)
    PlacementPos As Long        ''Placement Pos Long 4*Byte Schema Placement Position (index to field table entry that contains record placement position)
    FieldCount As Integer       ''Field Count Short 2*Byte Schema Field Count (number of fields in schema) Corrected April 19, 2000
    FieldEntries() As Integer       ''Field Entry Short 2*Byte Schema field entry occurs field count times. For address the entries will be 1,1,1,5,5,5,5,1,5,1,5,1,5,1,5,1,5,5,5,5,5,5,5,6,1,5,5,5,5,1 Corrected April 19, 2000
    NumEntries As Long              ''Num Entries Long 4*Byte Record count * 30 (number of field entries in entire file, as noted, divide by 30 to arrive at actual record count)
End Type



Public Type PalmPhone
    Label As Integer
    Number As String
End Type


Public Type PalmAddressrec
    RecordID As Long
    StatusField As Long
    Position As Long
    Name As String
    First As String
    Title As String
    Company As String
    Phone1 As PalmPhone
    Phone2 As PalmPhone
    Phone3 As PalmPhone
    Phone4 As PalmPhone
    Phone5 As PalmPhone
    Address As String
    City As String
    State As String
    Zip As String
    Country As String
    Note As String
    Private As Boolean
    Category As Long
    Custom1 As String
    Custom2 As String
    Custom3 As String
    Custom4 As String
    DisplayPhone As Long
End Type


Public Function PalmGetCStringField(myFilenum) 'maps to
Dim b As Byte, l As Integer, i As Integer, o  As String
    PalmGetLong (myFilenum)    ''FieldType As Long       ' 4 x Byte value 5
    PalmGetLong (myFilenum)    ''Padding As Long         ' 4 x Byte
    PalmGetCStringField = PalmGetCString(myFilenum)    ''Value As String
' String represented by Cstring
End Function
Public Function PalmGetCString(myFilenum)
''Cstrings are stored as follows:
''  Strings less than 255 bytes are stored with the length specified in the first byte followed by the actual string.
''  Zero length strings are stored with a 0x00 byte.
''  Strings 255 bytes or longer are stored with a flag byte set to 0xFF followed by a short (2*Byte) that specifies the length of the string, followed by the actual string.
Dim c As String, b As Integer, l As Integer, i As Integer, o  As String
c = InputB(1, myFilenum): If c = "" Then b = 0 Else b = AscB(c)
    o = ""
    If b > 0 Then
        If b = 255 Then l = PalmGetShort(myFilenum) Else l = b
        o = ""
        For i = 1 To l
            o = o & Input(1, myFilenum)
        Next i
    End If
    PalmGetCString = o
End Function
Public Function PalmGetTag(myFilenum) As String
Dim c1 As String, c2 As String, c3 As String, c4 As String
    c1 = InputB(1, myFilenum): c2 = InputB(1, myFilenum)
    c3 = InputB(1, myFilenum): c4 = InputB(1, myFilenum)
    PalmGetTag = c1 & c2 & c3 & c4
End Function
Public Function PalmGetLong(myFilenum) As Long
Dim c1 As String, c2 As String, c3 As String, c4 As String
Dim b1 As Long, b2 As Long, b3 As Long, b4 As Long
Dim h As Double
    c1 = InputB(1, myFilenum): If c1 = "" Then b1 = 0 Else b1 = AscB(c1)
    c2 = InputB(1, myFilenum): If c2 = "" Then b2 = 0 Else b2 = AscB(c2)
    c3 = InputB(1, myFilenum): If c3 = "" Then b3 = 0 Else b3 = AscB(c3)
    c4 = InputB(1, myFilenum): If c4 = "" Then b4 = 0 Else b4 = AscB(c4)
    If b4 < 255 Then
        h = b1 + 256 * (b2 + 256 * (b3 + 256 * b4))
    Else
        h = 0
    End If
    PalmGetLong = h
End Function
Public Function PalmGetShort(myFilenum) As Long
Dim c1 As String, c2 As String
Dim b1 As Integer, b2 As Integer
Dim h As Long
    c1 = InputB(1, myFilenum): If c1 = "" Then b1 = 0 Else b1 = AscB(c1)
    c2 = InputB(1, myFilenum): If c2 = "" Then b2 = 0 Else b2 = AscB(c2)
    h = b1 + 256 * b2
    PalmGetShort = h
End Function
Public Function PalmGetInteger(myFilenum) As Long
    PalmGetLong (myFilenum) ''FieldType As Long       ' 4 x Byte  value 1
    PalmGetInteger = PalmGetLong(myFilenum)    ''Value As Integer        ' 4 x Byte
End Function
Public Function PalmGetBoolean(myFilenum) As Boolean
    PalmGetLong (myFilenum) ''FieldType As Long      ' 4 x Byte value 6
    If PalmGetLong(myFilenum) = 1 Then PalmGetBoolean = True Else
PalmGetBoolean = False    ''    Value As Boolean        ' 4 x Byte 1 = True
End Function
Public Function PalmGetPhone(myFilenum) As PalmPhone
Dim myPhone As PalmPhone
With myPhone
    .Label = PalmGetInteger(myFilenum)
    .Number = PalmGetCStringField(myFilenum)
End With
PalmGetPhone = myPhone
End Function
Public Function PalmGetCategory(myFilenum) As PalmCategoryRec
Dim myCategory As PalmCategoryRec
With myCategory
    .Index = PalmGetLong(myFilenum)
    .ID = PalmGetLong(myFilenum)
    .Index = PalmGetLong(myFilenum)
    .LongName = PalmGetCString(myFilenum)
    .ShortName = PalmGetCString(myFilenum)
End With
PalmGetCategory = myCategory
End Function
Public Function PalmGetAddressFileHeader(myFilenum) As PalmAddressFileHeader
Dim myFH As PalmAddressFileHeader
Dim i As Integer
With myFH
    .Tag = PalmGetTag(myFilenum)               ''Version Tag Char 4*Byte 0x00 0x01 0x42 0x41 (AB10) for Address
    .Filename = PalmGetCString(myFilenum)      ''File Name CString   Fully Qualified Filename of file on PC
    .CustomNames = PalmGetCString(myFilenum) ''Table String CString   Custom Names followed by a Custom show header
    .NextFree = PalmGetLong(myFilenum) ''Next Free Long 4*Byte Next Free Category ID
    .CategoryCount = PalmGetLong(myFilenum) ''Category Count Long 4*Byte Count - 1 of the number of category entries (does not include Unfiled category)
    ReDim .Categories(.CategoryCount)
    For i = 1 To .CategoryCount
''Category entries Category-Entry   Occurs category count times
            .Categories(i) = PalmGetCategory(myFilenum)
            Debug.Print .Categories(i).ShortName
    Next i
    .ResourceID = PalmGetLong(myFilenum)
''Resource ID Long 4*Byte Schema Resource ID
    .FieldsperRow = PalmGetLong(myFilenum)
''Fields per Row Long 4*Byte Schema Fields per row. Will be 30 for address.
    .RecIDPos = PalmGetLong(myFilenum)
''Rec ID Pos Long 4*Byte Schema Record ID Position (index to field table entry that contains record id)
    .RecStatusPos = PalmGetLong(myFilenum)
''Rec Status Pos Long 4*Byte Schema Record Status Position (index to field table entry that contains record status)
    .PlacementPos = PalmGetLong(myFilenum)
''Placement Pos Long 4*Byte Schema Placement Position (index to field table entry that contains record placement position)
    .FieldCount = PalmGetShort(myFilenum)
''Field Count Short 2*Byte Schema Field Count (number of fields in schema) Corrected April 19, 2000
    ReDim .FieldEntries(.FieldCount)
    For i = 1 To .FieldCount                                      ''Field Entry Short 2*Byte Schema field entry occurs field count times. For address the entries will be 1,1,1,5,5,5,5,1,5,1,5,1,5,1,5,1,5,5,5,5,5,5,5,6,1,5,5,5,5,1 Corrected April 19, 2000
            .FieldEntries(i) = PalmGetShort(myFilenum)
    Next i
    .NumEntries = PalmGetLong(myFilenum) / .FieldCount
''Num Entries Long 4*Byte Record count * 30 (number of field entries in entire file, as noted, divide by 30 to arrive at actual record count)
    End With
    PalmGetAddressFileHeader = myFH
End Function



Public Function PalmGetAddress(myFilenum) As PalmAddressrec
Dim myAddress As PalmAddressrec
With myAddress
    .RecordID = PalmGetInteger(myFilenum)
    .StatusField = PalmGetInteger(myFilenum)
    .Position = PalmGetInteger(myFilenum)
    .Name = PalmGetCStringField(myFilenum)
    .First = PalmGetCStringField(myFilenum)
    .Title = PalmGetCStringField(myFilenum)
    .Company = PalmGetCStringField(myFilenum)
    .Phone1 = PalmGetPhone(myFilenum)
    .Phone2 = PalmGetPhone(myFilenum)
    .Phone3 = PalmGetPhone(myFilenum)
    .Phone4 = PalmGetPhone(myFilenum)
    .Phone5 = PalmGetPhone(myFilenum)
    .Address = PalmGetCStringField(myFilenum)
    .City = PalmGetCStringField(myFilenum)
    .State = PalmGetCStringField(myFilenum)
    .Zip = PalmGetCStringField(myFilenum)
    .Country = PalmGetCStringField(myFilenum)
    .Note = PalmGetCStringField(myFilenum)
    .Private = PalmGetBoolean(myFilenum)
    .Category = PalmGetInteger(myFilenum)
    .Custom1 = PalmGetCStringField(myFilenum)
    .Custom2 = PalmGetCStringField(myFilenum)
    .Custom3 = PalmGetCStringField(myFilenum)
    .Custom4 = PalmGetCStringField(myFilenum)
    .DisplayPhone = PalmGetInteger(myFilenum)
End With
PalmGetAddress = myAddress
End Function
Public Sub PalmPrintAddress(myA As PalmAddressrec)
With myA
Debug.Print
Debug.Print .RecordID, .StatusField, .Position
Debug.Print .Name, .First, .Title, .Company
If .Phone1.Number <> "" Then Debug.Print .Phone1.Label, " xxx:", .Phone1.Number
If .Phone2.Number <> "" Then Debug.Print .Phone2.Label, " xxx:", .Phone2.Number
If .Phone3.Number <> "" Then Debug.Print .Phone3.Label, " xxx:", .Phone3.Number
If .Phone4.Number <> "" Then Debug.Print .Phone4.Label, " xxx:", .Phone4.Number
If .Phone5.Number <> "" Then Debug.Print .Phone5.Label, " xxx:", .Phone5.Number
Debug.Print .Address, .City, .State, .Zip, .Country
If .Note <> "" Then Debug.Print .Note
Debug.Print .Private, .Category
Debug.Print .Custom1, .Custom2, .Custom3, .Custom4, .DisplayPhone
End With
End Sub