#Include once "window9.bi"

type PrefsNode
	declare constructor()  
	id as Ulong   
	valueS as USTRING  
	prev_node as PrefsNode Ptr  
	next_node as PrefsNode Ptr  
End type


type PrefsList
	declare constructor() 
	declare destructor() 
	declare sub Clear() 
	declare function AddLastS ( as USTRING ) as ULong 
	Declare Sub AddHeadS (As USTRING)
	Declare function Insert_S (As Ulong,As USTRING) As ULong
	declare function FindByID( as Ulong ) as PrefsNode Ptr 
	Declare Function GetCount (As PrefsList Ptr) As Long
	Declare function GURR( ) as PrefsNode Ptr
	Declare function GURR1( ) as PrefsNode Ptr
	Declare function PRED( ) as PrefsNode Ptr
	Declare function First( ) as PrefsNode Ptr
	Declare function Last( ) as PrefsNode Ptr
	Gurrent As PrefsNode Ptr   
	first_node as PrefsNode Ptr 
	last_node as PrefsNode Ptr 
end Type

constructor PrefsNode()	
	this.id = 0
	this.prev_node = 0
	this.next_node = 0
End constructor


constructor PrefsList()	
	this.first_node = 0
	this.last_node = 0
End constructor


destructor PrefsList()	
	this.Clear()
end destructor


sub PrefsList.Clear()
	dim del_node as PrefsNode Ptr 
	dim next_node as PrefsNode Ptr 
	del_node = this.first_node 
	do while del_node 
		next_node = del_node->next_node 
		Delete del_node 
		del_node = next_node 
	Loop	
	this.first_node = 0
	this.last_node = 0
end Sub

SUB PrefsList.AddHeadS (valueS As USTRING)
	DIM temp2 AS PrefsNode Ptr
	DIM temp1 AS PrefsNode Ptr
	IF first_node   Then                              
		temp1=first_node  
		temp2 = first_node->next_node     
		first_node = New PrefsNode
		if first_node then
			first_node->valueS=valueS  
			first_node->next_node=temp1 
			first_node->next_node->prev_node=first_node
			first_node->next_node->next_node=temp2
			first_node->id=0
			temp1=first_node
			While temp1
				temp1->id=temp1->id+1
				temp1=temp1->next_node
			Wend
		endif
	ELSE                                      
		first_node = New PrefsNode
		if first_node then
			first_node->valueS=valueS
			first_node->id=1
			last_node=first_node
			Gurrent=last_node
		endif
	END IF
END Sub
function PrefsList.Insert_S (ida As Ulong,valueS As USTRING) As ULong	
	IF first_node   Then   
		Dim seek_node as PrefsNode Ptr 
		seek_node = first_node 
		do while seek_node 
			
			if seek_node->id = ida Then 
				Exit Do
			end If
			seek_node = seek_node->next_node 
		Loop
		DIM Predid AS PrefsNode Ptr
		Dim temp1 AS PrefsNode Ptr
		
		If first_node=seek_node Then
			AddHeadS( valueS )
			Return 1
		ElseIf seek_node=0 Then
			AddLastS(valueS)
			Return 1
		EndIf
		
		Predid=seek_node->prev_node  
		Predid->next_node= New PrefsNode
		if Predid->next_node then
			Predid->next_node->valueS=valueS
			Predid->next_node->prev_node=Predid 
			Predid->next_node->next_node=seek_node 
			seek_node->prev_node=Predid->next_node 
			Gurrent=Predid->next_node
			Predid->id=Predid->id-1
			Predid->next_node->id=Predid->id+1
			temp1=Predid
			While temp1
				temp1->id=temp1->id+1
				temp1=temp1->next_node
			Wend
		endif
	ELSE                                     
		first_node = New PrefsNode
		if first_node then
			first_node->valueS=valueS
			first_node->id=1
			last_node=first_node
			Gurrent=last_node
		endif
	END IF
END Function

function PrefsList.AddLastS( valueS  as USTRING ) as ULong
	dim new_node as PrefsNode Ptr 
	new_node = New PrefsNode
	if new_node then
		new_node->valueS = valueS 
		if this.first_node = 0 then    
			new_node->id = 1
			this.first_node = new_node
		else                                     
			new_node->id = this.last_node->id + 1
			this.last_node->next_node = new_node
			new_node->prev_node = this.last_node
		end if
		this.last_node = new_node 
		Gurrent=this.last_node
		return new_node->id
	endif
