Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Move that INI File

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Move that INI File

    Code:
    ' NAME: inifile_move.bas
    ' PURPOSE: Convert (move or copy) INI file (well, actually 'any file') from "directory of EXE"
    ' (well, actually 'anywhere') to approved' Vista/Fully-secured NT class box location.
    ' USAGE:
    ' Add to your program and call at start passing the "old" ini file name and the approved
    ' new Location. After success (zero), use NEW location for all references to file
    ' Does nothing if file already moved.
    ' Author: Michael Mattias Tal Systems Inc Racine WI  March 21 2007
    ' Usage:  PLaced in public domain by author
    ' Compiler used: PB/Windows v 8.03. Should work on Anything PB 5+
    
    #COMPILE  EXE
    #DEBUG    ERROR ON
    #REGISTER NONE
    #DIM      ALL
    #TOOLS    OFF
    '=====[Windows API Header Files] ============================
    '  If you don't need all of the functionality supported by these APIs
    '  (and who does?), you can selectively turn off various modules by putting
    '  the following constants in your program BEFORE you #include "win32api.inc":
    '
    '  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
    '  %NOMMIDS = 1   ' no Multimedia ID definitions
    %NODGI   = 1
    %NOMMIDS = 1
    #INCLUDE "WIN32API.INC"   ' Feb 2005
    '==[End Windows API Header Files]============================
    
    ' equates from shlobj.h not found in Win32API.INC
    %SHGFP_TYPE_CURRENT  = 0&    ' // current value for user, verify it exists
    %SHGFP_TYPE_DEFAULT  = 1&    ' // default value, may not exist
    
    ' REFERENCE MATERIAL
    #IF 0
    ------------------------------------------------------
    HRESULT SHGetFolderPath(
        HWND hwndOwner,           ' typically null
        INT nFolder,              ' CSIDL equate; must exist. Force creation by adding %CSIDL_FLAG_CREATE
        HANDLE hToken,            ' -1& = default user, NULL OK else 'access token'
        DWORD dwFlags,            ' SHGFP_TYPE_CURRENT (current, always exists)
                                  '  or SHGFP_TYPE_DEFAULT (may not exist)
        LPTSTR pszPath            ' max_path ASCIIZ, result here
        
    );
    ' Returns: S_OK on success, s_FALSE if CSIDL valid but fle does not exist
    ' E_INVALIDARG if invalid cSIDL
    -------------------------------
    #ENDIF
    
    ' ===================================================================
    ' MOVE A FILE TO A 'SPECIAL FOLDER' AUTOMATICALLY CREATING ANY REQUIRED
    ' SUBDIRECTORIES. DO NOTHING IF FILE FOUND IN NEW LOCATION
    '======================================================================
    ' szIniFile         = Fully-qualified file name to be moved
    ' Approved location = one of the %CSIDL_xxx equates
    ' szSubFolders      = subfolders to be created under approved location
    '                     separated by backslash. Do not prefix or suffix a backslash!
    ' Example call: RelocateINiFile "c:\MyProgram\myprog,ini", _
    '                                %CSIDL_COMMON_APPDATA, _
    '                                "company name\program name"
    
    FUNCTION RelocateIniFile ( sziniFile AS ASCIIZ, BYVAL ApprovedLocation AS LONG, OPTIONAL szSubFolder AS ASCIIZ) AS LONG
        
      LOCAL szApprovedPath AS ASCIIZ * %MAX_PATH
      LOCAL iRET AS LONG
      LOCAL szF AS ASCIIZ * %MAX_PATH
      LOCAL sFilePArt AS STRING
      LOCAL shfo AS SHFILEOPSTRUCT
      
      ' if requested ini file already exists in target folder, just exit with success.
      ' this allows this function to be called "always" and not worry that the file
      ' has already been moved or copied.
      
      ' -------------------------------------------------------------------
      ' get the approved path (folder name); force creation if necessary
      ' -------------------------------------------------------------------
       iRet = ShgetFolderPath (BYVAL %NULL,_
                               (ApprovedLocation OR %CSIDL_FLAG_CREATE), _
                               -1&, _
                               %SHGFP_TYPE_CURRENT ,_
                               szApprovedPath)
                               
       IF iRet <> %S_OK THEN
           MSGBOX IIF$(iRet = %S_FALSE, "S_FALSE", "E_INVALIDARG")
           FUNCTION = -1&
           EXIT FUNCTION
       ' -----------------------------
       '  ELSE CLAUSE JUST FOR TESTING
       ' -----------------------------
       'ELSE
       '    MSGBOX USING$ ("Approved folder name '&'", szApprovedPath)
       END IF
       
       ' set up full path to new location if subfolders specified
       IF VARPTR (szSubFolder) THEN
             szApprovedPath = szApprovedPath & "\" & szSubFolder
       END IF
       
       
       ' if the new INI File already exists when we get here, we do NOT overwrite it
       sFilePart = MID$(szIniFile, INSTR(-1&, szIniFile,"\") + 1)
       szF       = szApprovedPath & "\" & sFilePart               ' fully=pathed new INI file
       
      ' at this point, we can set up a 'move file' operation. THis will fail
      ' if the specified source INI does not exist, but the error-handling gets tricky
      ' so we will test the old fashioned way
      
       IF DIR$(szF) = ""  THEN                        ' new Ini file does not yet exist
           IF DIR$(szIniFile) = "" THEN
               MSGBOX USING$ ("Cannot find old INI File '&'", szIniFile)
               FUNCTION = -1&
           ELSE
               ' move it to new location
               shfo.hWnd    = GEtDesktopwindow()
               shfo.wFunc   = %FO_MOVE                   '  %FO_COPY keeps old, %FO_MOVE moves!
               shfo.pfrom   = VARPTR (szIniFile)         '  tested both OK
               shfo.pTo     = VARPTR (szF)
               shfo.fflags  = %FOF_NOCONFIRMMKDIR OR %FOF_SILENT
               iret         = ShFileOperation (shfo)
               IF ISTRUE iRET THEN  ' true here means error
                   MSGBOX "Error Moving File"
                   FUNCTION = -1&
                   EXIT FUNCTION
               END IF
           END IF
       ' ----------------------------------------
       '  THIS ELSE CLAUSE WAS JUST FOR TESTING
       ' ----------------------------------------
       'ELSE
       '    MSGBOX "INI FIle already in new location, doing nothing"
       END IF
       
        
    END FUNCTION
        
    FUNCTION PBMAIN() AS LONG
    
     LOCAL szINi AS ASCIIZ * %MAX_PATH
     LOCAL ap AS LONG
     
     LOCAL szSubFolder AS ASCIIZ * %MAX_PATH
     
     ' OLD, FORBIDDEN INI FILE:
     ' most programmers have some kind of function they use to get this
     szIni = "C:\Program Files\EDIPAL 2.6\System\Edipal.ini"
     
     
     ' NEW VISTA (OR FULLY-SECURED NT CLASS) LOCATION
     Ap          =  %CSIDL_COMMON_APPDATA     ' these return expected values this returns 'all users'
    ' Ap = %CSIDL_LOCAL_APPDATA           ' this works returns 'Michael' user settings
     szSubFOlder = "Tal Systems\EDI Pal\2.6"
     
     CALL RelocateIniFile (szIni, ap, szSubFolder)
     
    END FUNCTION
        
    '--- END OF FILE ---
    ------------------
    Michael Mattias
    Tal Systems Inc.
    Racine WI USA
    mailto:[email protected][email protected]</A>
    www.talsystems.com
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

  • #2
    variation originally posted at http://www.powerbasic.com/support/pb...ad.php?t=14229 ...

    ...may or may not be handy...

    .. works here on win xp/pro, pb/win 8.03

    mcm

    Code:
    #option  version5 
    ' requires nt class o/s  plus shell32.dll 5.0 or later. 
    
    ' declare not in win32api.inc
    declare function shcreatedirectory lib "shell32.dll" alias "shcreatedirectory" _
        (byval hwnd as long, byval ppath as dword) as long
    
    
    $ini_filename    = "837export.ini"
    %ini_folder      = %csidl_common_appdata
    $ini_subfolder   = "tal systems\837export"    ' no leading or trailing backslash here
    
    ' ---------------------------------------------
    ' new approved location ini file name
    ' on first call, it insures the folder exists,
    ' although not the ini file itself. 
    ' (the ini functions handle that) 
    ' ---------------------------------------------
    
    function getinifilename () as string
        
        local approvedlocation as long, szapprovedpath as asciiz * %max_path
        local szsubfolder as asciiz * 64
        local iret as long
        local supath as string
        
        static beenhere as long                ' we might be calling this function a lot 
        static szthename  as asciiz * %max_path
        
        if istrue beenhere then
            function        =  szthename
            exit function
        else
            beenhere          =  %true
            approvedlocation  =  %ini_folder
            szsubfolder       =  $ini_subfolder
           ' ------------------------------------------------------------------------
           ' get the approved base path (folder name); force creation if necessary
           ' -------------------------------------------------------------------------
           iret = shgetfolderpath (byval %null,_
                               (approvedlocation or %csidl_flag_create), _
                               -1&, _
                               %shgfp_type_current ,_
                               szapprovedpath)
           if iret <> %s_ok then
               msgbox iif$(iret = %s_false, "s_false", "e_invalidarg")
               function = "
           end if
    
           ' set up full path to new location if subfolders specified (no trailing slash)
           szapprovedpath = szapprovedpath & "\" & szsubfolder
           ' make sure the directory exists.
           ' shcreatedirectory handles all the intermediate nodes, mkdir does not.
           ' shcreatedirectory requires unicode string for path
           
          supath  =  ucode$ (szapprovedpath) & $nul & $nul   ' add unicode termination
          iret    =  shcreatedirectory (byval %null, byval strptr(supath))  'param 1 - hwnd, may be null
          select case as long iret
              case %error_success, %error_file_exists, %error_already_exists
                  ' we don't care
                  iret = 0
              case else
                  ' returning error_bad_pathname (161) when you forget to make the path unicode!
                  msgbox using$ ("could not create folder '&' for ini file, error # ", szapprovedpath, iret)
          end select
    
          szthename = szapprovedpath & "\" & $ini_filename  ' set static var
          function  = szthename                             ' and return it
          
       end if ' if this was the first call or not.
       
    end function
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      One more modification. This version will return the Application (common) Approved folder (Path) -OR- the User Specific Folder (Path) based on the flag WhichLocation. If the path does not exist, this function will create it (MKDIR does not create 'nested' paths).

      The original function jumped out on re-entry calls by for the sake of complexity, I removed that feature. The call itself is extremely fast so it didn't seem to warrant the extra code to me. Feel free to add the logic in if you wish.
      Code:
      ' JPRO_COMPILER = PB/WIN
      ' JPRO_COMPILETEMP = TRUE
       
       
      '+------------------------------------------------------------------------------------------------------+
      '|Program       : ApprovedFolders.bas                                                                   |
      '|              : Modified from Michael Mattias's original work 'Move that INI'                         |
      '|              :                                                                                       |
      '|              : Slight modifications to pass a flag for either the Application Specific folder/Path   |
      '|              : or the User specific folder/Path                                                      |
      '|              :                                                                                       |
      '|              : Returns the requested path based on the flag %AppFolder or %UserFolder                |
      '|              : If the Foler/Path does not exist, it is created.  The actual .INI file(s) are not.    |
      '|              :                                                                                       |
      '|Version       : 1.1                                                                                   |
      '|Created       : May 10th, 2007                                                                        |
      '|Last Mod      :                                                                                       |
      '|              :                                                                                       |
      '|              : Released to the public domain.  Feel free to modify as you will                       |
      '|              :                                                                                       |
      '|Dependencies  :                                                                                       |
      '|============  :                                                                                       |
      '| * PBWin      : Compiler  v8 (8.03) although should work with any PB compiler 5+                      |
      '| * WIN32API   : Version   12/1/2005                                                                   |
      '| *            : All WIN32API settings declared in source (via InClean)                                |
      '+------------------------------------------------------------------------------------------------------+
       
      '
      #OPTION  VERSION5 
      #COMPILE EXE
      #DIM ALL
      '
      %WINAPI                 = 1
      %TRUE                   = 1
      %NULL                   = 0  
      %AppFolder              = 0             'Flag to return Application (common) folder
      %UserFolder             = 1             'Flag to return User specific folder
      %CSIDL_APPDATA          = &H001a        '<user name>\Application Data
      %CSIDL_COMMON_APPDATA   = &H0023        'All Users\Application Data
      %CSIDL_FLAG_CREATE      = &H00008000    'combine with CSIDL_ value to force MKDIR in SHGetFolderPath()
      %ERROR_SUCCESS          = 0             
      %ERROR_FILE_EXISTS      = 80            
      %ERROR_ALREADY_EXISTS   = 183           
      %S_OK                   = &H00000000    
      %S_FALSE                = &H00000001    
      %SubDir                 = &B010000      
      %MAX_PATH               = 260           'max. length of full pathname
      %SHGFP_TYPE_CURRENT     = 0&            'current value for user, verify it exists
      %SHGFP_TYPE_DEFAULT     = 1&            'default value, may not exist
      '
      '-----------------------------------------------------------------
      DECLARE FUNCTION SHGETFOLDERPATH LIB "SHFOLDER.DLL" ALIAS "SHGetFolderPathA" _ 
                                        (BYVAL hwndOwnder AS DWORD, _ 
                                         BYVAL nFolder AS LONG, _ 
                                         BYVAL hToken AS DWORD, _ 
                                         BYVAL dwFlags AS DWORD, _ 
                                         pszPath AS ASCIIZ)           AS LONG
      DECLARE FUNCTION SHCreateDirectory LIB "SHELL32.DLL" ALIAS "SHCreateDirectory" _
                                        (BYVAL hwnd AS LONG, BYVAL pPath AS DWORD) AS LONG
      DECLARE FUNCTION GetIniFileName   (BYVAL sCompany AS STRING, _ 
                                         BYVAL sTitle AS STRING, _ 
                                         WhichLocation AS LONG)       AS STRING
      '------------------------------------------------------------------------------
      '
      '
      FUNCTION GetIniFileName (BYVAL sCompany AS STRING, BYVAL sTitle AS STRING, WhichLocation AS LONG) AS STRING
      ' ---------------------------------------------
      ' NEW APPROVED LOCATION INI FILE NAME
      ' On first call, it insures the folder exists,
      ' although not the INI file itself. 
      ' (The INI functions handle that) 
      ' ---------------------------------------------
          LOCAL ApprovedLocation  AS LONG
          LOCAL szApprovedPath    AS ASCIIZ * %MAX_PATH
          LOCAL szSubFolder       AS ASCIIZ * 64
          LOCAL iRet              AS LONG
          LOCAL sUPath            AS STRING
       
          sCompany                = RTRIM$(sCompany,ANY "\/")             'No trailing slashes
          sTitle                  = RTRIM$(sTitle, ANY "\/")              'No trailing slashes
          szSubFolder             = sCompany & "\" & sTitle               'Company/Application Unique Names
          '
          '---Determine whether to use Applicaion or User foler---
          '                        
          IF WhichLocation        = 0 THEN
             ApprovedLocation     = %CSIDL_COMMON_APPDATA
          ELSE                    
             ApprovedLocation     = %CSIDL_APPDATA
          END IF
          ' 
          '---Get the approved base path (folder name); force creation if necessary---
          '
          iRet = SHGETFOLDERPATH (BYVAL %NULL,_
                                 (ApprovedLocation OR %CSIDL_FLAG_CREATE), _
                                 -1&, _
                                 %SHGFP_TYPE_CURRENT ,_
                                 szApprovedPath)
          IF iRet <> %S_OK THEN
              MSGBOX IIF$(iRet = %S_FALSE, "S_FALSE", "E_INVALIDARG")     'Remove MSGBOX for silent mode
              FUNCTION = ""                                               'Return null
          END IF
          '
          '---Set up full path to new location if subfolders specified
          '
          szApprovedPath = szApprovedPath & "\" & szSubFolder
          '
          '---Make sure the directory exists
          '---ShCreateDirectory handles all the intermediate nodes, MKDIR does not.
          '---ShCreateDirectory requires UNICODE string for path
          '
          sUPath  =  UCODE$ (szApprovedPath) & $NUL & $NUL   ' add Unicode termination
          iRet    =  ShCreateDirectory (BYVAL %NULL, BYVAL STRPTR(sUpath))  'param 1 - hWnd, may be null
          SELECT CASE AS LONG iRet
              CASE %ERROR_SUCCESS, %ERROR_FILE_EXISTS, %ERROR_ALREADY_EXISTS
                  iRet = 0                                                'we don't care
              CASE ELSE
                  ' returning error_bad_pathname (161) WHEN YOU FORGET TO MAKE THE PATH UNICODE!
                  MSGBOX USING$ ("Could not create Folder '&' for INI file, Error # ", szapprovedPath, iRet)
          END SELECT
          FUNCTION = szApprovedPath                                       'Physical Folder/Path name
      END FUNCTION
      '
      '
      '
      '
      FUNCTION PBMAIN() AS LONG
      '======================================================================================================
      'Test Code to return and create (if nonexistent) a 'Company/Application' path and a user specific path
      '------------------------------------------------------------------------------------------------------
          LOCAL sCompany AS STRING
          LOCAL sTitle   AS STRING
          LOCAL aResult  AS STRING
          LOCAL uResult  AS STRING
          '
          '---Change Values below for your company and application names
          '
          sCompany = "MyCompanyName"
          sTitle   = "MyApplicationName"
          aResult = GetIniFileName(sCompany, sTitle, %AppFolder)
          uResult = GetIniFileName(sCompany, sTitle, %UserFolder) 
          '
          MSGBOX aResult & $CRLF & uResult 
      END FUNCTION

      [This message has been edited by Joe Byrne (edited May 10, 2007).]
      Software makes Hardware Happen

      Comment


      • #4
        Updated version 3/7/08. See comments
        Code:
        ' NAME: inifile_access.bas
        ' PURPOSE: Get the name of a UAc-Compiliant application "INI"  configuration file, creating
        ' any required sub-folders needed
        
        ' USAGE:
        ' Very simple. Every time you need your application's INI file name for a read or write,
        ' you just call "GetIniFileName". The first time the function is called, it will make sure
        ' the needed folder exists.
        ' Author: Michael Mattias Tal Systems Inc Racine WI  March 7 2008
        ' Usage:  PLaced in public domain by author
        ' Compiler used: PB/Windows v 8.03. Should work on Anything PB 5+
        ' ----------------------------------------------------------------
        ' This program should run on anything Windows/95 or better. Prior example earlier in this
        ' thread required at least Windows/2000 with SHELL32.DLL version 5.0 or greater.
        
        ' THis program uses ShGetFolderPath, which does not support ALL the "CSIDL_xxx" values
        ' supported by the 'updated' function ShGetSpecialFolderPath. It does however
        ' support the most likely locations for INI files:
        '
        ' CSIDL_APPDATA         (user specific)
        ' and
        ' CSIDL_COMMON_APPDATA  (shared by all users)
        
        
        
        #COMPILE  EXE
        #DEBUG    ERROR ON
        #REGISTER NONE
        #DIM      ALL
        #TOOLS    OFF
        '=====[Windows API Header Files] ============================
        '  If you don't need all of the functionality supported by these APIs
        '  (and who does?), you can selectively turn off various modules by putting
        '  the following constants in your program BEFORE you #include "win32api.inc":
        '
        '  %NOGDI = 1     ' no GDI (Graphics Device Interface) functions
        '  %NOMMIDS = 1   ' no Multimedia ID definitions
        %NODGI   = 1
        %NOMMIDS = 1
        #INCLUDE "WIN32API.INC"   ' Feb 2005
        '==[End Windows API Header Files]============================
        
        
        #IF NOT %DEF(%SHGFP_TYPE_CURRENT)
          ' equates from shlobj.h not found in Win32API.INC
          %SHGFP_TYPE_CURRENT  = 0&    ' // current value for user, verify it exists
          %SHGFP_TYPE_DEFAULT  = 1&    ' // default value, may not exist
          DECLARE FUNCTION SHCreateDirectory LIB "SHELL32.DLL" ALIAS "SHCreateDirectory" _
            (BYVAL hwnd AS LONG, pszPath AS ASCIIZ) AS LONG
        #ENDIF
        
        ' ----------------------
        ' INI FILE CONSTANTS
        ' ----------------------
        ' -------------------------------------------------
        ' NEW APPROVED LOCATION INI FILE NAME and LOCATION
        ' --------------------------------------------------
        
        $INI_FILENAME    = "inifile_access.ini"
        %INI_FOLDER      = %CSIDL_COMMON_APPDATA      ' shared for all users
        $INI_FOLDER_LITERAL = "COMMON_APPDATA ; typically 'C:\Documents and Settings\All Users\Application Data'"
        
        ' use these equates for user-specific INI files:
        '%INI_FOLDER      = %CSIDL_APPDATA            ' current user only! (tested OK)
        '$INI_FOLDER_LITERAL = "APPDATA ; typically 'C:\Documents and Settings\username\Application Data'"
        
        ' ---------------------------------------------------------------------------------------
        '  NOTE THAT AFTER YOU RUN THIS DEMO THESE FOLDERS WILL HAVE BEEN CREATED ON YOUR SYSTEM
        '  AS SUBFOLDERS OF THE APPDATA or COMMON_APPDATA FOLDERS!!!
        ' ---------------------------------------------------------------------------------------
        
        $INI_SUBFOLDER   = "Tal Systems\First\Second\Third"    ' no leading or trailing backslashes here
        
        ' ------------------------------------------
        ' VERSION of GetIniFolderName which will
        ' avoid the need to use SHELL32.DLL v 5.0 or higher
        ' It will create the needed directory using CreateDirectory
        ' instead of ShCreateDirectory
        ' -----------------------------------------------
        FUNCTION GetIniFolderName () AS STRING
        
         STATIC bBeenHere AS LONG
         LOCAL szIniFolder AS ASCIIZ * %MAX_PATH
         LOCAL approvedLocation AS DWORD
         LOCAL szBaseFolder AS ASCIIZ * %MAX_PATH
         LOCAL iRet AS LONG, dwFlags AS DWORD
        
         LOCAL subFolder AS STRING, sfNode() AS STRING, nNode AS LONG, iNode AS LONG, iCreate AS LONG
         LOCAL LE AS LONG
        
         LOCAL sDIrTest AS STRING   ' what we will test
         LOCAL W32 AS WIN32_FIND_DATA, hSearch AS DWORD, szSearch AS ASCIIZ * %MAX_PATH
        
         ' always used,first or subsequent calls
         ApprovedLocation = %INI_FOLDER      ' the base folder's CSIDL
         dwFlags          = %SHGFP_TYPE_CURRENT   ' choices are _TYPE_CURRENT or +TYPE_DEFAULT ( user may move this folder temporarily)
        
        
         IF ISFALSE bBeenHere THEN    ' first call
             ' get the base folder name using ShGetFolderPath, which requires only SHFolder.DLL which should be available
             ' in NT4 or Win/95 minimum
             ' ShGetFolderpath only accepts a limited number of CSIDL equates,
             ' CSIDL_APPDATA and CSIDL_COMMON_APPDATA are both among the supported values
        
             iRet = ShGetFolderPath (BYVAL %NULL, _      ' hWnd, "typically null"
                                     (ApprovedLocation OR %CSIDL_FLAG_CREATE), _   ' (supoorted) CSIDL value
                                     BYVAL %NULL, _                                ' hTOken for security, null  = Default
                                     dwFlags, _                                    ' above
                                     szBaseFolder)
             IF iRet = %S_OK THEN
                 ' found
             ELSE
                 ' could be S_FALSE, folder CSIDL but folder does not exist
                 ' or E_INVALIDARG .
                 ' since we specified create we should never get S-\_FALSE, not to mention
                 ' that COMMON_APPDATA simply MUST exist
                 MSGBOX USING$ ("Can't find or create folder &", $INI_FOLDER_LITERAL),%MB_APPLMODAL OR %MB_ICONHAND, "INI File Error"
                 FUNCTION = ""
                 EXIT FUNCTION
             END IF
        
             ' now, does our SUBFOLDER exist?
             ' if not, create it
             subFolder = $INI_SUBFOLDER   ' format is "tal Systems\product[\version]  no leading or trailing slashes
        
             nNode =  PARSECOUNT (subFolder, "\")
             REDIM    sfNode (nNode-1)
             PARSE    subfolder, sfNode(), "\"
        
             sDirTest  = szBaseFolder
             szSearch  = szBaseFolder
        
             FOR iNode = LBOUND(sfnode,1) TO UBOUND (sfnode,1)
                 szSearch = szSearch & "\" & sfNOde (iNode)
                 hSearch  = FindFirstFile (szSearch, W32)
                 IF hSearch <> %INVALID_HANDLE_VALUE THEN
                     ' we found the file . IS it a directory?
                     ' or should I wait for the create to fail?
                    FindClose  hSearch   ' all good continue loop
                 ELSE
                     ' not found, we need to create this directory
                     iCreate = CreateDirectory (szSearch, BYVAL %NULL)
                     LE      = GetLastError()
                     IF ISFALSE iCreate THEN
                         MSGBOX "Can't create required Directory '&'" & $CRLF & "Err=" & FORMAT$(LE) & $CRLF _
                                 & " for INI file" , _
                                 %MB_APPLMODAL OR %MB_ICONHAND, _
                                 "INI File Error in File System"
                         FUNCTION = ""
                         EXIT FUNCTION
                     END IF
                 END IF
             NEXT   ' node of subfolder
        
             bBeenHere = %TRUE    ' so we don't do this each call.
        
         END IF   ' if bBeenHere (first call)
        
         '  build the folder name
         ' Get the base folder....
           iRet = ShGetFolderPath (BYVAL %NULL, _      ' hWnd, "typically null"
                                     (ApprovedLocation), _   ' (supoorted) CSIDL value We don't need create here
                                     BYVAL %NULL, _                                ' hTOken for security, null  = Default
                                     dwFlags, _                                    ' above
                                     szBaseFolder)
            ' ... and append the subfolder and exit.
            FUNCTION = szBaseFolder & "\" & $INI_SUBFOLDER
        
        
        END FUNCTION  ' GetIniFolderName
        
        FUNCTION GetIniFileName () AS STRING
        
            LOCAL sFolder AS STRING
        
            sFolder     =   GetIniFolderName()
            IF sFolder  = "" THEN
                sFolder = CURDIR$
                MSGBOX   "Error getting INI file name" & $CRLF & USING$ ("will use '&' ", sFolder & "\" & $INI_FILENAME) , _
                         %MB_ICONHAND OR %MB_APPLMODAL, _
                         "INI File Error"
            END IF
        
            FUNCTION = sFolder & "\" & $INI_FILENAME
        
        END FUNCTION
        
        
        
        FUNCTION PBMAIN() AS LONG
        
         LOCAL szINi AS ASCIIZ * %MAX_PATH
         LOCAL szSection AS ASCIIZ * 64, szKey AS ASCIIZ * 64, szValue AS ASCIIZ * 64
         LOCAL z AS LONG, S AS STRING
         
          
        
         ' write out a  couple of keys to the approved INI file name
          szIni =  GetIniFileName()
          
          FOR Z = 1 TO 10
              
             IF Z < 6 THEN
                 szSection = "SECTIONONE"
                 
             ELSE
                 szSection = "SECTIONTWO"
             END IF
          
             SzKey =  IIF$ (Z<6, "SectionOneKey", "SectionTwoKey") & FORMAT$(Z)
             szValue   = "Value_" & FORMAT$(Z)
             
             WritePrivatePRofileString szSection, szKey, szValue, szIni
          NEXT
          
          ' read 'em back and put into a formatted string
          
          FOR Z = 1 TO 10
              IF Z < 6 THEN
                  szSection = "SECTIONONE"
              ELSE
                  szSection = "SECTIONTWO"
              END IF
              SzKey =  IIF$ (Z<6, "SectionOneKey", "SectionTwoKey") & FORMAT$(Z)
              
              GetPrivatePRofileString szSection, szKey, "DEFAULT_VALUE", szValue, SIZEOF(szValue), szINi
              
              S = S & USING$ ("Section &  Key &  Value &", szSection, szKey, szValue) & $CRLF
              
          NEXT
          
          MSGBOX S, %MB_ICONINFORMATION, USING$ ("Contents of '&'", szIni)
          
              
          
        END FUNCTION
        
        '--- END OF FILE ---
        MCM
        Michael Mattias
        Tal Systems (retired)
        Port Washington WI USA
        [email protected]
        http://www.talsystems.com

        Comment


        • #5
          Following code will build a valid ini filename, based on the exe name and his path, it will also save position info, etc.
          If the exe is in a UAC protected folders such as CSIDL_WINDOWS, CSIDL_PROGRAM_FILES or CSIDL_PROGRAM_FILESX86
          then a subFolder will be created in \ProgramData\ExeName\ to write the ini.

          Also, in the case of an exe on the desktop, no ini will be saved there, \ProgramData\ExeName\ will be used instead.

          GetWindowPlacement is used to save size, position dialog and MAXIMIZED state.

          After a Windows screen reconfiguration, on restart, the dialog will be replaced in a valid position if necessary to avoid off screen position.

          WriteProfileString & co. won't be used, ini file will be read and written to via PRINT# and LINE INPUT to avoid any restrictions.

          The older ShGetFolderPath functions calls are commented. They can be reused in a XP and older environnement.

          Because of their status, the two next APIs are not used...
          MSDN: SHGetFolderPath is deprecated.
          MSDN: ShGetSpecialFolderPath is not supported.

          Pierre

          Code:
           
          #COMPILE  EXE '#Win 8.04#
          #DIM ALL
          #REGISTER NONE
          #INCLUDE "Win32Api.inc"
          #INCLUDE "CommCtrl.inc"
          '#RESOURCE ".PBR"
           
          DECLARE FUNCTION SHGetKnownFolderPath LIB "Shell32.dll" ALIAS "SHGetKnownFolderPath" _
          (BYREF rfid AS GUID, BYVAL dwFlags AS DWORD, BYVAL hToken AS DWORD, pszPath AS ANY) AS LONG
           
          %KF_FLAG_SIMPLE_IDLIST = &H00000100
           
          GLOBAL hDlg AS DWORD
           
          $AppVer  = "1.0"
          $AppName = "IniReadSave"
           
          %Label1   = 101
          %Button1  = 201
          %Textbox1 = 301
          '______________________________________________________________________________
           
          FUNCTION ExeName(Action AS LONG) AS STRING 'Return the ExeName of this APP or ExeName of calling app if DLL
           LOCAL zFileName   AS ASCIIZ * %Max_Path
           LOCAL PathFileLen AS LONG
           LOCAL FileExtLen  AS LONG
           LOCAL DotPos      AS LONG
           LOCAL SlashPos    AS LONG
           
           PathFileLen = GetModuleFileName(0, zFileName, %Max_Path)
           SlashPos = INSTR(-1, zFileName, "\")
           DotPos = INSTR(-1, zFileName, ".")
           IF DotPos < SlashPos THEN DotPos = 0
           FileExtLen = PathFileLen - SlashPos
           
           SELECT CASE Action
           
             CASE 0 '"C:\Subdir\File.exe" - Path, FileName, Extention
               FUNCTION = LEFT$(zFileName, PathFileLen)
           
             CASE 1 'C:\Subdir\File - Path and filename (No Dot, no Extention)
               IF DotPos THEN
                 FUNCTION = LEFT$(zFileName, DotPos - 1)
               ELSE
                 FUNCTION = LEFT$(zFileName, PathFileLen)
               END IF
           
             CASE 2 'C:\Subdir\ - Path with last backslash (No FileName no Extention))
               FUNCTION = LEFT$(zFileName, SlashPos)
           
             CASE 3 'File.exe - Filename, Dot, Extention (No Path)
               FUNCTION = MID$(zFileName, SlashPos + 1, FileExtLen)
           
             CASE 4 'File - Filename only (No Path, no Dot, no Extention)
               IF DotPos THEN
                 FUNCTION = MID$(zFileName, SlashPos + 1, FileExtLen - (PathFileLen - DotPos) - 1)
               ELSE
                 FUNCTION = MID$(zFileName, SlashPos + 1, FileExtLen)
               END IF
           
             CASE 5 '.Ext - .Extention only (No Path, no File)
               IF DotPos THEN
                 FUNCTION = MID$(zFileName, DotPos, FileExtLen)
               END IF
           
           END SELECT
           
          END FUNCTION
          '______________________________________________________________________________
           
          FUNCTION FileExist(sFileName AS STRING) AS LONG
           LOCAL Attribute AS DWORD
           
           Attribute = GetFileAttributes(BYVAL STRPTR(sFileName))
           IF Attribute <> %INVALID_HANDLE_VALUE THEN
             IF (Attribute AND %FILE_ATTRIBUTE_DIRECTORY) THEN
               FUNCTION = %FILE_ATTRIBUTE_DIRECTORY
             ELSE
               FUNCTION = %TRUE
             END IF
           END IF
           
          END FUNCTION
          '______________________________________________________________________________
           
          FUNCTION FileIniNameGet() AS STRING
           LOCAL zPathExe           AS ASCIIZ * %MAX_PATH
           LOCAL zPathWindows       AS ASCIIZ * %MAX_PATH
           LOCAL zPathDesktop       AS ASCIIZ * %MAX_PATH
           LOCAL zPathProgramFiles  AS ASCIIZ * %MAX_PATH
           LOCAL zPathCommonAppData AS ASCIIZ * %MAX_PATH
           LOCAL UseCommonAppData   AS LONG
           LOCAL FileNo             AS LONG
           LOCAL ErrorNum           AS LONG
           LOCAL puFolder           AS DWORD
           LOCAL GuidFolder         AS GUID
           
           'UAC protection for the Windows since Vista use virtualisation to redirect
           'the write of ini file. One should avoid to write to the redirected VirtualStore
           'and use %CSIDL_COMMON_APPDATA or %CSIDL_APPDATA for user specific.
           
           'Example of a virtualized file when
           'trying to write to "C:\Program Files (x86)\pbwinspy\pbwinspy.ini" will write in fact to
           '"C:\Users\UserName\AppData\Local\VirtualStore\Program Files (x86)\pbwinspy\pbwinspy.ini"
           
           'No ini should be written to %CSIDL_WINDOWS, %CSIDL_PROGRAM_FILES or %CSIDL_PROGRAM_FILESX86.
           'If the ini is not under any UAC protected folder the no virtualisation will occur.
           
           '%CSIDL_WINDOWS          C:\Windows
           '%CSIDL_DESKTOP          C:\Users\"UserName"\Desktop
           '%CSIDL_COMMON_APPDATA   C:\ProgramData
           '%CSIDL_PROGRAM_FILES    C:\Program Files (x86) [OS64, App32]
           '%CSIDL_PROGRAM_FILES    C:\Program Files       [OS-bit = App-bit]
           '%CSIDL_PROGRAM_FILESX86 C:\Program Files (x86)
           
           zPathExe = ExeName(2)
           
           'Optional: Do not use desktop to save .ini
           'XP: ShGetFolderPath(BYVAL 0, %CSIDL_DESKTOP, BYVAL 0, BYVAL 0, zPathDesktop) 'ShGetFolderPath, the pre Vista way
           'XP: zPathProgramFiles = zPathProgramFiles & "\"
           GuidFolder = GUID$("{905e63b6-c1bf-494e-b29c-65b732d3d21a}") '$FOLDERID_ProgramFiles
           zPathDesktop = zPathDesktop & "\"
           IF LEFT$(zPathExe, LEN(zPathDesktop)) = zPathDesktop THEN 'In "\Desktop\" folder
             UseCommonAppData = %TRUE
           END IF
           
           'XP: ShGetFolderPath(BYVAL 0, %CSIDL_WINDOWS, BYVAL 0, BYVAL 0, zPathWindows) 'ShGetFolderPath, the pre Vista way
           'XP: zPathProgramFiles = zPathProgramFiles & "\"
           GuidFolder = GUID$("{F38BF404-1D43-42F2-9305-67DE0B28FC23}") '$FOLDERID_Windows
           GOSUB GetKnownFolderPath
           zPathWindows = zPathWindows & "\"
           IF LEFT$(zPathExe, LEN(zPathWindows)) = zPathWindows THEN 'In "\Windows\" folder
             UseCommonAppData = %TRUE
           END IF
           
           'XP: ShGetFolderPath(BYVAL 0, %CSIDL_PROGRAM_FILES, BYVAL 0, BYVAL 0, zPathProgramFiles), the pre Vista way
           'XP: zPathProgramFiles = zPathProgramFiles & "\"
           GuidFolder = GUID$("{905e63b6-c1bf-494e-b29c-65b732d3d21a}") '$FOLDERID_ProgramFiles
           GOSUB GetKnownFolderPath
           IF LEFT$(zPathExe, LEN(zPathProgramFiles)) = zPathProgramFiles THEN 'In "\Program Files[ (x86)]\" folder
             UseCommonAppData = %TRUE
           END IF
           IF RIGHT$(zPathProgramFiles, 7) = " (x86)\" THEN '32 bit app under 64 bit OS
             zPathProgramFiles = LEFT$(zPathProgramFiles, LEN(zPathProgramFiles) - 7) & "\"
             IF LEFT$(zPathExe, LEN(zPathProgramFiles)) = zPathProgramFiles THEN 'In "\Program Files\" folder
               UseCommonAppData = %TRUE
             END IF
           END IF
           
           IF UseCommonAppData = %FALSE THEN 'Is exe folder writable
             FileNo = FREEFILE
             ERRCLEAR
             OPEN zPathExe & "DeleteMe.txt" FOR OUTPUT AS FileNo
             ErrorNum = ERR
             IF ErrorNum THEN 'No write permission
                UseCommonAppData = %TRUE 'No write permission
             ELSE
               CLOSE FileNo
               KILL zPathExe & "DeleteMe.txt"
             END IF
           END IF
           
           'XP: ShGetFolderPath(BYVAL 0, %CSIDL_COMMON_APPDATA, BYVAL 0, BYVAL 0, zPathCommonAppData) 'C:\ProgramData\, the pre Vista way
           'XP: zPathProgramFiles = zPathProgramFiles & "\"
           GuidFolder = GUID$("{62AB5D82-FDC1-4DC3-A9DD-070D1D495D97}") '$FOLDERID_ProgramData
           GOSUB GetKnownFolderPath
           IF UseCommonAppData THEN
             zPathCommonAppData = zPathCommonAppData & ExeName(4) & "\"
             IF FileExist(BYCOPY zPathCommonAppData) <> %FILE_ATTRIBUTE_DIRECTORY THEN
               CreateDirectory(zPathCommonAppData, BYVAL %NULL)
             END IF
             FUNCTION = zPathCommonAppData & ExeName(4) & ".ini"
           ELSE
             FUNCTION = ExeName(1) & ".ini"
           END IF
           
           EXIT FUNCTION '--------------------------------------------------------------
           
           GetKnownFolderPath:
           SHGetKnownFolderPath(BYVAL VARPTR(GuidFolder), %KF_FLAG_SIMPLE_IDLIST, %NULL, puFolder)
           zPathDesktop = ACODE$(PEEK$(puFolder, 2 * LStrlenW(BYVAL puFolder)))
           CoTaskMemFree(BYVAL puFolder)
           zPathDesktop = zPathDesktop & "\"
           RETURN
           
          END FUNCTION
          '______________________________________________________________________________
           
          FUNCTION FileIniSave() AS LONG
           LOCAL WinPla    AS WINDOWPLACEMENT
           LOCAL sFileName AS STRING
           LOCAL FileNo    AS LONG
           
           WinPla.Length = SIZEOF(WinPla)
           GetWindowPlacement(hDlg, WinPla)
           sFileName = FileIniNameGet()
           FileNo    = FREEFILE
           ERRCLEAR
           OPEN sFileName FOR OUTPUT AS FileNo
           IF ERR = %FALSE THEN
             PRINT # FileNo, "[Dialog]"
             PRINT # FileNo, "Left      =" & STR$(WinPla.rcNormalPosition.nLeft)
             PRINT # FileNo, "Right     =" & STR$(WinPla.rcNormalPosition.nRight)
             PRINT # FileNo, "Top       =" & STR$(WinPla.rcNormalPosition.nTop)
             PRINT # FileNo, "Bottom    =" & STR$(WinPla.rcNormalPosition.nBottom)
             PRINT # FileNo, "Maximized =" & STR$(WinPla.showCmd = %SW_SHOWMAXIMIZED)
             PRINT # FileNo, ""
             PRINT # FileNo, "[MyParam]"
             PRINT # FileNo, "Something =" & STR$(123)
             CLOSE FileNo
           END IF
           
          END FUNCTION
          '______________________________________________________________________________
           
          FUNCTION FileIniRead() AS LONG 'Restore previous coordinates.
           LOCAL WinPla       AS WINDOWPLACEMENT
           LOCAL rcDeskTop    AS RECT
           LOCAL sBuffer      AS STRING
           LOCAL sFileName    AS STRING
           LOCAL sDescription AS STRING
           LOCAL sData        AS STRING
           LOCAL sSection     AS STRING
           LOCAL FileNo       AS LONG
           LOCAL CharVal      AS LONG
           LOCAL CharPos      AS LONG
           
           sFileName = FileIniNameGet()
           FileNo = FREEFILE
           ERRCLEAR
           OPEN sFileName FOR INPUT AS FileNo
           
           IF ERR = %ERR_NOERROR THEN
             DO UNTIL EOF(FileNo)
               LINE INPUT #FileNo, sBuffer
               sBuffer = TRIM$(sBuffer)
               CharVal = ASC(sBuffer)
               IF CharVal = 91 THEN 'Left bracket -> [Section]
                 CharPos = INSTR(sBuffer, "]")
                 IF CharPos THEN
                   sSection = LCASE$(LEFT$(sBuffer, CharPos)) 'Brackets included
                 END IF
               ELSEIF CharVal = 59 THEN ';Remed line
               ELSEIF CharVal = 39 THEN ''Remed line
               ELSE
                 CharPos = INSTR(sBuffer, "=") 'sDescription = sData
                 IF CharPos THEN
                   sDescription = LCASE$(RTRIM$(LEFT$(sBuffer, CharPos - 1)))
                   sData = LTRIM$(MID$(sBuffer, CharPos + 1))
                   SELECT CASE sSection
                   'Put sSection and sDescription in minus in this function, sData will be read as is.
                     CASE "[dialog]"
                       SELECT CASE sDescription
                         CASE "left"      : WinPla.rcNormalPosition.nLeft   = VAL(sData)
                         CASE "right"     : WinPla.rcNormalPosition.nRight  = VAL(sData)
                         CASE "top"       : WinPla.rcNormalPosition.nTop    = VAL(sData)
                         CASE "bottom"    : WinPla.rcNormalPosition.nBottom = VAL(sData)
                         CASE "maximized" : WinPla.showCmd = IIF(VAL(sData),%SW_SHOWMAXIMIZED, %SW_SHOWNORMAL)
                       END SELECT
                     CASE "[myparam]"
                       SELECT CASE sDescription
                         CASE "something"  : CharVal = VAL(sData)
                     END SELECT
                   END SELECT
                 END IF
               END IF
             LOOP
             CLOSE FileNo
           
             SystemParametersInfo(%SPI_GETWORKAREA, 0, BYVAL VARPTR(rcDesktop), 0) 'Desktop size minus taskbar, thanks to Börje
           
             'Screen resolution may have changed so make sure dialog is not horizontally oversized.
             IF WinPla.rcNormalPosition.nRight - WinPla.rcNormalPosition.nLeft > rcDesktop.nRight THEN
               WinPla.rcNormalPosition.nLeft  = 0
               WinPla.rcNormalPosition.nRight = rcDesktop.nRight
             END IF
           
             'Screen resolution may have changed so make sure dialog is not vertically oversized.
             IF WinPla.rcNormalPosition.nBottom - WinPla.rcNormalPosition.nTop > rcDesktop.nBottom THEN
               WinPla.rcNormalPosition.nTop    = 0
               WinPla.rcNormalPosition.nBottom = rcDesktop.nBottom
             END IF
           
             'Make sure left side of dialog is visible. (Optionnal)
             IF WinPla.rcNormalPosition.nLeft < 0 THEN
               WinPla.rcNormalPosition.nRight = WinPla.rcNormalPosition.nRight - WinPla.rcNormalPosition.nLeft
               WinPla.rcNormalPosition.nLeft = 0
             END IF
           
             'Make sure right side of dialog is visible. (Optionnal)
             IF WinPla.rcNormalPosition.nRight > rcDesktop.nRight THEN
               WinPla.rcNormalPosition.nLeft = WinPla.rcNormalPosition.nLeft - (WinPla.rcNormalPosition.nRight - rcDesktop.nRight)
               WinPla.rcNormalPosition.nRight = rcDesktop.nRight
             END IF
           
             'Make sure bottom side of dialog is visible. (Optionnal)
             IF WinPla.rcNormalPosition.nBottom > rcDesktop.nBottom THEN
               WinPla.rcNormalPosition.nTop = WinPla.rcNormalPosition.nTop - (WinPla.rcNormalPosition.nBottom - rcDesktop.nBottom)
               WinPla.rcNormalPosition.nBottom = rcDesktop.nBottom
             END IF
           
             'Make sure top side of dialog is visible. (Optionnal)
             IF WinPla.rcNormalPosition.nTop < 0 THEN
               WinPla.rcNormalPosition.nBottom = WinPla.rcNormalPosition.nBottom - WinPla.rcNormalPosition.nTop
               WinPla.rcNormalPosition.nTop = 0
             END IF
           
             WinPla.Length = SIZEOF(WinPla)
             SetWindowPlacement(hDlg, WinPla)
           
           END IF
           
          END FUNCTION
          '______________________________________________________________________________
           
          CALLBACK FUNCTION DlgProc
           
           SELECT CASE CBMSG
           
             CASE %WM_INITDIALOG
               FileIniRead()
               CONTROL SET TEXT hDlg, %Textbox1, FileIniNameGet()
           
             CASE %WM_CLOSE
               FileIniSave()
           
             CASE %WM_COMMAND
               SELECT CASE LOWRD(CBWPARAM)
                 CASE %Button1
                   IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1  THEN
                     MessageBox(hDlg, FileIniNameGet(), $AppName & " - FileIniNameGet", %MB_ICONINFORMATION OR %MB_OK OR %MB_TOPMOST)
                   END IF
               END SELECT
           
             CASE %WM_SIZE 'Dialog size have changed
               LOCAL ClientSizeX AS LONG
               LOCAL ClientSizeY AS LONG
               IF CBWPARAM <> %SIZE_MINIMIZED THEN
                 ClientSizeX = LO(WORD, CBLPARAM)
                 ClientSizeY = HI(WORD, CBLPARAM)
                 SetWindowPos(GetDlgItem(hDlg, %Label1),   0, 15, 10, ClientSizeX - 30, 20, %SWP_NOZORDER OR %SWP_NOMOVE)
                 SetWindowPos(GetDlgItem(hDlg, %Textbox1), 0, 15, 30, ClientSizeX - 30, 20, %SWP_NOZORDER OR %SWP_NOMOVE)
                 SetWindowPos(GetDlgItem(hDlg, %Button1),  0, ClientSizeX / 2  - 105, 70, ClientSizeX - 30, 30, %SWP_NOZORDER OR %SWP_NOSIZE)
               END IF
           
            END SELECT
           
          END FUNCTION
          '______________________________________________________________________________
           
          FUNCTION PBMAIN()
           
           DIALOG FONT "Segoe UI", 9
           DIALOG NEW %HWND_DESKTOP ,"ini read & save", , , 200, 100, _
           %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR %WS_CAPTION OR _
           %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR _
           %WS_MAXIMIZEBOX, %WS_EX_WINDOWEDGE TO hDlg
           
           SetClassLong hDlg, %GCL_HICON, LoadIcon(BYVAL %NULL, BYVAL %IDI_INFORMATION)
           
           CONTROL ADD LABEL,   hDlg, %Label1,   "Size or maximize dialog, close and restart...", 5, 5, 140, 10
           CONTROL ADD TEXTBOX, hDlg, %Textbox1, "text", 5, 20, 140, 10
           CONTROL ADD BUTTON,  hDlg, %Button1,  "FileIniNameGet()", 5, 40, 140, 15
           
           DIALOG SHOW MODAL hDlg CALL DlgProc
           
          END FUNCTION
          '______________________________________________________________________________
          '

          Comment


          • #6
            If all you need is to get CommonProgramData and create a folder tree inside it to put your ini file then the following will do.
            Code is using the recommended SHGetKnownFolderPath. ;-)

            Pierre

            Code:
             
            #COMPILE  EXE '#Win 8.04#
            #DIM      ALL
            #INCLUDE "Win32Api.inc"
             
            %KF_FLAG_SIMPLE_IDLIST = &H00000100
             
            DECLARE FUNCTION SHGetKnownFolderPath LIB "Shell32.dll" ALIAS "SHGetKnownFolderPath" _
            (BYREF rfid AS GUID, BYVAL dwFlags AS DWORD, BYVAL hToken AS DWORD, pszPath AS ANY) AS LONG
             
            DECLARE FUNCTION MakeSureDirectoryPathExists LIB "DbgHelp.dll" _
            ALIAS "MakeSureDirectoryPathExists"(zPath AS ASCIIZ) AS LONG
             
            $Corporation = "MyCorporation"
            $Application = "MyApplication"
            $MyVersion   = "1.0"
            '_____________________________________________________________________________
             
            FUNCTION IniFolderNameSet() AS STRING
             LOCAL zIniFolder           AS ASCIIZ * %MAX_PATH
             LOCAL zCommonAppDataFolder AS ASCIIZ * %MAX_PATH
             LOCAL GuidFolder           AS GUID
             LOCAL puFolder             AS DWORD
             
             GuidFolder = GUID$("{62AB5D82-FDC1-4DC3-A9DD-070D1D495D97}") '$FOLDERID_ProgramData, often "C:\ProgramData\"
             SHGetKnownFolderPath(BYVAL VARPTR(GuidFolder), %KF_FLAG_SIMPLE_IDLIST, %NULL, puFolder) 'Get ProgramData folder
             zCommonAppDataFolder = ACODE$(PEEK$(puFolder, 2 * LStrlenW(BYVAL puFolder))) 'Convert wString to ASCIIZ
             CoTaskMemFree(BYVAL puFolder) 'Free memory
             zIniFolder = zCommonAppDataFolder & "\" & $Corporation & "\" & $Application & "\" & $MyVersion & "\"
             MakeSureDirectoryPathExists(zIniFolder) 'Create all needed folders, example: "C:\ProgramData\MyCorporation\MyApplication\1.0\"
             FUNCTION = zIniFolder
             
            END FUNCTION
            '_____________________________________________________________________________
             
            FUNCTION IniFileNameGet () AS STRING
             LOCAL zIniFileName  AS ASCIIZ * %MAX_PATH
             
             GetModuleFileName(BYVAL 0, zIniFileName, %MAX_PATH) 'Example: "C:\Basic\Tmp05.exe"
             zIniFileName = LEFT$(RIGHT$(zIniFileName, - INSTR(-1, zIniFileName, "\")), -3) & "ini" 'Result example: "Tmp05.ini"
             FUNCTION = IniFolderNameSet() & zIniFileName 'Example: "C:\ProgramData\MyCorporation\MyApplication\1.0\Tmp05.ini"
             
            END FUNCTION
            '_____________________________________________________________________________
             
            FUNCTION PBMAIN() AS LONG
             LOCAL zIniFileName AS ASCIIZ * %MAX_PATH
             LOCAL zSection     AS ASCIIZ * 64
             LOCAL zKey         AS ASCIIZ * 64
             LOCAL zValue       AS ASCIIZ * 64
             
             zIniFileName =  IniFileNameGet()
             zSection     = "SectionIni"
             zKey         = "Success"
             zValue       = "TRUE"
             
             WritePrivateProfileString(zSection, zKey, zValue, zIniFileName)
             zValue = "" 'Validate the following read
             GetPrivateProfileString(zSection, zKey, "DefaultValue", zValue, SIZEOF(zValue), zIniFileName)
             
             IF MessageBox(%HWND_DESKTOP, "Ini file name: " & zIniFileName & $CRLF & $CRLF & _
                           zSection & ": " & zKey & " = " & zValue & $CRLF & $CRLF & _
                           "View the ini folder?", _
                           "Ini fileName get", %MB_ICONINFORMATION OR %MB_YESNO OR %MB_TOPMOST) = %IDYES THEN
                ShellExecute(%HWND_DESKTOP, "explore", LEFT$(zIniFileName, _
                             INSTR(-1, zIniFileName, "\")), "", "", %SW_SHOWNORMAL)
             END IF
             
            END FUNCTION
            '_____________________________________________________________________________
            '

            Comment


            • #7
              This was my first code for control of INI files, still in the time of TB11. It was no wonder but it worked like a charm!
              I hope it's not seen as off-topic!
              Code:
              DEF FN LTRIM$(Arg$)
              ' remove the spaces from the beginning of the string
               DO WHILE LEFT$(Arg$,1%) = " "
                 Arg$ = RIGHT$(Arg$,LEN(Arg$) - 1%)
               LOOP
               FN LTRIM$ = Arg$
              END DEF 'Ltrim$
              
              '// --------------------------------------------------------------------------
              '// --------------------------------------------------------------------------
              
              DEF FN RTRIM$(Arg$)
              ' remove spaces at the end of the string
               DO WHILE RIGHT$(Arg$,1%) = " "
                 Arg$ = LEFT$(Arg$,LEN(Arg$) - 1%)
               LOOP
               FN RTRIM$ = Arg$
              END DEF 'Rtrim$
              
              '// --------------------------------------------------------------------------
              '// --------------------------------------------------------------------------
              
              SUB WritesIniFile
               SHARED INIFILE$, EXEFILE$, ININAME$, VERSION$, PathEnvironment$
               SHARED LAYERP$, LAYERN$, LAYERC$, BufIni%
               PRINT #BufIni%, "; ---------------------------------------------------------------------------"
               IF PathEnvironment$ <> "" THEN
                 PRINT #BufIni%, "; This file was created with the following system environment:"
                 PRINT #BufIni%, ";   SET " ININAME$ "=" PathEnvironment$
                 PRINT #BufIni%, "; This is a configuration file for the program " EXEFILE$ " version " VERSION$
               ELSE
                 PRINT #BufIni%, "; File " INIFILE$
                 PRINT #BufIni%, "; Setting for the program " EXEFILE$ " version " VERSION$
               END IF
               PRINT #BufIni%, "; ---------------------------------------------------------------------------"
               PRINT #BufIni%, "; Lines started with semicolons ';' are comments."
               PRINT #BufIni%, "; Blank lines, too."
               PRINT #BufIni%, "; Each group of this file begins and ends with the characters '[' and ']',"
               PRINT #BufIni%, "; respectively. It is mandatory to use! The character '[' must be in"
               PRINT #BufIni%, "; first position of the line."
               PRINT #BufIni%, "; The following six groups are defined, treating the characteristics"
               PRINT #BufIni%, "; specific to each one of them:"
               PRINT #BufIni%, ";       [theodolite]"
               PRINT #BufIni%, ";       [geodimeter]"
               PRINT #BufIni%, ";       [prism]"
               PRINT #BufIni%, ";       [ellipsoid]"
               PRINT #BufIni%, ";       [autocad]"
               PRINT #BufIni%, ";       [company]"
               PRINT #BufIni%, "; ---------------------------------------------------------------------------"
               PRINT #BufIni%, "; Note: Do not use any of the signs of accentuation of the Portuguese"
               PRINT #BufIni%, "; language in the orthography of the groups or their items. Words can be"
               PRINT #BufIni%, "; accented only on the lines of comment, as you see here. This fact is due to"
               PRINT #Bufini%, "; differences between the code pages currently in use."
               PRINT #BufIni%, "; ---------------------------------------------------------------------------"
               PRINT #BufIni%, ""
               PRINT #BufIni%, ""
               PRINT #BufIni%, "[theodolite]"
               PRINT #BufIni%, "BrandModel = Wild T16"
               PRINT #BufIni%, "VerticalType = Zenithal"
               PRINT #BufIni%, ";       As few as theodolites with Zenithal or Nadiral circles can be used."
               PRINT #BufIni%, ";       A program for use with another type theodolite vertical circle "
               PRINT #BufIni%, ";       can be provided. See! "
               PRINT #BufIni%, ";----------------------------------------------------------------------------"
               PRINT #BufIni%, ""
               PRINT #BufIni%, ""
               PRINT #BufIni%, "[geodimeter]"
               PRINT #BufIni%, "BrandModel = AGA 116"
               PRINT #BufIni%, "EccentricMounting = Yes"
               PRINT #BufIni%, "HeightAboveTheodolite = 0.114"
               PRINT #BufIni%, ";       The geodímeter is an eccentric when your vertical axis does not"
               PRINT #BufIni%, ";       coincide with the theodolite to all positions of this scope. "
               PRINT #BufIni%, ";       For corrections of eccentricity are made, it is necessary that"
               PRINT #BufIni%, ";       the Eccentric mount option is equal to Yes."
               PRINT #BufIni%, "AtmosphericPressure = 760.0"
               PRINT #BufIni%, "AverageAltitude = 0.0"
               PRINT #BufIni%, "AirTemperature = 20.0"
               PRINT #BufIni%, "DoAtmosphericCorrection = No"
               PRINT #BufIni%, ";       The determination of atmospheric pressure requires the use of a "
               PRINT #BufIni%, ";       barometer or Altimeter of type Paulin. As the use of any of these"
               PRINT #BufIni%, ";       requires certain care, it becomes easier to estimate air temperature"
               PRINT #BufIni%, ";       and provide the average elevation for the program, then calculate"
               PRINT #BufIni%, ";       the approximate value of the atmospheric pressure and then the"
               PRINT #BufIni%, ";       atmospheric corrections due, in ppm (parts per million). The value "
               PRINT #BufIni%, ";       of average altitude will not be taken into account if the"
               PRINT #BufIni%, ";       atmospheric pressure is provided. To avoid DOUBLE correction (one"
               PRINT #BufIni%, ";       for the geodímeter and another by the program), only use the"
               PRINT #BufIni%, ";       atmospheric correction of the program IF all measures of distance "
               PRINT #BufIni%, ";       were made with the button of geodímeter PPM placed in the mark"
               PRINT #BufIni%, ";       of ZERO.
               PRINT #BufIni%, ";----------------------------------------------------------------------------"
               PRINT #BufIni%, ""
               PRINT #BufIni%, ""
               PRINT #BufIni%, "[prism]"
               PRINT #BufIni%, "PrismConstant = 0.0"
               PRINT #BufIni%, ";       If the geodímeter do prism correction internally, as usual, put ZERO"
               PRINT #BufIni%, ";       in the constant Of Prism above. If this is not the case, put the"
               PRINT #BufIni%, ";       value of the constant of Prism which is always negative and expressed"
               PRINT #BufIni%, ";       in meters. He will be added algebraically to all distances measured."
               PRINT #BufIni%, ";       Its value is supplied by the manufacturer and refers to the path that"
               PRINT #BufIni%, ";       the infrared light makes within the Prism. The prisms may have"
               PRINT #BufIni%, ";       different constants depending on the manufacturer. Those provided by"
               PRINT #BufIni%, ";       AGA are -0.03m; the of Zeiss and Citation of -0.04m; the Kern of"
               PRINT #BufIni%, ";       -0.07m. If you rent the equipment and not sure geodímeter be using"
               PRINT #BufIni%, ";       proper Prism correction, do a test measure and determine whether it"
               PRINT #BufIni%, ";       is necessary to add some value to the Prism constant correction above."
               PRINT #BufIni%, ";       Example, if miss subtract 1 cm every distance place -0.01; If instead"
               PRINT #BufIni%, ";       it is necessary to add 1 cm, put 0.01m."
               PRINT #BufIni%, "EccentricMounting = No"
               PRINT #BufIni%, "HeightAboveSign = 0.114"
               PRINT #BufIni%, ";       Eccentric mounting equal as No, assumes that the prism and the sign"
               PRINT #BufIni%, ";       are fixed, or type of movement without eccentricity, which maintains"
               PRINT #BufIni%, ";       the same vertical even if some inclination on the prism to facilitate"
               PRINT #BufIni%, ";       very steep steps. In the case of geodímeters AGA, the 0+ key should"
               PRINT #BufIni%, ";       always be on 0 and never in +."
               PRINT #BufIni%, ";----------------------------------------------------------------------------"
               PRINT #BufIni%, ""
               PRINT #BufIni%, ""
               PRINT #BufIni%, "[ellipsoid]"
               PRINT #BufIni%, "SemiMajorAxis = 6378160.0"
               PRINT #BufIni%, "FlatteningModule = 298.25"
               PRINT #BufIni%, ";       The above values are the reference ellipsoid SAD-69, adopted by IBGE"
               PRINT #BufIni%, ";       since 1977, valid for all Brazil. The Semi major axis is expressed in"
               PRINT #BufIni%, ";       meters and the Flattening module in parts of this."
               PRINT #BufIni%, "LatitudePlaceMedia = -23.5"
               PRINT #BufIni%, ";       The value above is valid for the State of São Paulo and must be in"
               PRINT #BufIni%, ";       decimal degrees. Its value is negative in the southern hemisphere."
               PRINT #BufIni%, ";----------------------------------------------------------------------------"
               PRINT #BufIni%, ""
               PRINT #BufIni%, ""
               PRINT #BufIni%, "[autocad]"
               PRINT #BufIni%, "LayerPoints = " LAYERP$
               PRINT #BufIni%, ";       Layer where are plotted the X, Y coordinates of the points."
               PRINT #BufIni%, "LayerNumbers = " LAYERN$
               PRINT #BufIni%, ";       Layer where the numbers of the points are plotted, the X, Y"
               PRINT #BufIni%, ";       coordinates of each point."
               PRINT #BufIni%, "LayerDimensions = " LAYERD$
               PRINT #BufIni%, ";       Layer where dimensions numbers are plotted in the X, Y coordinates of"
               PRINT #BufIni%, ";       each point."
               PRINT #BufIni%, ";----------------------------------------------------------------------------"
               PRINT #BufIni%, ""
               PRINT #BufIni%, ""
               PRINT #BufIni%, "[company]"
               PRINT #BufIni%, "Text1 ="
               PRINT #BufIni%, "Text2 ="
               PRINT #BufIni%, "Text3 ="
               PRINT #BufIni%, ";       Place the necessary IDs on the service, work, etc."
               PRINT #BufIni%, ";----------------------------------------------------------------------------"
               PRINT #BufIni%, ""
               PRINT #BufIni%, ""
              END SUB 'WritesIniFile
              
              '// --------------------------------------------------------------------------
              '// --------------------------------------------------------------------------
              
              SUB GetIniParameters
              ' separates the items, subitems, and subtexts of the line read from ini file
               SHARED Group%, Group$, GroupItem%, GroupItem$, TextItem%, TextItem$
               SHARED EndOfFile%, IniLine$
               LOCAL  EqualSign%, OpenBrackets%, CloseBrackets%
                   Group% = %FALSE :     Group$ = ""
               GroupItem% = %FALSE : GroupItem$ = ""
                TextItem% = %FALSE :  TextItem$ = ""
               CALL GetIniLine
               IF EndOfFile% THEN EXIT SUB
               OpenBrackets%  = INSTR(IniLine$,"[")
               CloseBrackets% = INSTR(IniLine$,"]")
               EqualSign% = INSTR(IniLine$,"=")
               IF OpenBrackets% <> 0% AND CloseBrackets% <> 0% AND CloseBrackets% > OpenBrackets% AND NOT EqualSign% THEN
                 Group$ = FN LTRIM$(FN RTRIM$(MID$(IniLine$, OpenBrackets% + 1%, CloseBrackets% - OpenBrackets% - 1%)))
                 IF Group$ <> "" THEN Group% = %TRUE
               ELSEIF EqualSign% <> 0% AND NOT (CloseBrackets% OR OpenBrackets%) THEN
                 GroupItem$ = FN LTRIM$(FN RTRIM$( LEFT$(IniLine$, EqualSign% - 1%)))
                  TextItem$ = FN LTRIM$(FN RTRIM$(RIGHT$(IniLine$, LEN(IniLine$) - EqualSign%)))
                 IF GroupItem$ <> "" THEN GroupItem% = %TRUE
                 IF  TextItem$ <> "" THEN  TextItem% = %TRUE
               END IF
               EXIT SUB
              END SUB 'GetIniParameters
              
              '// --------------------------------------------------------------------------
              '// --------------------------------------------------------------------------
              
              SUB GetIniLine
              ' reads a line from the .ini configuration file
               SHARED Text$, EndOfFile%, IniLine$, BufIni%
               LOCAL Tmp$
               ReadAnotherIniLine:
               IF EOF(BufIni%) THEN EndOfFile% = %TRUE: EXIT SUB
               LINE INPUT #BufIni%, Text$
               IF Text$ = "" OR LEFT$(Text$,1) = ";" THEN ReadAnotherIniLine
               Tmp$ = FN LTRIM$(Text$)
               IF Tmp$ = "" THEN ReadAnotherIniLine
               IniLine$ = UCASE$(Tmp$)
              END SUB 'GetIniLine
              
              '// --------------------------------------------------------------------------
              '// --------------------------------------------------------------------------
              
              SUB SolvesIni
              ' resolves the reading of values of the ini file
               LOCAL Theodolite%, Geodimeter%, Prism%, Ellipsoid%, AutoCAD%, Company%, Terminating%
               SHARED EndOfFile%
               SHARED ABORTSEXEC$, MORETHANONE$, INIFILE$
               SHARED Group%, Group$, GroupItem%, GroupItem$, TextItem%, TextItem$, CurrentGroup$
               SHARED Theodolite.BrandModel$
               SHARED Theodolite.VerticalType$
               SHARED Geodimeter.BrandModel$
               SHARED Geodimeter.EccentricMounting$
               SHARED Geodimeter.HeightAboveTheodolite$
               SHARED Geodimeter.AtmosphericPressure$
               SHARED Geodimeter.AverageAltitude$
               SHARED Geodimeter.AirTemperature$
               SHARED Geodimeter.DoAtmosphericCorrection$
               SHARED      Prism.PrismConstant$
               SHARED      Prism.EccentricMounting$
               SHARED      Prism.HeightAboveSign$
               SHARED  Ellipsoid.SemiMajorAxis$
               SHARED  Ellipsoid.FlatteningModule$
               SHARED  Ellipsoid.LatitudePlaceMedia$
               SHARED    AutoCAD.LayerPoints$
               SHARED    AutoCAD.LayerNumbers$
               SHARED    AutoCAD.LayerDimensions$
               SHARED    Company.Text1$
               SHARED    Company.Text2$
               SHARED    Company.Text3$
              
               Theodolite% = %FALSE
               Geodimeter% = %FALSE
                    Prism% = %FALSE
                Ellipsoid% = %FALSE
                  AutoCAD% = %FALSE
                  Company% = %FALSE
              
               DO UNTIL Theodolite% AND Geodimeter% AND Prism% AND Ellipsoid% AND AutoCAD% AND Company%
                 CALL GetIniParameters
                 IF EndOfFile% THEN ERROR 62%
              
                 SELECT CASE Group$
              
                   CASE "THEODOLITE"
                     IF Theodolite% THEN PRINT: PRINT MORETHANONE$ Group$: PRINT ABORTSEXEC$: STOP
                     Terminating% = 0%
                     CurrentGroup$ = Group$
                     '----------------------------fedcba9876543210
                     DO UNTIL (Terminating% AND &B0000000000000011) = 3%        ' 2^1 + 2^0
                       CALL GetIniParameters
                       IF EndOfFile% THEN ERROR 62%
                       SELECT CASE GroupItem$
                         CASE "BRANDMODEL"
                           Theodolite.BrandModel$ = TextItem$                   ' Wild T16"
                           Terminating% = Terminating% + 2%^0% '&B00000001
                         CASE "VERTICALTYPE"
                           Theodolite.VerticalType$ = TextItem$                 ' Zenital
                           Terminating% = Terminating% + 2%^1% '&B00000010
                         CASE ELSE
                            CALL AbortsWithErrorMessage
                       END SELECT
                     LOOP
                     Theodolite% = %TRUE
              
                   CASE "GEODIMETER"
                     IF Geodimeter% THEN PRINT: PRINT MORETHANONE$ Group$: PRINT ABORTSEXEC$: STOP
                     Terminating% = 0%
                     CurrentGroup$ = Group$
                     '----------------------------fedcba9876543210
                     DO UNTIL (Terminating% AND &B0000000001111111) = 127%      ' 2^6 + 2^5 + 2^4 + 2^3 + 2^2 + 2^1 + 2^0
                       CALL GetIniParameters
                       IF EndOfFile% THEN ERROR 62%
                       SELECT CASE GroupItem$
                         CASE "BRANDMODEL"
                           Geodimeter.BrandModel$ = TextItem$                   ' AGA 116
                           Terminating% = Terminating% + 2%^0% '&B00000001
                         CASE "ECCENTRICMOUNTING"
                           Geodimeter.EccentricMounting$ = TextItem$            ' Yes
                           Terminating% = Terminating% + 2%^1% '&B00000010
                         CASE "HEIGHTABOVETHEODOLITE"
                           Geodimeter.HeightAboveTheodolite$ = TextItem$        ' 0.114
                           Terminating% = Terminating% + 2%^2% '&B00000100
                         CASE "ATMOSPHERICPRESSURE"
                           Geodimeter.AtmosphericPressure$ = TextItem$          ' 760.0
                           Terminating% = Terminating% + 2%^3% '&B00001000
                         CASE "AVERAGEALTITUDE"
                           Geodimeter.AverageAltitude$ = TextItem$              ' 0.0
                           Terminating% = Terminating% + 2%^4% '&B00010000
                         CASE "AIRTEMPERATURE"
                           Geodimeter.AirTemperature$ = TextItem$               ' 20.0
                           Terminating% = Terminating% + 2%^5% '&B00100000
                         CASE "DOATMOSPHERICCORRECTION"
                           Geodimeter.DoAtmosphericCorrection$ = TextItem$      ' No
                           Terminating% = Terminating% + 2%^6% '&B01000000
                         CASE ELSE
                            CALL AbortsWithErrorMessage
                       END SELECT
                     LOOP
                     Geodimeter% = %TRUE
              
                   CASE "PRISM"
                     IF Prism% THEN PRINT: PRINT MORETHANONE$ Group$: PRINT ABORTSEXEC$: STOP
                     Terminating% = 0%
                     CurrentGroup$ = Group$
                     '----------------------------fedcba9876543210
                     DO UNTIL (Terminating% AND &B0000000000000111) = 7%        ' 2^2 + 2^1 + 2^0
                       CALL GetIniParameters
                       IF EndOfFile% THEN ERROR 62%
                       SELECT CASE GroupItem$
                         CASE "PRISMCONSTANT"
                           Prism.PrismConstant$ = TextItem$                     ' 0.0
                           Terminating% = Terminating% + 2%^0% '&B00000001
                         CASE "ECCENTRICMOUNTING"
                           Prism.EccentricMounting$ = TextItem$                 ' No
                           Terminating% = Terminating% + 2%^1% '&B00000010
                         CASE "HEIGHTABOVESIGN"
                           Prism.HeightAboveSign$ = TextItem$                   ' 0.114
                           Terminating% = Terminating% + 2%^2% '&B00000100
                         CASE ELSE
                           CALL AbortsWithErrorMessage
                       END SELECT
                     LOOP
                     Prism% = %TRUE
              
                   CASE "ELLIPSOID"
                     IF Ellipsoid% THEN PRINT: PRINT MORETHANONE$ Group$: PRINT ABORTSEXEC$: STOP
                     Terminating% = 0%
                     CurrentGroup$ = Group$
                     '----------------------------fedcba9876543210
                     DO UNTIL (Terminating% AND &B0000000000000111) = 7%        ' 2^2 + 2^1 + 2^0
                       CALL GetIniParameters
                       IF EndOfFile% THEN ERROR 62%
                       SELECT CASE GroupItem$
                         CASE "SEMIMAJORAXIS"
                           Ellipsoid.SemiMajorAxis$ = TextItem$                 ' 6378160.0
                           Terminating% = Terminating% + 2%^0% '&B00000001
                         CASE "FLATTENINGMODULE"
                           Ellipsoid.FlatteningModule$ = TextItem$              ' 298.25
                           Terminating% = Terminating% + 2%^1% '&B00000010
                         CASE "LATITUDEPLACEMEDIA"
                           Ellipsoid.LatitudePlaceMedia$ = TextItem$            ' -23.5
                           Terminating% = Terminating% + 2%^2% '&B00000100
                         CASE ELSE
                            CALL AbortsWithErrorMessage
                       END SELECT
                     LOOP
                     Ellipsoid% = %TRUE
              
                   CASE "AUTOCAD"
                     IF AutoCAD% THEN PRINT: PRINT MORETHANONE$ Group$: PRINT ABORTSEXEC$: STOP
                     Terminating% = 0%
                     CurrentGroup$ = Group$
                     '----------------------------fedcba9876543210
                     DO UNTIL (Terminating% AND &B0000000000000111) = 7%        ' 2^2 + 2^1 + 2^0
                       CALL GetIniParameters
                       IF EndOfFile% THEN ERROR 62%
                       SELECT CASE GroupItem$
                         CASE "LAYERPOINTS"
                           AutoCAD.LayerPoints$ = TextItem$                     ' points
                           Terminating% = Terminating% + 2%^0% '&B00000001
                         CASE "LAYERNUMBERS"
                           AutoCAD.LayerNumbers$ = TextItem$                    ' numbers
                           Terminating% = Terminating% + 2%^1% '&B00000010
                         CASE "LAYERDIMENSIONS"
                           AutoCAD.LayerDimensions$ = TextItem$                 ' dimensions
                           Terminating% = Terminating% + 2%^2% '&B00000100
                         CASE ELSE
                           CALL AbortsWithErrorMessage
                       END SELECT
                     LOOP
                     AutoCAD% = %TRUE
              
                   CASE "COMPANY"
                     IF Company% THEN PRINT: PRINT MORETHANONE$ Group$: PRINT ABORTSEXEC$: STOP
                     Terminating% = 0%
                     CurrentGroup$ = Group$
                     '----------------------------fedcba9876543210
                     DO UNTIL (Terminating% AND &B0000000000000111) = 7%        ' 2^2 + 2^1 + 2^0
                       CALL GetIniParameters
                       IF EndOfFile% THEN ERROR 62%
                       SELECT CASE GroupItem$
                         CASE "TEXT1"
                           Company.Text1$ = TextItem$
                           Terminating% = Terminating% + 2%^0% '&B00000001
                         CASE "TEXT2"
                           Company.Text2$ = TextItem$
                           Terminating% = Terminating% + 2%^1% '&B00000010
                         CASE "TEXT3"
                           Company.Text3$ = TextItem$
                           Terminating% = Terminating% + 2%^2% '&B00000100
                         CASE ELSE
                           CALL AbortsWithErrorMessage
                       END SELECT
                     LOOP
                     Company% = %TRUE
              
                   CASE ELSE
                     PRINT
                     PRINT "Found unknown group! : " Group$
                     PRINT "The " INIFILE$ " file is invalid!"
                     PRINT "Delete it, a new file will be created!"
                     PRINT ABORTSEXEC$
                     STOP
                 END SELECT
               LOOP
              END SUB 'SolvesIni
              
              '// --------------------------------------------------------------------------
              '// --------------------------------------------------------------------------
              
              SUB AbortsWithErrorMessage
               SHARED ABORTSEXEC$
               SHARED CurrentGroup$, GroupItem$
               PRINT
               PRINT "The Group Item " CurrentGroup$ " is invalid! : " GroupItem$
               PRINT ABORTSEXEC$
               STOP
              END SUB 'AbortsWithErrorMessage
              
              Last edited by Arthur Gomide; 23 Mar 2016, 07:54 PM.
              "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

              Comment


              • #8
                Arthur, can you please post an English version of your code? Thank you

                Comment


                • #9
                  Ok, I'll translate it

                  Edited: in English now!
                  Last edited by Arthur Gomide; 23 Mar 2016, 05:04 PM.
                  "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

                  Comment


                  • #10
                    Thank you Arthur

                    Comment

                    Working...
                    X