Global   MultiSel()
Global   MoveBar()
Global   Menu[1000,2], Item, Bar, Tkey, NumItems, Selection
Global   ItemOrder

Global DbFields()
Global FileName All

Local BinNumOfFiles NumOfFiles BinHeader BinDummy
Local BinFileName AllfileNames Ctr
Local BinFNLength FNLength BinDead Dead

BUFFER BinDead        SIZE 55
BUFFER BinHeader      SIZE 55
BUFFER BinNumOfFiles  SIZE 2
BUFFER BinDummy       SIZE 62
BUFFER BinFNLength    SIZE 2              'Length of file name.
BUFFER BinFileName    SIZE 30

AllFileNames = Null

FileName = Upper(Ask("Enter FileName:"))

If FileName ! ".VW"

Fopen FileName As 1
 Fseek 1 6
 Fread 1 Binary 2 Into BinDead
 UnPack BinDead "B" Dead
 Fseek 1 55+Dead
 Fread 1 Binary 2 Into BinNumOfFiles
 UnPack BinNumOfFiles "B" NumOfFiles
 Fseek 1 117+Dead
 '  Fread 1 Binary 60 Into BinDummy
   Fread 1 Binary 2 Into BinFNLength
   UnPack BinFNLength "B" FNLength
   Fread 1 Binary FNLength Into BinFileName
   UnPack BinFileName "S" FileName
   AllFileNames = FileName
 For Ctr = 2 To NumOfFiles
   Fread 1 Binary 20 Into BinDummy
   Fread 1 Binary 2 Into BinFNLength
   UnPack BinFNLength "B" FNLength
   Fread 1 Binary FNLength Into BinFileName
   UnPack BinFileName "S" FileName
   AllFileNames = AllFileNames & FileName
 End For
Fclose 1

   FileName = Group(AllFileNames,1)|".db"
   DbFields()
 For Ctr = 2 To NumOfFiles
   FileName = Group(AllFileNames,Ctr)|".db"
   DbFields()
 End For

ElseIf FileName ! ".DB"
  DbFields()
Else
 exit main
End If

beep
MultiSel(trim(All),chr(32),1,1,15,1,15,12)


Function DbFields()
 Local NumOfFields Ctr
 Local BinHeader BinNumOfFields BinDummy
 Local  BinFieldLength   BinFieldOffset   BinFieldType   BinFieldName
 Local  FieldLength   FieldOffset   FieldType   FieldName

  BUFFER BinHeader         SIZE 2080
  BUFFER BinNumOfFields    SIZE 2
  BUFFER BinDummy          SIZE 22

  BUFFER BinFieldLength    SIZE 2
  BUFFER BinFieldOffset    Size 2
  BUFFER BinFieldType      Size 2

  BUFFER BinFieldName      Size 22


Fopen FileName as 1
    Fread 1 Binary 2080 Into BinHeader
    Fread 1 Binary 2 Into BinNumOfFields
    UnPack BinNumOfFields "B" NumOfFields
    Fread 1 Binary 22 Into BinDummy

For Ctr = 1 to NumOfFields
    Fread 1 Binary 2 Into BinFieldLength
    UnPack BinFieldLength "B" FieldLength
    Fread 1 Binary 2 Into BinFieldOffset
    UnPack BinFieldLength "B" FieldOffset
    Fread 1 Binary 2 Into BinFieldType
    UnPack BinFieldType "B" FieldType
    Fread 1 Binary 22 Into BinFieldName
    UnPack BinFieldName "S" FieldName
    All = All & fieldname
End For
fclose 1

End Function




'----------------------------------------------------------------------------
'MultiSel function
'----------------------------------------------------------------------------
'Function       To return multiple choices from the selection menu.
'
'Usage          MultiSel(InData,Delim,Lr,Lc,FG,BG,HFG,HBG)
'   Where:
'               InData
'                  Is any text file with each selection item
'                  on a separate line,
'                 or
'                  A variable that contains all of the possible
'                  items separated by a common delimitor.
'               Delim
'                  Can be any character from 0..255.
'                  But should be limited to unique characters.
'
'               Lr = Left row coordinate.
'               Lc = Left column coordinate.
'               FG = Foreground color.
'               BG = Background color.
'               HFG = Hilighter Foreground color.
'               HBG = Hilighter Background color.
'
'Returns        Null when Escape is pressed.
'               All choices delimited by Delim when Enter
'               is pressed.
'
'Restrictions   If InData is a variable it may contain no
'               more than 1000 characters.
'
'********************************************************************
'* BUG - When deselecting items; if the item being deselected is in *
'*       a position after another item that contains the same text  *
'*       then the first matching text will be deleted.              *
'********************************************************************

'Remarks        F6 is used to select/deselect items from
'               the menu. Items are returned in the order
'               that they were selected and separated by
'               Delim.
'
'See Also       SingleSel function.
'
'Examples:      External MultiSel(8)
'               Local MyVar Choices
'
'               Let MyVar = "Item1;Item2;Item3"
'               Let Choices = MultiSel(MyVar,";",1,1,15,1,15,7)
'
'----------------------------------------------------------------------------
FUNCTION MultiSel(InData,Delim,Lr,Lc,FG,BG,HFG,HBG)
 Local  _Key, Width, Rr, Rc
 Local  TopItem, TEMP
 Local  Text, I, FCOUNT