end Function

Function PrefsList.PRED( ) as PrefsNode Ptr
	Gurrent=Gurrent->prev_node
	Return Gurrent
End Function

function PrefsList.First( ) as PrefsNode Ptr
	Gurrent=first_node
	Return Gurrent
End Function

function PrefsList.Last( ) as PrefsNode Ptr
	Gurrent=last_node
	Return Gurrent
End Function

function PrefsList.GURR( ) as PrefsNode Ptr
	Gurrent=Gurrent->next_node
	Return Gurrent
End Function

function PrefsList.GURR1( ) as PrefsNode Ptr
	Return Gurrent
End Function


function PrefsList.FindByID( id as uLong ) as PrefsNode ptr
	dim seek_node as PrefsNode Ptr 
	seek_node = this.first_node 
	do while seek_node 
		if seek_node->id = id Then 
			Gurrent=seek_node
			return seek_node
		end if
		seek_node = seek_node->next_node 
	loop
	return 0 
end Function

FUNCTION PrefsList.GetCount (lis As PrefsList Ptr) As Long
	Var ggg=lis->FindByID(1)
	If ggg=0 Then
		ggg=lis->FindByID(2)
		If ggg=0 Then Return 0
	EndIf
	DIM temp  AS PrefsNode PTR = ggg
	DIM count AS Long    = 0 
	WHILE temp                          
		count = count + 1              
		temp = temp->next_node          
	WEND
	RETURN count
END Function

Private Sub InsertElement_S(ByVal lis As PrefsList Ptr,ByVal item As Ulong, byval  znach As USTRING)
	lis->Insert_S(item, znach )
End Sub
Private Sub AddElement_S(ByVal lis As PrefsList Ptr,ByVal  znach As USTRING)
	lis->AddLastS( znach )
End Sub
Private Function NewList() As PrefsList Ptr
	Return New PrefsList
End Function
Private Sub ClearList(ByVal lis As PrefsList Ptr )
	lis->Clear
End Sub
Private Function SizeList(ByVal lis As PrefsList Ptr ) As Long
	DIM alls AS PrefsList
	Return alls.GetCount(lis)
End Function
Private Function NextElement(ByVal lis As PrefsList Ptr ) As Integer 
	Return Cast(Integer,lis-> GURR( ))
End Function
Private Function FirstElement(ByVal lis As PrefsList Ptr ) As Integer 
	Return Cast(Integer,lis-> First( ))
End Function
Private Sub SetValueElement_S(ByVal lis As PrefsList Ptr ,ByVal element As Long,ByVal znachenie As USTRING)
	Lis->FindByID(element)->VALUES=znachenie
End Sub
Private Function GetList_S(ByVal lis As PrefsList Ptr  ) As USTRING 
	Return lis-> GURR1( )->VALUES
End Function

Type Tprefs
	As HANDLE  hfile
	As Long  buff,Nlist,check
	As Byte     b,c,know
	As USTRING   key,ts
	As Any Ptr  list
	As bool flag
End Type
Dim Shared Prefs As Tprefs

Function CreateFBini( ByRef filename As USTRING) As handle Export
	prefs.hFile = Create_File(FileName)
	prefs.list=NewList()
	prefs.flag=1
	Return prefs.hFile
End Function

Function OpenFBini( ByRef filename As USTRING,ByVal flag As bool=0) As handle Export
	prefs.hFile = Open_File(FileName)
	
	If prefs.hFile<>cast(handle,-1) Then
		prefs.list=NewList()
		
		While E_O_F(prefs.hFile)=0
			prefs.ts=Read_String(prefs.hfile)
			If prefs.ts<>"" then
				AddElement_S(prefs.list,prefs.ts)
			endif
		Wend
		If flag=1 Then
			Close_File(Prefs.hfile)
			prefs.hFile = Open_File(FileName)
		EndIf
		prefs.flag=flag
	endif
	Return prefs.hFile
End Function

