WritePrivateProfileStructA Demo

- tsh73

Demonstration Program

- tsh73

 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