PureBasic Forums - English

Code: Select all

;*****************************************************************************
;* IO Functions                                                              *
;*****************************************************************************

;
;
;
Procedure.l OpenEditPrefs(filename.s)
  rfh.l=ReadFile(#PB_Any,filename)
  If(rfh<>0)
    Global NewList preflns.s()
    resl=#True
    Repeat
      ln.s=ReadString(rfh)
      If ln<>""
        AddElement(preflns())
        preflns()=ln
      EndIf
    Until ln=""
    CloseFile(rfh)
  Else
    resl=#False
  EndIf
EndProcedure
;
;
;
Procedure SaveEditPrefs(filename.s)
  wfh.l=CreateFile(#PB_Any,filename)
  If(wfh<>0)
    ForEach preflns()
      WriteStringN(wfh,preflns())
    Next
    CloseFile(wfh)
  EndIf
EndProcedure
;
;
;
Procedure CloseEditPrefs()
  ClearList(preflns())
EndProcedure

;*****************************************************************************
;* Utils Functions                                                           *
;*****************************************************************************
;
;
;
Procedure FindPrefsGroup(group.s)
  fngroup.s="["+LCase(group)+"]"
  ForEach preflns()
    If(LCase(preflns())=fngroup)
      resl=itln
      Break
    EndIf           
    itln=itln+1
  Next
  ProcedureReturn resl
EndProcedure
;
;
;
Procedure.l FindPrefsGroupKey(group.s,key.s)
  keysearch.l=#False
  groupsearch.l=#True
  resl=-1
  fngroup.s="["+LCase(group)+"]"
  fnkey.s=LCase(Key)
  ForEach preflns()
    If(Left(preflns(),1)="[") And (LCase(preflns())<>fngroup) And (groupsearch=#False)
      Break
    EndIf
    If(LCase(preflns())=fngroup)
      NextElement(preflns())
      groupsearch=#False
      keysearch=#True
    EndIf           
    If(keysearch=#True)
      If(LCase(Left(preflns(),Len(fnkey)))=fnkey)
        resl=itln
        keysearch=#False
        Break
      EndIf   
    EndIf
    itln=itln+1
  Next
  ProcedureReturn resl
EndProcedure

;*****************************************************************************
;* Change Key Functions                                                      *
;*****************************************************************************

;
;
;
Procedure.l EditPrefsString(group.s,key.s,newval.s)
  itln.l=FindPrefsGroupKey(group,key)
  If(itln<>-1)
    SelectElement(preflns(),itln+1)
    preflns()=key.s+" = "+newval.s
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure
;
;
;
Procedure.l EditPrefsLong(group.s,key.s,newval.l)
  itln.l=FindPrefsGroupKey(group,key)
  If(itln<>-1)
    SelectElement(preflns(),itln+1)
    preflns()=key.s+" = "+StrU(newval,#PB_Long )
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure
;
;
;
Procedure.l EditPrefsFloat(group.s,key.s,newval.f)
  itln.l=FindPrefsGroupKey(group,key)
  If(itln<>-1)
    SelectElement(preflns(),itln+1)
    preflns()=key.s+" = "+StrF(newval)
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure

;*****************************************************************************
;* Delete Key Functions                                                      *
;*****************************************************************************
;
;
;
Procedure.l EditPrefsDeleteGroupKey(group.s,key.s)
  itln.l=FindPrefsGroupKey(group,key)
  If(itln<>-1)
    SelectElement(preflns(),itln+1)
    DeleteElement(preflns())
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure
;
;
;
Procedure.l EditPrefsDeleteGroup(group.s)
  donedel.b=#False
  itln.l=FindPrefsGroup(group)
  If(itln<>-1)
    SelectElement(preflns(),itln)
    While(donedel=#False)
      DeleteElement(preflns())
      If(NextElement(preflns())=0)
        donedel=#True
      EndIf
      If (Left(preflns(),1)="[")
        PreviousElement(preflns())
        DeleteElement(preflns())
        donedel=#True
      EndIf
    Wend
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure
;*****************************************************************************
;* Insert Key Functions                                                      *
;*****************************************************************************
;
;
;
Procedure.l EditPrefsInsertGroupKeyString(group.s,key.s,insstrval.s)
  done.b=#False
  itln.l=FindPrefsGroup(group)
  If(itln<>-1)
    SelectElement(preflns(),itln)
    While(done=#False)
      If(NextElement(preflns())=0)
        LastElement(preflns())
        AddElement(preflns())
        preflns()=key+" = "+insstrval
        done=#True
      EndIf
      If (Left(preflns(),1)="[")
        PreviousElement(preflns())
        InsertElement(preflns())
        preflns()=key+" = "+insstrval
        done=#True
      EndIf
    Wend
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure
;
;
;
Procedure.l EditPrefsInsertGroupKeyLong(group.s,key.s,insstrval.l)
  done.b=#False
  itln.l=FindPrefsGroup(group)
  If(itln<>-1)
    SelectElement(preflns(),itln)
    While(done=#False)
      If(NextElement(preflns())=0)
        LastElement(preflns())
        AddElement(preflns())
        preflns()=key+" = "+StrU(insstrval,#PB_Long )
        done=#True
      EndIf
      If (Left(preflns(),1)="[")
        PreviousElement(preflns())
        InsertElement(preflns())
        preflns()=key+" = "+StrU(insstrval,#PB_Long )
        done=#True
      EndIf
    Wend
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure
;
;
;
Procedure.l EditPrefsInsertGroupKeyFloat(group.s,key.s,insstrval.f)
  done.b=#False
  itln.l=FindPrefsGroup(group)
  If(itln<>-1)
    SelectElement(preflns(),itln)
    While(done=#False)
      If(NextElement(preflns())=0)
        LastElement(preflns())
        AddElement(preflns())
        preflns()=key+" = "+StrF(insstrval)
        done=#True
      EndIf
      If (Left(preflns(),1)="[")
        PreviousElement(preflns())
        InsertElement(preflns())
        preflns()=key+" = "+StrF(insstrval)
        done=#True
      EndIf
    Wend
    resl=#True
  Else
    resl=#False
  EndIf
  ProcedureReturn resl
EndProcedure