Function CloseFBini() As bool Export
	If prefs.flag=1 Then
		If SizeList(prefs.list)<>0 Then
			FirstElement(prefs.list)
			Do
				Write_StringN(prefs.hFile,GetList_S(prefs.list))
			Loop Until NextElement(prefs.list)=0
		EndIf
	EndIf
	ClearList(prefs.list)  
	Close_File(Prefs.hfile) 
	memset(@prefs,0, SizeOf(Tprefs))
	
	return 1
End Function

Sub WriteGroupFBini(ByRef group As USTRING) Export
	group= "[" & group & "]"
	AddElement_S(prefs.list,group)
End Sub

Function checkkeyini(ByVal Key As USTRING, ByVal Nlist1 As Long, ByVal flag As bool) As bool
	Var Nlist=Nlist1
	If flag=0 Then
		If NextElement(prefs.list)=0 Then
			Return 0
		EndIf
	EndIf
	Do
		Nlist+=1
		prefs.ts=GetList_S(prefs.list)
		If InStr(prefs.ts,Key & "=") Then
			If flag=1 And Nlist=1 Then
				Return 1
			ElseIf flag=1 Then
				Return Nlist
			Else
				Return Nlist+1
			EndIf
		EndIf
	Loop Until Left(prefs.ts,1) = "[" Or NextElement(prefs.list)=0
	Return 0
End Function

sub WriteSUB(ByVal group As USTRING,ByVal Key As USTRING, ByVal value As Any Ptr,ByVal know As USTRING)
	FirstElement(prefs.list)
	If group<>"" Then
		Do
			prefs.ts=GetList_S(prefs.list)
			If InStr(prefs.ts,group) And Right(prefs.ts,1)="]" Then
				prefs.check= checkkeyini(Key,prefs.Nlist,0)
				If prefs.check<>0 Then
					prefs.Nlist=0
					Exit Do
				EndIf
				Select Case know
					Case "{b}"
						InsertElement_S(prefs.list,prefs.Nlist+2,know & Key & "=" & Peek(Byte,value))
					Case "{w}"
						InsertElement_S(prefs.list,prefs.Nlist+2,know & Key & "=" & Peek(Short,value))
					Case "{i}"
						InsertElement_S(prefs.list,prefs.Nlist+2,know & Key & "=" & Peek(Long,value))
					Case "{d}"
						InsertElement_S(prefs.list,prefs.Nlist+2,know & Key & "=" & Peek(Double,value))
					Case "{s}"
						InsertElement_S(prefs.list,prefs.Nlist+2,know & Key & "=" & PeekS(value))
					Case "{l}"
						InsertElement_S(prefs.list,prefs.Nlist+2,know & Key & "=" & Peek(LongInt,value))
				End Select
				prefs.Nlist=0
				Exit Do
			EndIf
			prefs.Nlist+=1
		Loop Until NextElement(prefs.list)=0
	Else
		If SizeList(prefs.list)<>0 Then
			prefs.check= checkkeyini(Key,0,1)
		EndIf
		If prefs.check=0 Then
			Select Case know
				Case "{b}"
					AddElement_S(prefs.list,know & Key & "=" & Peek(Byte,value))
				Case "{w}"
					AddElement_S(prefs.list,know & Key & "=" & Peek(Short,value))
				Case "{i}"
					AddElement_S(prefs.list,know & Key & "=" & Peek(Long,value))
				Case "{d}"
					AddElement_S(prefs.list,know & Key & "=" & Peek(Double,value))
				Case "{s}"
					AddElement_S(prefs.list,know & Key & "=" & PeekS(value))
				Case "{l}"
					AddElement_S(prefs.list,know & Key & "=" & Peek(LongInt,value))
			End Select
		EndIf
	EndIf
	If prefs.check<>0 Then
		Select Case know
			Case "{b}"
				SetValueElement_S(prefs.list,prefs.check,know & Key & "=" & Peek(Byte,value))
			Case "{w}"
				SetValueElement_S(prefs.list,prefs.check,know & Key & "=" & Peek(Short,value))
			Case "{i}"
				SetValueElement_S(prefs.list,prefs.check,know & Key & "=" & Peek(Long,value))
			Case "{d}"
				SetValueElement_S(prefs.list,prefs.check,know & Key & "=" & Peek(Double,value))
			Case "{s}"
				SetValueElement_S(prefs.list,prefs.check,know & Key & "=" & PeekS(value))
			Case "{l}"
				SetValueElement_S(prefs.list,prefs.check,know & Key & "=" & Peek(LongInt,value))
		End Select
	EndIf