Width = 0
Clear Menu[]
Clear ItemOrder
IF FILE(InData) and (Group(InData,2) = Null)
  FOPEN InData AS 1
    Width=0
    Item=1
    WHILE NOT(EOF(1))
      FREAD 1 INTO Menu[Item,1]
      Menu[Item,2] = 0
      IF Len(Menu[Item,1]) > Width
        Width = Len(Menu[Item,1])
      END IF
      Item=Item+1
    END WHILE
  FCLOSE 1
ELSE
  Item = 1
  FOR I = 1 TO LEN(InData)
   IF InData[I] <> asc(Delim)
     Menu[Item,1] = Menu[Item,1] | CHR(InData[I])
   ELSE
     IF LEN(Menu[Item,1]) > Width
      Width = LEN(Menu[Item,1])
     END IF
     Item = Item+1
   END IF
  END FOR
     IF LEN(Menu[Item,1]) > Width
      Width = LEN(Menu[Item,1])
     END IF
     Item = Item + 2
END IF


  Rr = MIN((Lr+Item-1),(Lr+11))
  Rc = MIN((Lc+Width+6),80)

'  Explode(Lr,Lc,Rr,Rc,FG,BG,10,1,400,1,"")
SCREEN CLEAR BOX Lr Lc Rr Rc FG BG
  Screen Print Lr Lc 15 BG "F6:Select"
  Screen Print Rr Lc 15 BG "Esc:Cancel"
  NumItems = Item-2

  Item=1
  FOR Item = 1 TO MIN(NumItems,10)                 'display items on screen
    SCREEN PRINT Lr+Item Lc+5 FG BG Menu[Item,1]
  END FOR

  Item = 1
  TopItem = 1
  SCREEN PRINT Lr+1 Lc+3 FG BG "û"     'Highlight first item.

  Bar = Lr+1
  LET _Key = OLDKEY(INCHAR)
      Tkey = UPPER(CHR(_Key))
  WHILE _Key <> 27
     IF _Key = 20480                     'Down arrow
       IF Item < NumItems
         IF Bar < Rr-1
           MoveBar("DOWN",Lr,Lc,FG,BG,HFG,HBG)
         ELSE
           SCREEN PRINT Lr+10 Lc+3 BG BG "û"
           Item=Item+1
           TopItem=TopItem+1
           SCREEN SCROLL UP Lr+1 Lc+1 Rr-1 Rc-1 FG BG 1
           IF Menu[Item,2] = 1
             SCREEN PRINT Lr+10 Lc+5 HFG HBG Menu[Item,1]
           ELSE
             SCREEN PRINT Lr+10 Lc+5 FG BG Menu[Item,1]
           END IF
           SCREEN PRINT Lr+10 Lc+3 FG BG "û"
         END IF
       END IF
     ELSEIF _Key = 18432                     'Up arrow
       IF Item > 1
         IF Bar > Lr+1
           MoveBar("UP",Lr,Lc,FG,BG,HFG,HBG)
         ELSE
           SCREEN PRINT Lr+1 Lc+3 BG BG "û"
           Item=Item-1
           TopItem=TopItem-1
           SCREEN SCROLL DOWN Lr+1 Lc+1 Rr-1 Rc-1 FG BG 1
           IF Menu[Item,2] = 1
             SCREEN PRINT Lr+1 Lc+5 HFG HBG Menu[Item,1]
           ELSE
             SCREEN PRINT Lr+1 Lc+5 FG BG Menu[Item,1]
           END IF
           SCREEN PRINT Lr+1 Lc+3 FG BG "û"
         END IF
       END IF
'********************************************************************
'* BUG - When deselecting items; if the item being deselected is in *
'*       a position after another item that contains the same text  *
'*       then the first matching text will be deleted.              *
'********************************************************************
     ELSEIF _Key = 16384                     'F6
       IF Menu[Item,2] = 0
          Menu[Item,2] = 1
          ItemOrder = ItemOrder | Menu[Item,1] | Delim
          SCREEN PRINT Bar Lc+5 HFG HBG Menu[Item,1]
       ELSE
          Menu[Item,2] = 0
          ItemOrder = REPLACE(ItemOrder,FIND(Menu[Item,1],ItemOrder,0),LEN(Menu[Item,1])+1,NULL)
          SCREEN PRINT Bar Lc+5 FG BG Menu[Item,1]
       END IF
       SmartPoke $_key keyvalue("down")

     ELSEIF _Key = 13                      'Enter
       ItemOrder = REPLACE(ItemOrder,LEN(ItemOrder)-1,1,NULL)
       RETURN ItemOrder
     END IF
     SCREEN CLEAR BOX 25 1 25 80 FG BG No-Border
     Screen Print 25 1 FG BG right(ItemOrder,78)
     LET _Key = OLDKEY(INCHAR)
     Tkey = UPPER(CHR(_Key))
   END WHILE
   Repaint
 RETURN NULL
END FUNCTION


'--------------------------------------------
'Function MoveBar() Moves the highlighter Bar
'--------------------------------------------
FUNCTION MoveBar(DIR,Lr,Lc,FG,BG,HFG,HBG)
    SCREEN PRINT Bar Lc+3 BG BG "û"
  CASE DIR
    WHEN "UP"
      Item = Item - 1
      Bar = Bar - 1
    WHEN "DOWN"
      Item = Item + 1
       Bar = Bar + 1
    END CASE
    SCREEN PRINT Bar Lc+3 FG BG "û"
END FUNCTION