PureBasic Forums - English

Code: Select all

; Uses the application folder to store preferences if the program
; is running from a removable drive. If running from anything else
; it stores the preferences files in the user profile folder

declare writePreferences(inFolder.s, name.s)
declare readPreferences(inFolder.s, name.s)
declare.s getSpecialFolder(id)


;demo code
global location.s

writePreferences("Preferences File Test", "Preferences File Test.prefs")
readPreferences("Preferences File Test", "Preferences File Test.prefs")

messageRequester("Preference File", "Written to: " + location)
runProgram(getPathPart(location))

end
;end demo code


procedure writePreferences(inFolder.s, name.s)
  #CSIDL_APPDATA = $1A
  ;	XP:     C:\Documents and Settings\username\Application Data*    
  ;	Vista:  C:\Users\username\AppData\Roaming
  if len(inFolder)
    inFolder + "\"
  endIf
  path.s = getPathPart(programFileName())
  type = getDriveType_(left(path, 2))
  if type = 2
    ;removable
    path = path + inFolder
  else
    path = getSpecialFolder(#CSIDL_APPDATA) + inFolder
  endIf
  createDirectory(path)
  if createPreferences(path + name)
    ; insert your own preferences code below
    preferenceGroup("location")
      writePreferenceString("is", path + name)
    ; insert your own preferences code above
    closePreferences()
    procedureReturn 1    
  endIf
  procedureReturn 0
endProcedure

procedure readPreferences(inFolder.s, name.s)
  #CSIDL_APPDATA = $1A
  ;	XP:     C:\Documents and Settings\username\Application Data*    
  ;	Vista:  C:\Users\username\AppData\Roaming
  if len(inFolder)
    inFolder + "\"
  endIf
  path.s = getPathPart(programFileName())
  type = getDriveType_(left(path, 2))
  if type = 2
    ;removable
    path = path + inFolder + name
  else
    path = getSpecialFolder(#CSIDL_APPDATA) + inFolder + name
  endIf
  openPreferences(path)
    ; insert your own preferences code below
    preferenceGroup("location")
    location = readPreferenceString("is", "unknown")
    ; insert your own preferences code above
  closePreferences()
endProcedure

procedure.s getSpecialFolder(id)
  shGetSpecialFolderLocation_(0, id, @pidl) 
  path.s = space(#MAX_PATH) 
  shGetPathFromIDList_(pidl, @path)
  if right(path, 1) <> "\"
    path + "\"
  endIf
  if pidl 
   coTaskMemFree_(pidl)
  endIf 
  procedureReturn path
endProcedure