End Sub

Sub WriteValueFBini OverLoad(ByRef group As USTRING,ByRef Key As USTRING, ByVal value As byte) Export
	WriteSUB(group,Key,@value,"{b}")
End Sub

Sub WriteValueFBini OverLoad(ByRef group As USTRING,ByRef Key As USTRING, ByVal value As Short) Export
	WriteSUB(group,Key,@value,"{w}")
End Sub

Sub WriteValueFBini OverLoad(ByRef group As USTRING,ByRef Key As USTRING, ByVal value As Integer32) Export
	WriteSUB(group,Key,@value,"{i}")
End Sub

Sub WriteValueFBini OverLoad(ByRef group As USTRING,ByRef Key As USTRING, ByVal value As LongInt) Export
	WriteSUB(group,Key,@value,"{l}")
End Sub

Sub WriteValueFBini OverLoad(ByRef group As USTRING,ByRef Key As USTRING, ByVal value As Double) Export
	WriteSUB(group,Key,@value,"{d}")
End Sub

Sub WriteValueFBini OverLoad(ByRef group As USTRING,ByRef Key As USTRING, ByRef value As USTRING) Export
	#ifdef UNICODE
		WriteSUB(group,Key,cast(any ptr,*value),"{s}")
	#else
		WriteSUB(group,Key,strptr(value),"{s}")	
	#EndIf
End Sub

Function ReadByteValueFBini(ByRef group As USTRING,ByRef Key As USTRING) As byte Export
	If SizeList(prefs.list)<>0 Then
		FirstElement(prefs.list)
		If group<>"" Then
			Do
				If InStr(GetList_S(prefs.list),"[" & group & "]") Then
					
					If NextElement(prefs.list)=0 Then
						Return 0
					EndIf
					Do
						prefs.ts=GetList_S(prefs.list)
						If InStr(prefs.ts,"{b}" & Key & "=") Then
							Return Cast(Byte,atof(Mid(prefs.ts,Len("{b}" & Key & "=")+1)))
						EndIf
					Loop Until Left(prefs.ts,1) = "[" Or NextElement(prefs.list)=0
					Return 0
				EndIf
			Loop Until NextElement(prefs.list)=0
		Else
			Do
				prefs.ts=GetList_S(prefs.list)
				If InStr(prefs.ts,"{b}" & Key & "=") Then
					Return Cast(byte,atof(Mid(prefs.ts,Len("{b}" & Key & "=")+1)))
				EndIf
			Loop Until NextElement(prefs.list)=0
			Return 0
		EndIf
	EndIf
End Function

Function ReadShortValueFBini(ByRef group As USTRING,ByRef Key As USTRING) As Short Export
	If SizeList(prefs.list)<>0 Then
		FirstElement(prefs.list)
		If group<>"" Then
			Do
				If InStr(GetList_S(prefs.list),"[" & group & "]") Then
					
					If NextElement(prefs.list)=0 Then
						Return 0
					EndIf
					Do
						prefs.ts=GetList_S(prefs.list)
						If InStr(prefs.ts,"{w}" & Key & "=") Then
							Return Cast(Short,atof(Mid(prefs.ts,Len("{w}" & Key & "=")+1)))
						EndIf
					Loop Until Left(prefs.ts,1) = "[" Or NextElement(prefs.list)=0
					Return 0
				EndIf
			Loop Until NextElement(prefs.list)=0
		Else
			Do
				prefs.ts=GetList_S(prefs.list)
				If InStr(prefs.ts,"{w}" & Key & "=") Then
					Return Cast(Short,atof(Mid(prefs.ts,Len("{w}" & Key & "=")+1)))
				EndIf
			Loop Until NextElement(prefs.list)=0
			Return 0
		EndIf
	EndIf
End Function

