; English forum: http://www.purebasic.fr/english/viewtopic.php?t=9439&highlight=
; Author: ppjm99 (updated for PB 4.00 by Andre)
; Date: 08. February 2004
; OS: Windows
; Demo: Yes

; Perhaps this will be helpful to anybody wishing to manage/sort record data in memory.
; This is the beginning of my memrec library, and includes the pbi include file and an
; example showing its use. 
; Evolving into a flat file manager, load, save, sort. 

Global MemIndexElements 
Global MemIndexFieldWidth 
Global MemIndexPointerWidth 
Global MemFieldDefs$ 
Global NewList MemRecords.s() 
MemIndexPointerWidth = 6 ;Allows for generating indexes with 6 digit recordcount 

Procedure MemIndexCreate(StartPos,Length,SortOpt) ;SortOpt = 0-3 as per Sortarray function 
    MemIndexFieldWidth = Length 
    MemIndexElements = CountList(MemRecords()) 
    Dim MemIndex.s(MemIndexElements) 
    
    For nIdx = 1 To MemIndexElements 
        SelectElement(MemRecords(),nIdx-1) 
        MemIndex(nIdx) = Mid(MemRecords(),StartPos,MemIndexFieldWidth) + "," + RSet(Str(nIdx),MemIndexPointerWidth,"0") 
    Next 
    SortArray(MemIndex(), SortOpt) 
EndProcedure 

Procedure MemIndexClear() 
    MemIndexElements = 0 
    Global Dim MemIndex.s(MemIndexElements) 
EndProcedure 

Procedure MemRecsProcess(ProcAddress) 
    If MemIndexElements > 0 ;Process in indexed order 
        For nIdx = 1 To MemIndexElements 
            IndexEntry$ = MemIndex(nIdx) 
            RecIdx = Val(Mid(IndexEntry$,MemIndexFieldWidth+2,MemIndexPointerWidth)) 
            SelectElement(MemRecords(),RecIdx-1) 
            Record$ = MemRecords() 
            *ProcPointer = ProcAddress 
            CallFunctionFast(*ProcPointer, Record$) 
        Next 
    Else ;Process in natural order 
        nCount = CountList(MemRecords()) 
        For nIdx = 1 To nCount 
            SelectElement(MemRecords(),nIdx-1) 
            Record$ = MemRecords() 
            *ProcPointer = ProcAddress 
            CallFunctionFast(*ProcPointer, Record$) 
        Next 
    EndIf 
EndProcedure 

Procedure.l MemFieldCount() 
    nPos = FindString(MemFieldDefs$,",",1) 
    While nPos > 0 
        nCount + 1 
        nPos = FindString(MemFieldDefs$,",",nPos+1) 
    Wend 
    ProcedureReturn (nCount + 1)/3 
EndProcedure 

Procedure.s MemFieldName(FieldPos) 
    nIndex = (FieldPos - 1)*3 + 1 
    sName$ = StringField(MemFieldDefs$,nIndex,",") 
    ProcedureReturn sName$ 
EndProcedure 

Procedure.l MemFieldStart(FieldName$) 
    nIdx = 1 
    sField$ = StringField(MemFieldDefs$,nIdx,",") 
    While sField$ <> "" 
        If sField$ = FieldName$ 
            nStart = nTotalSize + 1 
        Else 
            nTotalSize + Val(sField$) 
        EndIf 
        nIdx+1 
        sField$ = StringField(MemFieldDefs$,nIdx,",") 
    Wend 
    ProcedureReturn nStart 
EndProcedure 

Procedure.l MemFieldSize(FieldName$) 
    nPos = FindString(MemFieldDefs$,FieldName$,1) 
    If nPos > 0 
        sRemaining$ = Mid(MemFieldDefs$,nPos,Len(MemFieldDefs$)-nPos+1) 
        sSize$ = StringField(sRemaining$,2,",") 
    EndIf 
    ProcedureReturn Val(sSize$) 
EndProcedure 

Procedure.s MemFieldType(FieldName$) 
    nPos = FindString(MemFieldDefs$,FieldName$,1) 
    If nPos > 0 
        sRemaining$ = Mid(MemFieldDefs$,nPos,Len(MemFieldDefs$)-nPos+1) 
        sType$ = StringField(sRemaining$,3,",") 
    EndIf 
    ProcedureReturn sType$ 
EndProcedure 

;MFP - Short form for MemFieldPrep 
Procedure.s MFP(FieldName$,sData$) 
    Select MemFieldType(FieldName$) 
        Case "T" ;Left justify and pad text fields 
            Result$ = LSet(sData$,MemFieldSize(FieldName$)) 
        Case "N" ;Right justify and zero pad number fields (for sorting) 
            Result$ = RSet(sData$,MemFieldSize(FieldName$),"0") 
    EndSelect 
    ProcedureReturn Result$ 
EndProcedure 

Procedure MemRecAdd(MemRecord$) 
    AddElement(MemRecords()) 
    MemRecords() = MemRecord$ 
EndProcedure 

Procedure MemRecsClear() 
    ClearList(MemRecords()) 
EndProcedure 

Procedure MemRecsToFile(FilePath$) 
    If OpenFile(999,FilePath$)<>0 
        If MemIndexElements > 0 ;Process in indexed order 
            For nIdx = 1 To MemIndexElements 
                IndexEntry$ = MemIndex(nIdx) 
                RecIdx = Val(Mid(IndexEntry$,MemIndexFieldWidth+2,MemIndexPointerWidth)) 
                SelectElement(MemRecords(),RecIdx-1) 
                Record$ = MemRecords() 
                WriteStringN(999, Record$) 
            Next 
        Else ;Process in natural order 
            nCount = CountList(MemRecords()) 
            For nIdx = 1 To nCount 
                SelectElement(MemRecords(),nIdx-1) 
                Record$ = MemRecords() 
                WriteStringN(999, Record$) 
            Next 
        EndIf 
        CloseFile(999) 
    EndIf 
EndProcedure 

Procedure MemRecsFromFile(FilePath$) 
    If OpenFile(999,FilePath$)<>0 
        While Eof(999)=0 
            Record$=ReadString(999) 
            MemRecAdd(Record$) 
        Wend 
        CloseFile(999) 
    EndIf 
EndProcedure 

;Test Library Code 
;FieldName,Size,Type (T OR N),FieldName,Size,Type (T OR N) 
; MemFieldDefs$ = "Name,20,T,Age,3,N" 
; Debug MemFieldSize("Name") 
; Debug MemFieldSize("Age") 
; Debug MemFieldType("Name") 
; Debug MemFieldType("Age") 
; Debug MemFieldName(1) 
; Debug MemFieldName(2) 
; Debug MemFieldCount() 
; Debug MemFieldStart("Name") 
; Debug MemFieldStart("Age") 
; Debug MFP("Name","Bob") + "*" 
; Debug MFP("Age","30") 

;MemRecsToFile("Testfile.txt") 


; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = ---