#include Once "window9.bi"

Type THASHDATA
    
    pszKey As Zstring Ptr =0
    
    pszValue As Any Ptr =0
    
End Type

Type THLIST Extends THASHDATA
    
    As THLIST Ptr p =0
    
End Type

Type TGLLIST
    
    As THLIST Ptr pFirst =0
    
    As THLIST Ptr pEnd =0
    
    Declare Sub add_last (pszKey As Zstring Ptr , pszValue As Any Ptr)
    
    Declare Sub delete_element (pszKey As Zstring Ptr , bFlagFreeMemoryStrings As Long = 0)
    
    Declare Function get_element ( pszKey As Zstring Ptr) As THLIST Ptr
    
End Type

Sub TGLLIST.add_last (pszKey As Zstring Ptr , pszValue As Any Ptr)
    
    Dim As THLIST Ptr nw = Allocate(Sizeof(THLIST))
    
    If nw =0 Then Exit Sub
    
    nw->pszKey =pszKey
    
    nw->pszValue =pszValue
    
    nw->p =0
    
    If pFirst =0 Then
        
        pFirst =nw
        
        pEnd =pFirst
        
    Else
        
        pEnd->p =nw
        
        pEnd =nw
        
    Endif
    
End Sub

Sub TGLLIST.delete_element (pszKey As Zstring Ptr , bFlagFreeMemoryStrings As Long = 0)
    
    if pszKey = 0 then exit sub
    
    Dim As THLIST Ptr pTemp = pFirst , pTempOld
    
    pTempOld = pTemp
    
    While pTemp
        
        If pTemp->pszKey andalso *(pTemp->pszKey) = *pszKey Then
            
            If pTemp->p <> 0 Then
                
                If pTemp =pFirst Then
                    
                    pFirst =pTemp->p
                    
                Else
                    
                    pTempOld->p =pTemp->p
                    
                Endif
                
            Else
                
                If pTemp =pFirst Then
                    
                    pFirst =0
                    
                    pEnd =0
                    
                Else
                    
                    pTempOld->p =0
                    
                    pEnd =pTempOld
                    
                Endif
                
            Endif
            
            Deallocate(pTemp->pszKey)
            
            If bFlagFreeMemoryStrings Then
                
                If pTemp->pszValue Then
                    
                    Deallocate(pTemp->pszValue)
                    
                Endif
                
            Endif
            
            Deallocate(pTemp)
            
            Exit While
            
        Endif
        
        pTempOld = pTemp
        
        pTemp = pTemp->p
        
    Wend
    
End Sub

Function TGLLIST.get_element ( pszKey As Zstring Ptr) As THLIST Ptr
    
    Dim As THLIST Ptr pTemp =pFirst
    
    Dim As Long iLen =Len(*pszKey)
    
    While pTemp
        
        If Len(*(pTemp->pszKey)) =iLen Andalso *(pTemp->pszKey) =*pszKey Then
            
            Return pTemp
            
        Endif
        
        pTemp =pTemp->p
        
    Wend
    
End Function

Type THASHITEM Extends THASHDATA
    
    pList As TGLLIST Ptr
    
    iFdelete As Long
    
End Type

Type THASHTABLE
    
    pArray As THASHITEM Ptr
    
    iCountItem As Ulong
    
    iSize As Ulong
    
    Declare Constructor()
    
    Declare Sub deleteitem(pszKey As Zstring Ptr, bFlagFreeMemoryStrings As Long = 0)
    
    Declare Sub cleartable(bFlagFreeMemoryStrings As Long = 0)
    
    Declare Sub freetable()
    
    Declare Function count() As Long
    
    Declare Function size() As Long
    
    Declare Sub insert(pszKey As Zstring Ptr , pszValue As Any Ptr , bFlagFreeMemoryStrings As Long = 0)
    
    Declare Sub add_rehash(pNew As THASHITEM Ptr , pszKey As Zstring Ptr , pszValue As Any Ptr)
    
    Declare Function find(pszKey As Zstring Ptr) As Any Ptr
    
    Declare Function hash_horner(psz As Zstring Ptr) As Long
    
    Declare Sub rehash()
    
End Type