Function ReadIntegerValueFBini(ByRef group As USTRING,ByRef Key As USTRING) As Integer32 Export
	If SizeList(prefs.list)<>0 Then
		FirstElement(prefs.list)
		If group<>"" Then
			Do
				If InStr(GetList_S(prefs.list),"[" & group & "]") Then
					
					If NextElement(prefs.list)=0 Then
						Return 0
					EndIf
					Do
						prefs.ts=GetList_S(prefs.list)
						If InStr(prefs.ts,"{i}" & Key & "=") Then
							Return Cast(Integer32,atof(Mid(prefs.ts,Len("{i}" & Key & "=")+1)))
						EndIf
					Loop Until Left(prefs.ts,1) = "[" Or NextElement(prefs.list)=0
					Return 0
				EndIf
			Loop Until NextElement(prefs.list)=0
		Else
			Do
				prefs.ts=GetList_S(prefs.list)
				If InStr(prefs.ts,"{i}" & Key & "=") Then
					Return Cast(Integer32,atof(Mid(prefs.ts,Len("{i}" & Key & "=")+1)))
				EndIf
			Loop Until NextElement(prefs.list)=0
			Return 0
		EndIf
	EndIf
End Function

Function ReadLongintValueFBini(ByRef group As USTRING,ByRef Key As USTRING) As LongInt Export
	If SizeList(prefs.list)<>0 Then
		FirstElement(prefs.list)
		If group<>"" Then
			Do
				If InStr(GetList_S(prefs.list),"[" & group & "]") Then
					
					If NextElement(prefs.list)=0 Then
						Return 0
					EndIf
					Do
						prefs.ts=GetList_S(prefs.list)
						If InStr(prefs.ts,"{l}" & Key & "=") Then
							Return Cast(LongInt,atof(Mid(prefs.ts,Len("{l}" & Key & "=")+1)))
						EndIf
					Loop Until Left(prefs.ts,1) = "[" Or NextElement(prefs.list)=0
					Return 0
				EndIf
			Loop Until NextElement(prefs.list)=0
		Else
			Do
				prefs.ts=GetList_S(prefs.list)
				If InStr(prefs.ts,"{l}" & Key & "=") Then
					Return Cast(LongInt,atof(Mid(prefs.ts,Len("{l}" & Key & "=")+1)))
				EndIf
			Loop Until NextElement(prefs.list)=0
			Return 0
		EndIf
	EndIf
End Function

Function ReadDoubleValueFBini(ByRef group As USTRING,ByRef Key As USTRING) As Double Export
	If SizeList(prefs.list)<>0 Then
		FirstElement(prefs.list)
		If group<>"" Then
			Do
				If InStr(GetList_S(prefs.list),"[" & group & "]") Then				
					If NextElement(prefs.list)=0 Then
						Return 0
					EndIf
					Do
						prefs.ts=GetList_S(prefs.list)
						If InStr(prefs.ts,"{d}" & Key & "=") Then
							Return Cast(Double,atof(Mid(prefs.ts,Len("{d}" & Key & "=")+1)))
						EndIf
					Loop Until Left(prefs.ts,1) = "[" Or NextElement(prefs.list)=0
					Return 0
				EndIf
			Loop Until NextElement(prefs.list)=0
		Else
			Do
				prefs.ts=GetList_S(prefs.list)
				If InStr(prefs.ts,"{d}" & Key & "=") Then
					Return Cast(Double,atof(Mid(prefs.ts,Len("{d}" & Key & "=")+1)))
				EndIf
			Loop Until NextElement(prefs.list)=0
			Return 0
		EndIf
	EndIf
End Function

Function ReadStringValueFBini(ByRef group As USTRING,ByRef Key As USTRING) As USTRING Export
	If SizeList(prefs.list)<>0 Then
		FirstElement(prefs.list)
		If group<>"" Then
			Do
				If InStr(GetList_S(prefs.list),"[" & group & "]") Then
					If NextElement(prefs.list)=0 Then
						Return ""
					EndIf
					Do
						prefs.ts=GetList_S(prefs.list)
						If InStr(prefs.ts,"{s}" & Key & "=") Then
							Return Mid(prefs.ts,Len("{s}" & Key & "=")+1)
						EndIf
					Loop Until Left(prefs.ts,1) = "[" Or NextElement(prefs.list)=0
					Return ""
				EndIf
			Loop Until NextElement(prefs.list)=0
		Else
			Do
				prefs.ts=GetList_S(prefs.list)
				If InStr(prefs.ts,"{s}" & Key & "=") Then
					Return Mid(prefs.ts,Len("{s}" & Key & "=")+1)
				EndIf
			Loop Until NextElement(prefs.list)=0
			Return ""
		EndIf
	endif
End Function