#Include once "window9.bi"
#Include once "crt/stdlib.bi"

type ListNode14
  declare constructor()  ' конструктор
  id as UInteger   ' индекс узла
  valueS as String  ' значение которое хранится в узле списка
  prev_node as ListNode14 Ptr  ' указатель на предыдущий узел
  next_node as ListNode14 Ptr  ' указатель на следующий узел
End type

' класс списка
type List14
  declare constructor() ' конструктор
  declare destructor() ' деструктор
  declare sub Clear() '  метод очистки всего списка
  declare function AddLastS ( as string ) as UInteger ' метод добавление нового узла в конец списка
  Declare Sub AddHeadS (As String)
  Declare function Insert_S (As UInteger,As String) As UInteger
  declare function FindByID( as uinteger ) as ListNode14 Ptr ' ищет узел по индексу
  Declare Function GetCount (As List14 Ptr) As Integer
  Declare function GURR( ) as ListNode14 Ptr
  Declare function GURR1( ) as ListNode14 Ptr
  Declare function PRED( ) as ListNode14 Ptr
  Declare function First( ) as ListNode14 Ptr
  Declare function Last( ) as ListNode14 Ptr
  Gurrent As ListNode14 Ptr   ' текущий узел
  first_node as ListNode14 Ptr ' указатель на первый узел
  last_node as ListNode14 Ptr ' указатель на последний узел
end Type
' конструктор узла
constructor ListNode14()
  ' просто обнуляет указатели
  this.id = 0
  this.prev_node = 0
  this.next_node = 0
End constructor

' конструктор списка
constructor List14()
  ' просто обнуляет указатели
  this.first_node = 0
  this.last_node = 0
End constructor

' деструктор списка
destructor List14()
  ' вызывает метод очистки списка
  this.Clear()
end destructor

' метод очищающий весь список
sub List14.Clear()
  dim del_node as ListNode14 Ptr ' указатель на разрушаемый узел
  dim next_node as ListNode14 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 List14.AddHeadS (valueS As String)
  DIM temp2 AS ListNode14 Ptr
  DIM temp1 AS ListNode14 Ptr
  IF first_node   Then                                ' если хотя бы одна запись уже есть
    temp1=first_node  ' запоминаем адрес первого
    temp2 = first_node->next_node     '  узнаем адрес второго элемента
    first_node = New ListNode14  ' делаем первым, выделяя новый элемент
    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
  ELSE                                      ' иначе
    first_node = New ListNode14              ' создаём первую
    first_node->valueS=valueS
    first_node->id=1
    last_node=first_node
    Gurrent=last_node
  END IF
END Sub
function List14.Insert_S (ida As UInteger,valueS As String) As UInteger
  /'.....................................................................................................
  ........................................ Ищем указатель для вставки........................................
  .....................................................................................................'/
  IF first_node   Then   ' если хотя бы одна запись уже есть
    Dim seek_node as ListNode14 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 ListNode14 Ptr
    Dim temp1 AS ListNode14 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 ListNode14 ' создаем новый адрес относительно предыдущего
    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
  ELSE                                      ' иначе
    first_node = New ListNode14              ' создаём первую
    first_node->valueS=valueS
    first_node->id=1
    last_node=first_node
    Gurrent=last_node
  END IF
END Function
' метод добавление узла в конец списка
function List14.AddLastS( valueS  as string ) as UInteger
  dim new_node as ListNode14 Ptr ' указатель на новый узел
  new_node = New ListNode14 ' создаёт объект узла
  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 ' возвращает идентификатор нового узла
end Function

Function List14.PRED( ) as ListNode14 Ptr
  Gurrent=Gurrent->prev_node
  Return Gurrent
End Function

function List14.First( ) as ListNode14 Ptr
  Gurrent=first_node
  Return Gurrent
End Function

function List14.Last( ) as ListNode14 Ptr
  Gurrent=last_node
  Return Gurrent
End Function

function List14.GURR( ) as ListNode14 Ptr
  Gurrent=Gurrent->next_node
  Return Gurrent
End Function

function List14.GURR1( ) as ListNode14 Ptr
  Return Gurrent
End Function

' ищет узел по индексу
function List14.FindByID( id as uinteger ) as ListNode14 ptr
  dim seek_node as ListNode14 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 ' возвращает 0, если узел не найден
end Function

FUNCTION List14.GetCount (lis As List14 Ptr) As Integer
  Var ggg=lis->FindByID(1)
  If ggg=0 Then
    ggg=lis->FindByID(2)
    If ggg=0 Then Return 0
  EndIf
  DIM temp  AS ListNode14 PTR = ggg' создаём временный объект и делаем его первым в списке
  DIM count AS INTEGER    = 0  ' создаём счётчик записей
  WHILE temp                          ' пока записи не закончились
    count = count + 1              ' учитываем текущую
    temp = temp->next_node          ' переходим на следующую
  WEND
  RETURN count
END Function

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

Type Tprefs
  As HANDLE  hfile
  As Integer  buff,Nlist,check
  As Byte     b,c,know
  As String   key,ts
  As Any Ptr  list
  As bool flag
End Type
Dim Shared Prefs As Tprefs
Function CreateFBini( ByVal filename As String) As handle Export
  prefs.hFile = CreateFile(FileName,GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,0)
  prefs.list=NewList()
  prefs.flag=1
  Return prefs.hFile
End Function
Function OpenFBini( ByVal filename As String,ByVal flag As bool=0) As handle Export
  prefs.hFile = CreateFile(FileName,GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,0)
  If prefs.hFile<>-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
      CloseHandle(Prefs.hfile)
      prefs.hFile = CreateFile(FileName,GENERIC_WRITE Or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL,0)
    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)
  ZeroMemory(@prefs,SizeOf(Tprefs))
  Return CloseHandle(Prefs.hfile)
End Function
Sub WriteGroupFBini(ByRef group As String) Export
  group= "[" & group & "]"
  AddElement_S(prefs.list,group)
End Sub
Function checkkeyini(ByVal Key As String, ByVal Nlist1 As Integer, 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 String,ByVal Key As String, ByVal value As Any Ptr,ByVal know As String)
  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(Integer,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(Integer,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(Integer,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(ByVal group As String,ByVal Key As String, ByVal value As byte) Export
  WriteSUB(group,Key,@value,"{b}")
End Sub

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

Sub WriteValueFBini OverLoad(ByVal group As String,ByVal Key As String, ByVal value As Integer) Export
  WriteSUB(group,Key,@value,"{i}")
End Sub

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

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

Sub WriteValueFBini OverLoad(ByVal group As String,ByVal Key As String, ByVal value As String) Export
  WriteSUB(group,Key,StrPtr(value),"{s}")
End Sub

Function ReadByteValueFBini(ByVal group As String,ByVal Key As String) 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(ByVal group As String,ByVal Key As String) 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(ByVal group As String,ByVal Key As String) As Integer 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(Integer,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(Integer,atof(Mid(prefs.ts,Len("{i}" & Key & "=")+1)))
        EndIf
      Loop Until NextElement(prefs.list)=0
      Return 0
    EndIf
  EndIf
End Function

Function ReadLongintValueFBini(ByVal group As String,ByVal Key As String) 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(ByVal group As String,ByVal Key As String) 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(ByVal group As String,ByVal Key As String) As String 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