Constructor THASHTABLE()
    
    iCountItem =0
    
    iSize =64
    
    pArray =Callocate(Sizeof(THASHITEM)*(iSize+4))
    
End Constructor

Sub THASHTABLE.deleteitem(pszKey As Zstring Ptr, bFlagFreeMemoryStrings As Long = 0)
    
    Dim As Long iIndex =hash_horner(pszKey)
    
    If pArray[iIndex].pszKey Then
        
        If pArray[iIndex].iFdelete =0 Andalso *(pArray[iIndex].pszKey) =*pszKey Then
            
            Deallocate(pArray[iIndex].pszKey)
            
            pArray[iIndex].pszKey = 0
            
            If bFlagFreeMemoryStrings Then
                
                If pArray[iIndex].pszValue Then
                    
                    Deallocate(pArray[iIndex].pszValue)
                    
                    pArray[iIndex].pszValue = 0
                    
                Endif
                
            Endif
            
            pArray[iIndex].iFdelete =1
            
        Else
            
            If pArray[iIndex].pList Then
                
                pArray[iIndex].pList->delete_element(pszKey , bFlagFreeMemoryStrings)
                
            Endif
            
        Endif
        
        iCountItem-=1
        
        If iCountItem*4 <iSize Then
            
            rehash()
            
        Endif
        
    Endif
    
End Sub

Sub THASHTABLE.cleartable(bFlagFreeMemoryStrings As Long = 0)
    
    For i As Long =0 To iSize
        
        If pArray[i].pszKey Then
            
            If pArray[i].iFdelete =0 Then
                
                Deallocate(pArray[i].pszKey)
                
                If bFlagFreeMemoryStrings Then
                    
                    If pArray[i].pszValue Then
                        
                        Deallocate(pArray[i].pszValue)
                        
                    Endif
                    
                Endif
                
                pArray[i].pszKey =0
                
                pArray[i].pszValue =0
                
            Endif
            
            If pArray[i].pList Then
                
                Dim As THLIST Ptr pTemp , pTemp2
                
                pTemp =pArray[i].pList->pFirst
                
                pTemp2 =pArray[i].pList->pFirst
                
                While pTemp
                    
                    pTemp2 =pTemp->P
                    
                    Deallocate(pTemp->pszKey)
                    
                    If bFlagFreeMemoryStrings Then
                        
                        If pTemp->pszValue Then
                            
                            Deallocate(pTemp->pszValue)
                            
                        Endif
                        
                    Endif
                    
                    Deallocate(pTemp)
                    
                    pTemp =pTemp2
                    
                Wend
                
                Deallocate(pArray[i].pList)
                
                pArray[i].pList = 0
                
            Endif
            
        Endif
        
    Next
    
    iCountItem =0
    
    rehash()
    
End Sub

Sub THASHTABLE.freetable()
    
    if pArray then 
    	
    	Deallocate(pArray)
    	
    	pArray = 0
    	
    EndIf
    
End Sub

Function THASHTABLE.count() As Long
    Return iCountItem
End Function

Function THASHTABLE.size() As Long
    Return iSize
End Function

