Tweet
Linked List Class
Hi,
I took the libery to 'migrate' a subset of the work Paul Squires did on his Linked List source code and made it into a class. This is just a small set
of his functions that I used. There nothing to it actually, since all the hard
work was already done by Paul.
I took the libery to 'migrate' a subset of the work Paul Squires did on his Linked List source code and made it into a class. This is just a small set
of his functions that I used. There nothing to it actually, since all the hard
work was already done by Paul.
Code:
'
' ======================================================================================================
DECLARE FUNCTION lstrcmp LIB "KERNEL32.DLL" ALIAS "lstrcmpA" (lpString1 AS ASCIIZ, lpString2 AS ASCIIZ) AS LONG
DECLARE FUNCTION lstrcmpi LIB "KERNEL32.DLL" ALIAS "lstrcmpiA" (lpString1 AS ASCIIZ, lpString2 AS ASCIIZ) AS LONG
Declare Function GetProcessHeap Lib "KERNEL32.DLL" Alias "GetProcessHeap" () As Long
Declare Function HeapAlloc Lib "KERNEL32.DLL" Alias "HeapAlloc" (ByVal hHeap As Dword, ByVal dwFlags As Dword, ByVal dwBytes As Dword) As Dword
Declare Function HeapCompact Lib "KERNEL32.DLL" Alias "HeapCompact" (ByVal hHeap As Dword, ByVal dwFlags As Dword) As Dword
Declare Function HeapCreate Lib "KERNEL32.DLL" Alias "HeapCreate" (ByVal flOptions As Dword, ByVal dwInitialSize As Dword, ByVal dwMaximumSize As Dword) As Dword
Declare Function HeapDestroy Lib "KERNEL32.DLL" Alias "HeapDestroy" (ByVal hHeap As Dword) As Long
Declare Function HeapFree Lib "KERNEL32.DLL" Alias "HeapFree" (ByVal hHeap As Dword, ByVal dwFlags As Dword, ByVal lpMem As Dword) As Long
Declare Function HeapLock Lib "KERNEL32.DLL" Alias "HeapLock" (ByVal hHeap As Dword) As Long
Declare Function HeapReAlloc Lib "KERNEL32.DLL" Alias "HeapReAlloc" (ByVal hHeap As Dword, ByVal dwFlags As Dword, ByVal lpMem As Dword, ByVal dwBytes As Dword) As Dword
Declare Function HeapSize Lib "KERNEL32.DLL" Alias "HeapSize" (ByVal hHeap As Dword, ByVal dwFlags As Dword, ByVal lpMem As Dword) As Dword
Declare Function HeapValidate Lib "KERNEL32.DLL" Alias "HeapValidate" (ByVal hHeap As Dword, ByVal dwFlags As Dword, lpMem As Any) As Long
Declare Function FormatMessage Lib "KERNEL32.DLL" Alias "FormatMessageA" (ByVal dwFlags As Dword, lpSource As Any, ByVal dwMessageId As Dword, ByVal dwLanguageId As Dword, lpBuffer As Asciiz, ByVal nSize As Dword, Arguments As Any) As Dword
Declare Function LocalFree Lib "KERNEL32.DLL" Alias "LocalFree" (ByVal hMem As Dword) As Long
Declare Function GetLastError Lib "KERNEL32.DLL" Alias "GetLastError" () As Long
Type LINKED_LIST_TYPE
pNext As LINKED_LIST_TYPE Ptr
pPrev As LINKED_LIST_TYPE Ptr
zKey As Asciiz Ptr
zData As Long
nType As Integer ' 0 = Long, 1 = String
End Type
Type LINKED_LIST_HEADER_TYPE
pFirst As LINKED_LIST_TYPE Ptr
pLast As LINKED_LIST_TYPE Ptr
UseStrings As Byte ' TRUE if zData is pointer to a string
SortList As Byte ' TRUE if zData is to maintained in sorted order
Count As Long
End Type
%LINKED_LIST_INSERT_START = 1
%LINKED_LIST_INSERT_END = 2
%LINKED_LIST_INSERT_BEFORE = 3
%LINKED_LIST_INSERT_AFTER = 4
%HEAP_GENERATE_EXCEPTIONS = &H00000004
%HEAP_NO_SERIALIZE = &H00000001
%HEAP_REALLOC_IN_PLACE_ONLY = &H00000010
%HEAP_ZERO_MEMORY = &H00000008
%STATUS_ACCESS_VIOLATION = &HC0000005???
%STATUS_NO_MEMORY = &HC0000017???
%FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
%FORMAT_MESSAGE_IGNORE_INSERTS = &H200
%FORMAT_MESSAGE_FROM_STRING = &H400
%FORMAT_MESSAGE_FROM_HMODULE = &H800
%FORMAT_MESSAGE_FROM_SYSTEM = &H1000
%FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
%FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
%LANG_NEUTRAL = &H00
%SUBLANG_DEFAULT = &H01 ' user default
%TRUE = 1
%FALSE = 0
%Null = 0
' ======================================================================================================
Class cList
Instance pListAddress As Dword
' ======================================================================================================
'
' ======================================================================================================
Class Method iMemFree(ByRef pMem As Dword) As Long
If pMem Then
Method = HeapFree( GetProcessHeap(), 0, ByVal pMem)
pMem = 0
End If
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method iMemAlloc(ByVal nSize As Long) As Dword
If nSize > 0 Then
Method = HeapAlloc( GetProcessHeap(), %HEAP_ZERO_MEMORY, nSize)
End If
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method iHeapAllocString(ByVal sData As String) As Dword
Local sPtr As String Ptr
sPtr = me.iHeapAlloc(Len(sData))
If sPtr > 0 Then
@sPtr = sData
Method = sPtr
Else
Method = 0
End If
Exit Method
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method iHeapAlloc(ByVal Size As Dword) As Dword
Local lHeapPtr As Dword
Local Retval As Dword
If Size = 0 Then
Exit Method
End If
If Size < 4 Then Size = Size + (4 - Size)
RetVal = HeapAlloc(GetProcessHeap,%HEAP_GENERATE_EXCEPTIONS Or %HEAP_ZERO_MEMORY, Size)
Select Case RetVal
Case %STATUS_ACCESS_VIOLATION
MsgBox FuncName$ & ": " & "Access Violation !"
Case %STATUS_NO_MEMORY
MsgBox FuncName$ & ": " & "No memory !"
Case Else
Method = RetVal
End Select
Exit Method
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method AllocString(ByVal sData As String) As Dword
Local sPtr As String Ptr
sPtr = me.iHeapAlloc(Len(sData))
If sPtr Then
@sPtr = sData
Method = sPtr
Else
Method = 0
End If
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method RetrieveString(ByVal zData As Long) As String
Local pS As String Ptr
If zData = 0 Then
method = ""
else
pS = zData
Method = @pS
end if
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method iGetByPosition(ByVal nPosition As Dword) As Dword
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pListItem As LINKED_LIST_TYPE Ptr
Local x As Long
pList = pListAddress
If pList = 0 Then
Exit Method
End If
' Iterate to the specified ordinal position
pListItem = @pList.pFirst
MsgBox "getpos: " & format$(pListItem)
x = 1
Do Until x >= nPosition
pListItem = @pListItem.pNext
MsgBox "getpos: " & Format$(x) & ", " & format$(pListItem)
If pListItem = 0 Then Exit Do
Incr x
Loop
Method = pListItem
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method iMemoryString(ByRef pMem As Dword, ByVal sData As String)
If pMem Then HeapFree( GetProcessHeap(), ByVal 0, ByVal pMem) ' free any existing memory
sData = sData & $Nul
pMem = HeapAlloc( GetProcessHeap(), %HEAP_ZERO_MEMORY, Len( sData ) + 1)
If pMem Then Poke$ pMem, sData
End Method
' ======================================================================================================
'
' ======================================================================================================
Class Method iList_Add_Internal(ByVal sKey As String, _
ByVal zData As Long, _
ByVal nAddMethod As Long, _
ByVal nDataType As Integer) As Dword
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pNewItem As LINKED_LIST_TYPE Ptr
Local pListItem As LINKED_LIST_TYPE Ptr
Local zPtr1 As Asciiz Ptr
Local zPtr2 As Asciiz Ptr
Local nFirstElement As Long
Local nLastElement As Long
Local nPos As Long
Local nResult As Long
pList = pListAddress
If pList = 0 Then
Method = 0
Exit Method
End If
sKey = lcase$(sKey)
pListItem = 0
' Create memory for the new node to occupy
pNewItem = me.iMemAlloc(SizeOf(LINKED_LIST_TYPE))
If pNewItem = 0 Then
Method = 0
Exit Method
End If
' Assign the Data. The assignment depends on whether the
' data being added is a string or a numeric.
If @pList.UseStrings Then
zPtr1 = zData
me.iMemoryString(@pNewItem.zData, @zPtr1)
Else
@pNewItem.zData = zData
End If
@pNewItem.nType = nDataType
' Assign the Key
me.iMemoryString(@pNewItem.zKey, sKey)
'MemString @pNewItem.zKey, sKey
' Determine how this key will be added to the List. The fastest
' way is to simply add it to the end of the list. If the user
' wants the list in sorted order then we must find where in the
' list the new item should be placed.
' We will use a binary search type of algoritm because the list
' should already be in sorted. This is a little more complicated
' then a normal linear search but the performance improvement is
' substantial - normally 200% to 300% (especially for large lists).
If @pList.SortList Then
nFirstElement = 1
nLastElement = @pList.Count
Do
nPos = (nFirstElement + nLastElement) \ 2
pListItem = me.iGetByPosition(nPos)
If pListItem = 0 Then Exit Do
If @pList.UseStrings Then
' Do string comparisons (case sensitive)
zPtr1 = @pListItem.zData
zPtr2 = zData
nResult = lstrcmp( @zPtr1, @zPtr2 )
Else
' Do a simple numeric comparison
If @pListItem.zData = zData Then nResult = 0
If @pListItem.zData < zData Then nResult = -1
If @pListItem.zData > zData Then nResult = 1
End If
Select Case nResult
Case 0
Exit Do ' exact match
Case > 0
nLastElement = nPos - 1
Case < 0
nFirstElement = nPos + 1
End Select
Loop While nLastElement >= nFirstElement
If pListItem = 0 Then
nAddMethod = %LINKED_LIST_INSERT_END
Else
Select Case nResult
Case >= 0
nAddMethod = %LINKED_LIST_INSERT_BEFORE
Case Else
nAddMethod = %LINKED_LIST_INSERT_AFTER
End Select
End If
End If
Select Case nAddMethod
Case %LINKED_LIST_INSERT_START
' Add the new item at the start of the list
If @pList.pLast = 0 Then
@pList.pFirst = pNewItem
@pList.pLast = pNewItem
Else
@pNewItem.pNext = @pList.pFirst
If @pList.pFirst Then
@[email protected] = pNewItem
End If
@pList.pFirst = pNewItem
End If
Case %LINKED_LIST_INSERT_END
'- Add this item to the end of the list. We save the link to
' the last item in pList in order to speed up adding future
' items otherwise we need to iterate the entire list for every
' add in order to find the last item.
If @pList.pLast = 0 Then
@pList.pFirst = pNewItem
Else
If @pList.pLast Then
@[email protected] = pNewItem
End If
@pNewItem.pPrev = @pList.pLast
End If
@pList.pLast = pNewItem
Case %LINKED_LIST_INSERT_BEFORE
If @pListItem.pPrev = 0 Then
' Start of list
If @pList.pFirst Then
@[email protected] = pNewItem
End If
@pList.pFirst = pNewItem
@pNewItem.pNext = pListItem
Else
@pNewItem.pPrev = @pListItem.pPrev
@pNewItem.pNext = pListItem
@pListItem.pPrev = pNewItem
@[email protected] = pNewItem
End If
Case %LINKED_LIST_INSERT_AFTER
If @pListItem.pNext = 0 Then
' last item in list
@pListItem.pNext = pNewItem
@pNewItem.pPrev = pListItem
@pList.pLast = pNewItem
Else
@[email protected] = pNewItem
@pNewItem.pNext = @pListItem.pNext
@pNewItem.pPrev = pListItem
@pListItem.pNext = pNewItem
End If
End Select
Incr @pList.Count
Method = pNewItem
End Method
' ======================================================================================================
' Interface
' ======================================================================================================
Interface cIList
Inherit IDispatch
' ======================================================================================================
'
' ======================================================================================================
Method Default()
me.Init(0, 0)
End Method
' ======================================================================================================
' Method: Init
' ======================================================================================================
Method Init (ByVal nUseStrings As Long, ByVal nSortList As Long) As Integer
Local pList As LINKED_LIST_HEADER_TYPE Ptr
pList = me.iMemAlloc(SizeOf(LINKED_LIST_HEADER_TYPE))
If pList Then
' The data in the Linked List items can represent either a
' string or a simple numeric value. If you want the list to
' hold strings for the Data then set nUseStrings = TRUE
@pList.UseStrings = nUseStrings
' Set flag to determine whether the zData element is maintained
' in a sorted order.
@pList.SortList = nSortList
pListAddress = pList
Method = 1
Else
Method = 0
End If
End Method
' ======================================================================================================
' Method: Free
' ======================================================================================================
Method Free () As Integer
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pNext As LINKED_LIST_TYPE Ptr
Local pSave As Dword
Local hResult As Dword
pList = pListAddress
If pList = 0 Then
Method = 0
Exit Method
End If
pNext = @pList.pFirst
Do Until pNext = 0
If @pNext.zKey Then
me.iMemFree(@pNext.zKey)
End If
'If @pList.UseStrings Then
' If @pNext.zData Then MemFree @pNext.zData
'End If
If @pNext.nType = 1 Then
If @pNext.zData Then
me.iMemFree(@pNext.zData)
End If
Else
If @pList.UseStrings Then
If @pNext.zData Then
me.iMemFree(@pNext.zData)
End If
End If
End If
pSave = pNext
pNext = @pNext.pNext
me.iMemFree (pSave)
Loop
' Free memory for the List header itself
me.iMemFree (pList)
Method = 1
End Method
' ======================================================================================================
'
' ======================================================================================================
Method AddString(ByVal sKey As String, ByVal zData As String) As Dword
Local pData As Long
pData = me.iHeapAllocString(zData)
method = me.iList_Add_internal(sKey, pData, %LINKED_LIST_INSERT_END, 1)
End Method
' ======================================================================================================
'
' ======================================================================================================
Method AddValue (ByVal sKey As String, ByVal zData As Long) As Dword
method = me.iList_Add_internal(sKey, zData, %LINKED_LIST_INSERT_END, 0)
End Method
' ======================================================================================================
'
' ======================================================================================================
method RetrieveDataStringByKey(ByVal zKey As String) As String
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pNext As LINKED_LIST_TYPE Ptr
Local hResult As Long
pList = pListAddress
If pList = 0 Then
Exit Method
End If
pNext = @pList.pFirst
Do Until pNext = 0
If @pNext.zKey Then
If Lstrcmpi( @[email protected], ByCopy zKey ) = 0 Then
If @pNext.zData Then
Method = me.RetrieveString(@pNext.zData)
End If
Exit Do
End If
End If
pNext = @pNext.pNext
Loop
End method
' ======================================================================================================
'
' ======================================================================================================
Method RetrieveDataValueByKey(ByVal zKey As String) As Long
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pNext As LINKED_LIST_TYPE Ptr
zKey = lcase$(zKey)
pList = pListAddress
If pList = 0 Then
Exit Method
End If
pNext = @pList.pFirst
Do Until pNext = 0
If @pNext.zKey Then
If Lstrcmpi( @[email protected], ByCopy zKey ) = 0 Then
Method = @pNext.zData
Exit Do
End If
End If
pNext = @pNext.pNext
Loop
End method
' ======================================================================================================
' SearchByKey
' ======================================================================================================
Method SearchByKey(ByVal zKey As String) As Dword
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pNext As LINKED_LIST_TYPE Ptr
zKey = lcase$(zKey)
pList = pListAddress
If pList = 0 Then Exit Method
pNext = @pList.pFirst
Do Until pNext = 0
If @pNext.zKey Then
If Lstrcmpi( @[email protected], ByCopy zKey ) = 0 Then
Method = pNext
Exit Do
End If
End If
pNext = @pNext.pNext
Loop
End Method
' ======================================================================================================
'
' ======================================================================================================
Method UpdateString(ByVal zKey As String, ByVal zData As String) As Long
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pListItem As LINKED_LIST_TYPE Ptr
Local zPtr As Asciiz Ptr
Local hResult As Long
pList = pListAddress
If pList = 0 Then
Exit Method
End If
pListItem = me.SearchByKey(zKey)
If pListItem = 0 Then
pListItem = me.AddString(zKey, zData)
Exit Method
End If
' Assign the Key
zKey = lcase$(zKey)
' Assign the Data. The assignment depends on whether the
' data being added is a string or a numeric.
If @pListItem.zData Then
me.iMemFree(@pListItem.zData)
End If
@pListItem.zData = me.AllocString(zData)
@pListItem.nType = 1
End Method
' ======================================================================================================
'
' ======================================================================================================
Method UpdateLong(ByVal sKey As String, ByVal zData As Long) As Long
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pListItem As LINKED_LIST_TYPE Ptr
Local zPtr As Asciiz Ptr
pList = pListAddress
If pList = 0 Then
Exit Method
End If
pListItem = me.SearchByKey(sKey)
If pListItem = 0 Then
pListItem = me.AddValue(sKey, zData)
Exit Method
End If
' Assign the Key
sKey = lcase$(sKey)
' Assign the Data. The assignment depends on whether the
' data being added is a string or a numeric.
@pListItem.zData = zData
@pListItem.nType = 0
End Method
' ======================================================================================================
'
' ======================================================================================================
Method Delete (ByVal pListItemAddress As Long) As Long
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pDelete As LINKED_LIST_TYPE Ptr
Local hResult As Long
pList = pListAddress
If pList = 0 Then
Exit Method
End If
pDelete = pListItemAddress
If pDelete = 0 Then
Exit Method
End If
' If pLast points to the node being deleted then
' we need to adjust that to point to the previous node.
If @pList.pLast = pDelete Then
@pList.pLast = @pDelete.pPrev
End If
'- Remove the item from the list
If @pDelete.pPrev = 0 Then
@pList.pFirst = @pDelete.pNext
If @pDelete.pNext Then
@[email protected] = 0
End If
Else
@[email protected] = @pDelete.pNext
If @pDelete.pNext Then
If @pDelete.pNext Then
@[email protected] = @pDelete.pPrev
End If
End If
End If
'- Free pDelete (and any allocated string memory)
me.iMemFree(@pDelete.zKey)
If @pList.UseStrings Then
me.iMemFree (@pDelete.zData)
Else
If @pDelete.nType = 1 Then
me.iMemFree(@pDelete.zData)
Else
@pDelete.zData = 0
End If
End If
me.iMemFree(pDelete)
Decr @pList.Count
Method = 1
End Method
' ======================================================================================================
' GetDataLong
' ======================================================================================================
Method GetDataLong(ByVal pListItem As Dword) As Long
Local pListItm As LINKED_LIST_TYPE Ptr
If pListItem Then
pListItm = pListItem
If @pListItm.zData Then
Method = @pListItm.zData
End If
End If
End Method
' ======================================================================================================
'
' ======================================================================================================
Method GetDataString(ByVAl pListItem As Dword) As String
Local pListItm As LINKED_LIST_TYPE Ptr
Local pString As String Ptr
If pListItem Then
pListItm = pListItem
If @pListItm.zData Then
pString = @pListItm.zData
Method = @pString
End If
End If
End Method
' ======================================================================================================
'
' ======================================================================================================
method GetStringDataByPosition(ByVal nPosition As Long) As String
Local pList As LINKED_LIST_HEADER_TYPE Ptr
Local pListItem As LINKED_LIST_TYPE Ptr
Local x As Long
pList = pListAddress
If pList = 0 Then
Exit Method
End If
' Iterate to the specified ordinal position
pListItem = @pList.pFirst
x = 1
Do Until x >= nPosition
pListItem = @pListItem.pNext
If pListItem = 0 Then Exit Do
Incr x
Loop
If @pListItem.zData Then
Method = me.RetrieveString(@pListItem.zData)
End If
End Method
' ======================================================================================================
'
' ======================================================================================================
Property Get Count As Long
Local pList As LINKED_LIST_HEADER_TYPE Ptr
pList = pListAddress
If pList = 0 Then
Exit Property
End If
Property = @pList.Count
End Property
End Interface
' ======================================================================================================
'
' ======================================================================================================
End Class
' ======================================================================================================
Function pbmain() As Long
Local iList As cIList
iList = Class "cList"
iList.Default()
iList.AddString("Test", "My value")
Local n As Long
For n = 1 To 250
iList.AddString(Format$(n), "Data " & Format$(n))
Next
MsgBox "Count = " & Format$(iList.Count)
MsgBox iList.RetrieveDataStringByKey("test")
iList.Free
Comment