WritePrivateProfileStructA Demo

- tsh73

---

Demonstration Program

Accompanies the article on Initialization Files

- tsh73 advises, "Run it, write it, read it, break it and try to write again."

print " * WritePrivateProfileStructA / GetPrivateProfileStructA demo *"
'based on code by Richard Russel (80%) and by Stefan Pendl (15%)
print
 
dim info$(1, 1) 'for fileExists
struct config, soundon$ as char[12], fullscreen as long
SoundOn$ = "sound is on"
config.soundon$.struct = SoundOn$
config.fullscreen.struct = 4
 
print "Initial values: [soundon$ = ";config.soundon$.struct;"]  [fullscreen = ";config.fullscreen.struct;"]"
 
if right$(DefaultDir$,1)<>"\" then
    DefaultDir$=DefaultDir$+"\"
end if
inifile$ = DefaultDir$ + "testINI.ini"
print inifile$ 
if fileExists("",  inifile$) then print "File exists" else print "No such file"
print
 
[mnu]
    print "1. Write INI"
    print "2. Read INI"
    print "3. Delete INI"
    print "4. Mess with INI with Notepad (don't forget to save it)"
    print "0. Exit"
    input "Enter selection: ";sel
    if sel = 0 then end
    if sel <1 or sel >4 then [mnu]
 
select case sel
case 1
    size = len(config.struct)
 
    calldll #kernel32, "WritePrivateProfileStructA", _
    "settings" as ptr, _  ' Section name
    "config" as ptr, _    ' Key name
    config as struct, _   ' Structure
    size as ulong, _      ' Size of structure
    inifile$ as ptr, ret as long
 
    if ret=0 then  'If the function successfully copies the string to the initialization file, the return value is nonzero.
        print "Some error happened"
        call displayError
    else
        print "Write OK"
    end if
 
case 2
    size = len(config.struct)
 
    calldll #kernel32, "GetPrivateProfileStructA", _
    "settings" as ptr, _  ' Section name
    "config" as ptr, _    ' Key name
    config as struct, _   ' Structure
    size as ulong, _      ' Size of structure
    inifile$ as ptr, ret as long
 
    if ret=0 then  'If the function succeeds, the return value is nonzero.
        print "Some error happened"
        call displayError
    else
        print "Read OK"
        '  To retrieve the information from the struct:
        '
        SoundOn$ = config.soundon$.struct
        FullScreen = config.fullscreen.struct
        print "SoundOn$: ";SoundOn$
        print "FullScreen: ";FullScreen
    end if
 
case 3
     call tryToKill inifile$
     if fileExists("",  inifile$) then print "File still exists" else print "No such file"
 
case 4
     run "notepad.exe "+inifile$ 
 
end select
 
goto [mnu]
 
 
end
 
sub tryToKill filename$
'try to kill it
'don't care much if failed
    on error goto [handler]
    kill filename$
[handler]
end sub
 
sub displayError
    ' by Stefan Pendl
    calldll #kernel32, "GetLastError", _
        ErrorCode as ulong
 
    dwFlags = _FORMAT_MESSAGE_FROM_SYSTEM
    nSize = 1024
    lpBuffer$ = space$(nSize); chr$(0)
    dwMessageID = ErrorCode
 
    calldll #kernel32, "FormatMessageA", _
        dwFlags      as ulong, _
        lpSource     as ulong, _
        dwMessageID  as ulong, _
        dwLanguageID as ulong, _
        lpBuffer$    as ptr, _
        nSize        as ulong, _
        Arguments    as ulong, _
        result       as ulong
 
    print "Error "; ErrorCode; ": "; left$(lpBuffer$, result)
end sub
 
function fileExists(path$, filename$)
  files path$, filename$, info$()
  fileExists = val(info$(0, 0)) 'non zero is true
end function