Sub THASHTABLE.insert(pszKey As Zstring Ptr , pszValue As Any Ptr , bFlagFreeMemoryStrings As Long = 0)
    
    If pszKey =0 Orelse pszValue =0 Then
        
        ? "Invalidate value!"
        
        Exit Sub
        
    Endif
    
    If iCountItem >(iSize Shr 1) Andalso iCountItem <32770 Then
        
        reHash()
        
    Endif
    
    Dim As Long iIndex =hash_horner(pszKey)
    
    If pArray[iIndex].pszKey =0 Orelse pArray[iIndex].iFdelete Then
        
        pArray[iIndex].pszKey =Allocate((Len(*pszKey)+1)*Sizeof(Zstring))
        
        if pArray[iIndex].pszKey = 0 then exit sub
        
        *(pArray[iIndex].pszKey) =*pszKey
        
        pArray[iIndex].pszValue =pszValue
        
        If pArray[iIndex].iFdelete Then pArray[iIndex].iFdelete =0
        
    Else
        
        If *(pArray[iIndex].pszKey) =*pszKey Then
            
            If bFlagFreeMemoryStrings Andalso pArray[iIndex].pszValue Then
            	
            	Deallocate(pArray[iIndex].pszValue)
            	
            Endif
            
            pArray[iIndex].pszValue = pszValue
            
            Exit Sub
            
        Endif
        
        Dim As THLIST Ptr pPrevData
        
        If pArray[iIndex].pList =0 Then
            
            pArray[iIndex].pList =Callocate(Sizeof(TGLLIST))
            
        Else
        
			pPrevData = pArray[iIndex].pList->get_element(pszKey)
			
			If pPrevData Then

				If bFlagFreeMemoryStrings Andalso pPrevData->pszValue Then
					
					Deallocate(pPrevData->pszValue)
					
				Endif

				pPrevData->pszValue = pszValue
				
				Exit Sub
				
			Endif
            
        Endif
        
        Dim As Zstring Ptr pTempKey =Allocate((Len(*pszKey)+1)*Sizeof(Zstring))
        
        if pTempKey andalso pArray[iIndex].pList then
        
			*pTempKey =*pszKey
			
			pArray[iIndex].pList->add_last(pTempKey , pszValue)
        
        endif
        
    Endif
    
    iCountItem+=1
    
End Sub

Sub THASHTABLE.add_rehash(pNew As THASHITEM Ptr , pszKey As Zstring Ptr , pszValue As Any Ptr)
    
    Dim As Long iIndex =hash_horner(pszKey)
    
    If pNew[iIndex].pszKey =0 Then
        
        pNew[iIndex].pszKey =pszKey
        
        pNew[iIndex].pszValue =pszValue
        
    Else
        
        If pNew[iIndex].pList =0 Then
            
            pNew[iIndex].pList =Callocate(Sizeof(TGLLIST))
            
        Endif
        
        if pNew[iIndex].pList then
        	
        	pNew[iIndex].pList->add_last(pszKey , pszValue)
        	
        EndIf
        
    Endif
    
End Sub

Function THASHTABLE.find(pszKey As Zstring Ptr) As Any Ptr
    
    If pszKey =0 Then
        
        ? "Invalidate value!"
        
        Return 0
        
    Endif
    
    Dim As Long iIndex =hash_horner(pszKey)
    
    If (pArray[iIndex].pszKey Andalso pArray[iIndex].iFdelete =0) Andalso *(pArray[iIndex].pszKey) =*pszKey Then
        
        Return pArray[iIndex].pszValue
        
    Else
        
        If pArray[iIndex].pList Then
            
            Dim As THLIST Ptr p =pArray[iIndex].pList->get_element(pszKey)
            
            If p Then
                
                Return p->pszValue
                
            Else
                
                Return 0
                
            Endif
            
        Endif
        
    Endif
    
End Function

Function THASHTABLE.hash_horner(psz As Zstring Ptr) As Long
    
    Dim As Ulong iResult
    
    For i As Long =0 To Len(*psz)-1
        
        iResult =(11 * iResult + (*psz)[i])
        
    Next
    
    Return iResult Mod iSize
    
End Function

Sub THASHTABLE.rehash()
    
    Dim As Long iOldSize =iSize
    
    If iCountItem >32768 Then
        
        iSize =131072
        
    Elseif iCountItem >16384 Then
        
        iSize =65536
        
    Elseif iCountItem >8192 Then
        
        iSize =32768
        
    Elseif iCountItem >4096 Then
        
        iSize =16384
        
    Elseif iCountItem >2048 Then
        
        iSize =8192
        
    Elseif iCountItem >1024 Then
        
        iSize =4096
        
    Elseif iCountItem >512 Then
        
        iSize =2048
        
    Elseif iCountItem >256 Then
        
        iSize =1024
        
    Elseif iCountItem >128 Then
        
        iSize =512
        
    Elseif iCountItem >64 Then
        
        iSize =256
        
    Elseif iCountItem >32 Then
        
        iSize =128
        
    Elseif iCountItem >16 Then
        
        iSize =64
        
    Endif
    
    Dim As THASHITEM Ptr pNew =Callocate(Sizeof(THASHITEM)*(iSize+4))
    
    if pNew then
    
		For i As Long =0 To iOldSize
			
			If pArray[i].pszKey Then
				
				If pArray[i].iFdelete =0 Then
					
					add_rehash(pNew , pArray[i].pszKey , pArray[i].pszValue)
					
				Endif
				
				If pArray[i].pList Then
					
					Dim As THLIST Ptr pTemp =pArray[i].pList->pFirst , pTemp2
					
					While pTemp
						
						add_rehash(pNew , pTemp->pszKey , pTemp->pszValue)
						
						pTemp2 =pTemp->P
						
						Deallocate(pTemp)
						
						pTemp =pTemp2
						
					Wend
					
					Deallocate(pArray[i].pList)
					
					pArray[i].pList = 0
					
				Endif
				
			Endif
			
		Next
		
		if pArray then 
			
			Deallocate(pArray)
			
			pArray = 0
			
		EndIf
		
		pArray = pNew
    
    endif
    
End Sub

Function CreateHashTable() As Any Ptr
    
    Return New THASHTABLE
    
End Function

Function GetSizeHashTable(p As Any Ptr) As Long
	
	If p Then
		
		Return Cast(THASHTABLE Ptr , p)->iCountItem
		
	Endif
	
End Function

Sub SetValueHashTable(p As Any Ptr , sKey As String , anyValue As Any Ptr)
    
	If p Then
		
		Cast(THASHTABLE Ptr , p)->insert(sKey , anyValue)
		
	Endif
    
End Sub

Sub SetValueStrHashTable(p As Any Ptr , sKey As String , anyValue As USTRING)
    
	If p Then
		
		#ifdef UNICODE
            Dim As Long iLen = Len(anyValue)
		#else
            Dim As Long iLen = Len(anyValue)
		#endif
        
		If iLen Then
			
			#ifdef UNICODE
				
				Dim As Wstring Ptr pws = Allocate(Sizeof(Wstring)*(iLen+1))
				
			#else
				
				Dim As Zstring Ptr pws = Allocate(iLen+1)
				
			#endif
			
			if pws then
			
				*pws = anyValue
				
				(*pws)[iLen] = 0
			
			endif
			
			Cast(THASHTABLE Ptr , p)->insert(sKey , pws , 1)
			
		Else
			
			Cast(THASHTABLE Ptr , p)->insert(sKey , 0 , 1)
			
		Endif
		
	Endif
    
End Sub

Function GetValueHashTable(p As Any Ptr , sKey As String) As Any Ptr
    
	If p Then
		
		Return Cast(THASHTABLE Ptr , p)->find(sKey)
		
	Endif
    
End Function

Function GetValueStrHashTable(p As Any Ptr , sKey As String) As USTRING
    
	If p Then
		
		Dim As USTRING sRet
		
		#ifdef UNICODE
			Dim As Wstring Ptr pTemp = Cast(THASHTABLE Ptr , p)->find(sKey)
		#else
			Dim As Zstring Ptr pTemp = Cast(THASHTABLE Ptr , p)->find(sKey)
		#endif
		
		If pTemp Then
			
			sRet = *pTemp
			
		Endif
		
		Return sRet
		
	Endif
    
End Function

Sub FreeHashTable(p As Any Ptr , bFlagFreeMemoryStrings As Long = 0)
	
	If p Then
		
		Cast(THASHTABLE Ptr , p)->cleartable(bFlagFreeMemoryStrings)
		
	Endif
	
End Sub

Sub FreeKeyHashTable(p As Any Ptr , sKey As String , bFlagFreeMemoryStrings As Long = 0)
	
	If p Then
		
		Cast(THASHTABLE Ptr , p)->deleteitem(sKey , bFlagFreeMemoryStrings)
		
	Endif
	
End Sub

Sub DeleteHashTable(p As Any Ptr , bFlagFreeMemoryStrings As Long = 0)
	
	If p Then
		
		If Cast(THASHTABLE Ptr , p)->iSize Then
			
			Cast(THASHTABLE Ptr , p)->cleartable(bFlagFreeMemoryStrings)
			
			Cast(THASHTABLE Ptr , p)->freetable()
			
		Endif
		
		Delete Cast(THASHTABLE Ptr , p)
		
	Endif
	
End Sub
