home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / tool / prg_sup / kpini / inifile.txt < prev   
Text File  |  1995-02-26  |  33KB  |  1,103 lines

  1. '***************************************************************************
  2. '** INIFILE.BAS ** Third Public Release
  3. '*************************************************
  4. '** VB Module for simplifying .INI file operations
  5. '***************************************************************************
  6. 'Copyright (C)Karl E. Peterson, February 1994, CIS 72302,3707.
  7. 'Portions originally downloaded from CompuServe's MSBASIC forum as
  8. 'MINIFILE.BAS, author unknown.  Comments and questions welcome!
  9. '***************************************************************************
  10. 'This module contains "wrappers" for just about anything you'd want to do
  11. 'with INI files.  The only prerequisite for using them is to register the
  12. 'particular INI path/filename and [Section] in advance of calling them.
  13. 'Register Private.Ini by calling PrivIniRegister, and Win.Ini by calling
  14. 'WinIniRegister.
  15. '
  16. 'This provides *safe* assured access to both application (Private.Ini) and
  17. 'Windows (Win.Ini) initialization files, with no need to worry about proper
  18. 'declarations and calling conventions.  It also greatly simplifies the task
  19. 'of repeatedly reading or writing to an Ini file.
  20. '
  21. 'You are free to use this module as you see fit.  If you like it, I'd really
  22. 'appreciate hearing that!  If you don't like it, or have problems with it,
  23. 'I'd like to know that too.
  24. '***************************************************************************
  25. 'The SECOND RELEASE added a dozen new functions, and two old ones were renamed.
  26. 'Latest modifications, June 1994
  27. '  WinGetSectionEntries() is now WinGetSectEntries()
  28. '  PrivGetSectionEntries() is now PrivGetSectEntries()
  29. 'Two new functions retrieve an entire [Section], entries and values, into an
  30. 'array from either Win.Ini or Private.Ini.  These functions are:
  31. '  WinGetSectEntriesEx()
  32. '  PrivGetSectEntriesEx()
  33. 'The other four deal with problems associated with multiple "device=" lines
  34. 'in System.Ini.  Use these at your *own risk*!  Especially the ones that add
  35. 'or remove a device.  These functions are:
  36. '  SysDevAdd()              Adds a "device=" line to System.Ini
  37. '  SysDevRemove()           Removes a "device=" line from System.Ini
  38. '  SysDevLoaded()           Checks for a specific "device=" line
  39. '  SysDevGetList()          Retrieves array of all devices
  40. 'The last six deal with [Section]'s.
  41. '  Win/PrivGetSections()    Retrieves list of all [Section]'s
  42. '  Win/PrivGetSectionsEx()  Retrieves array of all [Section]'s
  43. '  Win/PrivSectionExist()   Verifies existence of registered [Section]
  44. '***************************************************************************
  45. 'The THIRD RELEASE fixes a problem with the SysDevLoaded and SysDevRemove
  46. 'functions.  Neither worked if comments were on the same line.  Also, a flag
  47. 'has been added so that paths can be ignored or enforced with the SysXXX
  48. 'functions.  All API calls have been Aliased, so that this module may more
  49. 'easily be incorporated into existing programs.  Four new routines have
  50. 'been added:
  51. '  SysIniRegister()         Set nmSysPath flag
  52. '  ExtractName$()           Returns filename from filespec
  53. '  ExtractPath$()           Returns path from filespec
  54. '  StripComment$()          Removes trailing comments/spaces
  55. '***************************************************************************
  56. 'The FOURTH RELEASE finally added some example code that exercises the
  57. 'routines in INIFILE.BAS!  The enclosed project, INIEDIT, is provided AS-IS,
  58. 'with no warranties expressed or implied.  Use it at your own risk, preferably
  59. 'on a copy of "real" INI files so you're not timid about adding and deleting
  60. 'data.
  61. '
  62. 'The only changes made in INIFILE.BAS were to expand the Max_SectionBuffer
  63. 'length, and to set an error trap in the XXXGetSectEntriesEx functions.
  64. 'There appears to be a problem if a very large section is read with these
  65. 'routines (such as the [fonts] section in Win.Ini if several hundred fonts
  66. 'are installed).  If anyone has ideas on improving this, *please* let me
  67. 'know!  Currently, the return data is truncated, but that's better than an
  68. 'untrapped error, right? <g>
  69. '***************************************************************************
  70.  
  71. Option Explicit
  72.  
  73. '** Windows API calls
  74. '(NOTE: Profile calls *altered* from those found in WIN30API.TXT!)
  75.   Declare Function kpGetProfileInt Lib "Kernel" Alias "GetProfileInt" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Integer) As Integer
  76.   Declare Function kpGetProfileString Lib "Kernel" Alias "GetProfileString" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  77.   Declare Function kpWriteProfileString Lib "Kernel" Alias "WriteProfileString" (ByVal lpAppName As Any, ByVal lpKeyName As Any, ByVal lpString As Any) As Integer
  78.   Declare Function kpGetPrivateProfileInt Lib "Kernel" Alias "GetPrivateProfileInt" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  79.   Declare Function kpGetPrivateProfileString Lib "Kernel" Alias "GetPrivateProfileString" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  80.   Declare Function kpWritePrivateProfileString Lib "Kernel" Alias "WritePrivateProfileString" (ByVal lpAppName As Any, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Integer
  81.   Declare Function kpSendMessage Lib "User" Alias "SendMessage" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  82.   Declare Function kpGetWindowsDirectory Lib "Kernel" Alias "GetWindowsDirectory" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  83.  
  84. '** Module-level variables for [Section] and Ini file names
  85.   Dim smSectionName As String   'Current section in private Ini file
  86.   Dim smIniFileName As String   'Fully qualified path/name of current private Ini file
  87.   Dim smWinSection As String    'Current section in Win.Ini
  88.   Dim nmWinInit As Integer      'Flag to indicate that Win.Ini section is initialized
  89.   Dim nmPrivInit As Integer     'Flag to indicate that Private.Ini is initialized
  90.   Dim nmSysPath As Integer      'Flag to indicate whether paths should be used with DEVICE=
  91.  
  92. '** Constants used to size buffers
  93.   Const Max_SectionBuffer = 8192
  94.   Const Max_EntryBuffer = 255
  95.  
  96. '** Special values to alert other apps of Win.Ini changes
  97.   Const HWND_BROADCAST = &HFFFF
  98.   Const WM_WININICHANGE = &H1A
  99.  
  100. Function ExtractName$ (sSpecIn$, nBaseOnly%)
  101.   
  102.   Dim nCnt%, nDot%, sSpecOut$
  103.  
  104.   On Local Error Resume Next
  105.  
  106.   If InStr(sSpecIn, "\") Then
  107.     For nCnt = Len(sSpecIn) To 1 Step -1
  108.       If Mid$(sSpecIn, nCnt, 1) = "\" Then
  109.         sSpecOut = Mid$(sSpecIn, nCnt + 1)
  110.         Exit For
  111.       End If
  112.     Next nCnt
  113.   
  114.   ElseIf InStr(sSpecIn, ":") = 2 Then
  115.     sSpecOut = Mid$(sSpecIn, 3)
  116.     
  117.   Else
  118.     sSpecOut = sSpecIn
  119.   End If
  120.     
  121.   If nBaseOnly Then
  122.     nDot = InStr(sSpecOut, ".")
  123.     If nDot Then
  124.       sSpecOut = Left$(sSpecOut, nDot - 1)
  125.     End If
  126.   End If
  127.  
  128.   ExtractName$ = UCase$(sSpecOut)
  129.  
  130. End Function
  131.  
  132. Function ExtractPath$ (sSpecIn$)
  133.  
  134.   Dim nCnt%, sSpecOut$
  135.   
  136.   On Local Error Resume Next
  137.  
  138.   If InStr(sSpecIn, "\") Then
  139.     For nCnt = Len(sSpecIn) To 1 Step -1
  140.       If Mid$(sSpecIn, nCnt, 1) = "\" Then
  141.         sSpecOut = Left$(sSpecIn, nCnt)
  142.         Exit For
  143.       End If
  144.     Next nCnt
  145.   
  146.   ElseIf InStr(sSpecIn, ":") = 2 Then
  147.     sSpecOut = CurDir$(sSpecIn)
  148.     If Len(sSpecOut) = 0 Then sSpecOut = CurDir$
  149.  
  150.   Else
  151.     sSpecOut = CurDir$
  152.   End If
  153.     
  154.   If Right$(sSpecOut, 1) <> "\" Then
  155.     sSpecOut = sSpecOut + "\"
  156.   End If
  157.   ExtractPath$ = UCase$(sSpecOut)
  158.  
  159. End Function
  160.  
  161. Sub Main ()
  162.   'This subroutine is useful for simply testing the other routines in this
  163.   'module.  Make this module the only one in a project, and set Sub Main as
  164.   'the entry point.  Then enter the code you wish to test below.
  165. End Sub
  166.  
  167. Sub PrivClearEntry (sEntryName As String)
  168.  
  169.   'Bail if not initialized
  170.     If Not nmPrivInit Then
  171.       PrivIniNotReg
  172.       Exit Sub
  173.     End If
  174.  
  175.   'Sets a specific entry in Private.Ini to Nothing or Blank
  176.     Dim nRetVal As Integer
  177.     nRetVal = kpWritePrivateProfileString(smSectionName, sEntryName, "", smIniFileName)
  178.  
  179. End Sub
  180.  
  181. Sub PrivDeleteEntry (sEntryName As String)
  182.  
  183.   'Bail if not initialized
  184.     If Not nmPrivInit Then
  185.       PrivIniNotReg
  186.       Exit Sub
  187.     End If
  188.  
  189.   'Deletes a specific entry in Private.Ini
  190.     Dim nRetVal As Integer
  191.     nRetVal = kpWritePrivateProfileString(smSectionName, sEntryName, 0&, smIniFileName)
  192.  
  193. End Sub
  194.  
  195. Sub PrivDeleteSection ()
  196.  
  197.   'Bail if not initialized
  198.     If Not nmPrivInit Then
  199.       PrivIniNotReg
  200.       Exit Sub
  201.     End If
  202.  
  203.   'Deletes an *entire* [Section] and all its Entries in Private.Ini
  204.     Dim nRetVal As Integer
  205.     nRetVal = kpWritePrivateProfileString(smSectionName, 0&, 0&, smIniFileName)
  206.  
  207.   'Now Private.Ini needs to be reinitialized
  208.     smSectionName = ""
  209.     nmPrivInit = False
  210.  
  211. End Sub
  212.  
  213. Function PrivGetInt (sEntryName As String, nDefaultValue As Integer) As Integer
  214.  
  215.   'Bail if not initialized
  216.     If Not nmPrivInit Then
  217.       PrivIniNotReg
  218.       Exit Function
  219.     End If
  220.  
  221.   'Retrieves an Integer value from Private.Ini, range: 0-32767
  222.     PrivGetInt = kpGetPrivateProfileInt(smSectionName, sEntryName, nDefaultValue, smIniFileName)
  223.  
  224. End Function
  225.  
  226. Function PrivGetSectEntries () As String
  227.  
  228.   'Bail if not initialized
  229.     If Not nmPrivInit Then
  230.       PrivIniNotReg
  231.       Exit Function
  232.     End If
  233.  
  234.   'Retrieves all Entries in a [Section] of Private.Ini
  235.   'Entries nul terminated; last entry double-terminated
  236.     Dim sTemp As String * Max_SectionBuffer
  237.     Dim nRetVal As Integer
  238.     nRetVal = kpGetPrivateProfileString(smSectionName, 0&, "", sTemp, Len(sTemp), smIniFileName)
  239.     PrivGetSectEntries$ = Left$(sTemp, nRetVal + 1)
  240.  
  241. End Function
  242.  
  243. Function PrivGetSectEntriesEx (sTable() As String) As Integer
  244.  
  245.   'Bail if not initialized
  246.     If Not nmPrivInit Then
  247.       PrivIniNotReg
  248.       Exit Function
  249.     End If
  250.  
  251.   'Example of usage, note return is one higher than UBound
  252.     'Dim i%, n%
  253.     'Dim eTable() As String
  254.     'PrivIniRegister "386Enh", "System.Ini"
  255.     'n% = PrivGetSectionEntriesEx(eTable())
  256.     'For i = 0 To n - 1
  257.     '  Debug.Print eTable(0, i); "="; eTable(1, i)
  258.     'Next i
  259.  
  260.   'Retrieves all Entries in a [Section] of Private.Ini
  261.   'Entries nul terminated; last entry double-terminated
  262.     Dim sBuff As String * Max_SectionBuffer
  263.     Dim sTemp As String
  264.     Dim nRetVal As Integer
  265.     nRetVal = kpGetPrivateProfileString(smSectionName, 0&, "", sBuff, Len(sBuff), smIniFileName)
  266.     sTemp = Left$(sBuff, nRetVal + 1)
  267.  
  268.   'Parse entries into first dimension of table
  269.   'and retrieve values into second dimension
  270.     Dim nEntries As Integer
  271.     Dim nNull As Integer
  272.     On Error Resume Next
  273.     Do While Asc(sTemp)
  274.   'Bail if buffer wasn't large enough!!!
  275.       If Err Then Exit Do
  276.       ReDim Preserve sTable(0 To 1, 0 To nEntries)
  277.       nNull = InStr(sTemp, Chr$(0))
  278.       sTable(0, nEntries) = Left$(sTemp, nNull - 1)
  279.       sTable(1, nEntries) = PrivGetString(sTable(0, nEntries), "")
  280.       sTemp = Mid$(sTemp, nNull + 1)
  281.       nEntries = nEntries + 1
  282.     Loop
  283.  
  284.   'Make function assignment
  285.     PrivGetSectEntriesEx = nEntries
  286.  
  287. End Function
  288.  
  289. Function PrivGetSections$ ()
  290.  
  291.   'Bail if not initialized
  292.     If Not nmPrivInit Then
  293.       PrivIniNotReg
  294.       Exit Function
  295.     End If
  296.  
  297.   'Setup some variables
  298.     Dim sRet As String
  299.     Dim sBuff As String
  300.     Dim hFile As Integer
  301.  
  302.   'Extract all [Section] lines
  303.     hFile = FreeFile
  304.     Open smIniFileName For Input As hFile
  305.     Do While Not EOF(hFile)
  306.       Line Input #hFile, sBuff
  307.       sBuff = StripComment$(sBuff)
  308.       If InStr(sBuff, "[") = 1 And InStr(sBuff, "]") = Len(sBuff) Then
  309.         sRet = sRet + Mid$(sBuff, 2, Len(sBuff) - 2) + Chr$(0)
  310.       End If
  311.     Loop
  312.     Close hFile
  313.  
  314.   'Assign return value
  315.     If Len(sRet) Then
  316.       PrivGetSections = sRet + Chr$(0)
  317.     Else
  318.       PrivGetSections = String$(2, 0)
  319.     End If
  320.  
  321. End Function
  322.  
  323. Function PrivGetSectionsEx (sTable() As String) As Integer
  324.  
  325.   'Get "normal" list of all [Section]'s
  326.     Dim sSect As String
  327.     sSect = PrivGetSections$()
  328.     If Len(sSect) = 0 Then
  329.       PrivGetSectionsEx = 0
  330.       Exit Function
  331.     End If
  332.  
  333.   'Parse [Section]'s into table
  334.     Dim nEntries As Integer
  335.     Dim nNull As Integer
  336.     Do While Asc(sSect)
  337.       ReDim Preserve sTable(0 To nEntries)
  338.       nNull = InStr(sSect, Chr$(0))
  339.       sTable(nEntries) = Left$(sSect, nNull - 1)
  340.       sSect = Mid$(sSect, nNull + 1)
  341.       nEntries = nEntries + 1
  342.     Loop
  343.  
  344.   'Make function assignment
  345.     PrivGetSectionsEx = nEntries
  346.   
  347. End Function
  348.  
  349. Function PrivGetString (sEntryName As String, ByVal sDefaultValue As String) As String
  350.  
  351.   'Bail if not initialized
  352.     If Not nmPrivInit Then
  353.       PrivIniNotReg
  354.       Exit Function
  355.     End If
  356.  
  357.   'Retrieves Specific Entry from Private.Ini
  358.     Dim sTemp As String * Max_EntryBuffer
  359.     Dim nRetVal As Integer
  360.     nRetVal = kpGetPrivateProfileString(smSectionName, sEntryName, sDefaultValue, sTemp, Len(sTemp), smIniFileName)
  361.     If nRetVal Then
  362.       PrivGetString = Left$(sTemp, nRetVal)
  363.     End If
  364.  
  365. End Function
  366.  
  367. Function PrivGetTF (sEntryName As String, nDefaultValue As Integer)
  368.   
  369.   'Retrieves Specific Entry as either True/False from Private.Ini
  370.   'local vars
  371.     Dim sTF As String
  372.     Dim sDefault As String
  373.  
  374.   'get string value from INI
  375.     If nDefaultValue Then
  376.       sDefault = "true"
  377.     Else
  378.       sDefault = "false"
  379.     End If
  380.     sTF = PrivGetString(sEntryName, sDefault)
  381.  
  382.   'interpret return string
  383.     Select Case Trim$(UCase$(sTF))
  384.       Case "YES", "Y", "TRUE", "T", "ON", "1", "-1"
  385.         PrivGetTF = True
  386.       Case "NO", "N", "FALSE", "F", "OFF", "0"
  387.         PrivGetTF = False
  388.       Case Else
  389.         PrivGetTF = False
  390.     End Select
  391.  
  392. End Function
  393.  
  394. Sub PrivIniFlushCache ()
  395.  
  396.   'Bail if not initialized
  397.     If Not nmPrivInit Then
  398.       PrivIniNotReg
  399.       Exit Sub
  400.     End If
  401.  
  402.   'To improve performance, Windows keeps a cached version of the most-recently
  403.   'accessed initialization file. If that filename is specified and the other
  404.   'three parameters are NULL, Windows flushes the cache
  405.     Dim nRetVal As Integer
  406.     nRetVal = kpWritePrivateProfileString(0&, 0&, 0&, smIniFileName)
  407.  
  408. End Sub
  409.  
  410. Private Sub PrivIniNotReg ()
  411.   
  412.   'Warn *PROGRAMMER* that there's a logic error!
  413.     MsgBox "[Section] and FileName Not Registered in Private.Ini!", 16, "IniFile Logic Error"
  414.  
  415. End Sub
  416.  
  417. Sub PrivIniRead (SectionName$, KeyName$, nDefault%, ByVal DefaultStr$, ReturnStr$, Numeric%, IniFileName$)
  418.  
  419.   'One-shot read from Private.Ini, more *work* than it's worth
  420.     Dim nRetVal As Integer
  421.     Dim RetStr As String * Max_EntryBuffer 'Create an empty string to be filled
  422.  
  423.     If Numeric% Then    'we are looking for integer input
  424.       Numeric% = kpGetPrivateProfileInt(SectionName$, KeyName$, nDefault%, IniFileName$)
  425.     Else
  426.       nRetVal = kpGetPrivateProfileString(SectionName$, KeyName$, DefaultStr$, RetStr$, Len(RetStr$), IniFileName$)
  427.       If nRetVal Then
  428.         ReturnStr$ = Left$(RetStr$, nRetVal)
  429.       End If
  430.     End If
  431.  
  432. End Sub
  433.  
  434. Sub PrivIniRegister (sSectionName As String, sIniFileName As String)
  435.  
  436.   'Store module-level values for future reference
  437.     smSectionName = Trim$(sSectionName)
  438.     smIniFileName = Trim$(sIniFileName)
  439.     nmPrivInit = True
  440.  
  441. End Sub
  442.  
  443. Sub PrivIniWrite (SectionName$, IniFileName$, EntryName$, ByVal NewVal$)
  444.     
  445.   'One-shot write to Private.Ini, more *work* than it's worth
  446.     Dim nRetVal As Integer
  447.     nRetVal = kpWritePrivateProfileString(SectionName$, EntryName$, NewVal$, IniFileName$)
  448.     
  449. End Sub
  450.  
  451. Function PrivPutInt (sEntryName As String, nValue As Integer) As Integer
  452.  
  453.   'Bail if not initialized
  454.     If Not nmPrivInit Then
  455.       PrivIniNotReg
  456.       Exit Function
  457.     End If
  458.  
  459.   'Write an integer to Private.Ini
  460.     PrivPutInt = kpWritePrivateProfileString(smSectionName, sEntryName, Format$(nValue), smIniFileName)
  461.  
  462. End Function
  463.  
  464. Function PrivPutString (sEntryName As String, ByVal sValue As String) As Integer
  465.  
  466.   'Bail if not initialized
  467.     If Not nmPrivInit Then
  468.       PrivIniNotReg
  469.       Exit Function
  470.     End If
  471.  
  472.   'Write a string to Private.Ini
  473.     PrivPutString = kpWritePrivateProfileString(smSectionName, sEntryName, sValue, smIniFileName)
  474.  
  475. End Function
  476.  
  477. Function PrivPutTF (sEntryName As String, nValue As Integer)
  478.  
  479.   'Set an entry in Private.Ini to True/False
  480.   'local vars
  481.     Dim sTF As String
  482.  
  483.   'create INI string
  484.     If nValue Then
  485.       sTF = "true"
  486.     Else
  487.       sTF = "false"
  488.     End If
  489.  
  490.   'write new value
  491.     PrivPutTF = PrivPutString(sEntryName, sTF)
  492.  
  493. End Function
  494.  
  495. Function PrivSectExist () As Integer
  496.  
  497.   'Retrieve list of all [Section]'s
  498.     Dim sSect As String
  499.     sSect = PrivGetSections$()
  500.     If Len(sSect) = 0 Then
  501.       PrivSectExist = False
  502.       Exit Function
  503.     End If
  504.  
  505.   'Check for existence registered [Section]
  506.     sSect = Chr$(0) + UCase$(sSect)
  507.     If InStr(sSect, Chr$(0) + UCase$(smSectionName) + Chr$(0)) Then
  508.       PrivSectExist = True
  509.     Else
  510.       PrivSectExist = False
  511.     End If
  512.  
  513. End Function
  514.  
  515. Private Function StripComment$ (ByVal StrIn$)
  516.   
  517.   'Check for comment
  518.     Dim nRet%
  519.     nRet = InStr(StrIn, ";")
  520.  
  521.   'Remove it if present
  522.     If nRet = 1 Then
  523.       'Whole string is a comment
  524.         StripComment = ""
  525.         Exit Function
  526.     ElseIf nRet > 1 Then
  527.       'Strip comment
  528.         StrIn = Left$(StrIn, nRet - 1)
  529.     End If
  530.   
  531.   'Trim any trailing space
  532.     StripComment = Trim$(StrIn)
  533.  
  534. End Function
  535.  
  536. Function SysDevAdd (sNewDev$, sComment$, sBAK$) As Integer
  537.   
  538.   'Setup some variables
  539.     Dim sSysIni As String
  540.     Dim sSysBak As String
  541.     Dim sBuff() As String
  542.     Dim sTemp As String
  543.     Dim nRet As Integer
  544.     Dim hFile As Integer
  545.     Dim nCnt As Integer
  546.     Dim fAdded As Integer
  547.  
  548.   'Find System.Ini, and make backup
  549.     sTemp = String$(Max_EntryBuffer, 0)
  550.     nRet = kpGetWindowsDirectory(sTemp, Max_EntryBuffer)
  551.     sSysIni = Left$(sTemp, nRet) + "\System.Ini"
  552.     If Len(Trim$(sBAK)) Then
  553.       sSysBak = Left$(sTemp, nRet) + "\System." + sBAK
  554.       On Local Error Resume Next
  555.         FileCopy sSysIni, sSysBak
  556.         If Err Then
  557.           SysDevAdd = False
  558.           Exit Function
  559.         End If
  560.       On Local Error GoTo 0
  561.     End If
  562.  
  563.   'Read entire file, and insert new line
  564.     hFile = FreeFile
  565.     Open sSysIni For Input As hFile
  566.     Do While Not EOF(hFile)
  567.       nCnt = nCnt + 1
  568.       ReDim Preserve sBuff(1 To nCnt)
  569.       Line Input #hFile, sBuff(nCnt)
  570.       If Not fAdded Then
  571.         sTemp = UCase$(Trim$(sBuff(nCnt)))
  572.         If sTemp = "[386ENH]" Then
  573.           sTemp = Trim$(sNewDev)
  574.           sComment = Trim$(sComment)
  575.           If Len(sComment) Then
  576.             sTemp = sTemp + "    ;" + sComment
  577.           End If
  578.           nCnt = nCnt + 1
  579.           ReDim Preserve sBuff(1 To nCnt)
  580.           sBuff(nCnt) = "device=" + sTemp
  581.           fAdded = True
  582.         End If
  583.       End If
  584.     Loop
  585.     Close hFile
  586.  
  587.   'Write file back out
  588.     hFile = FreeFile
  589.     Open sSysIni For Output As hFile
  590.     For nCnt = LBound(sBuff) To UBound(sBuff)
  591.       Print #hFile, sBuff(nCnt)
  592.     Next nCnt
  593.     Close hFile
  594.  
  595.   'Make sure all went well
  596.     SysDevAdd = SysDevLoaded(sNewDev)
  597.  
  598. End Function
  599.  
  600. Function SysDevGetList (sTable() As String) As Integer
  601.   
  602.   'Setup some variables
  603.     Dim sSysIni As String
  604.     Dim sBuff As String
  605.     Dim nRet As Integer
  606.     Dim hFile As Integer
  607.     Dim nCnt As Integer
  608.  
  609.   'Example of usage, note return is one higher than UBound
  610.   'Returned values *always* have paths, if present
  611.     'Dim i%, n%
  612.     'Dim eTable() As String
  613.     'n% = SysDevGetList(eTable())
  614.     'For i = 0 To n - 1
  615.     '  Debug.Print "device="; eTable(i)
  616.     'Next i
  617.   
  618.   'Find System.Ini
  619.     sBuff = String$(Max_EntryBuffer, 0)
  620.     nRet = kpGetWindowsDirectory(sBuff, Max_EntryBuffer)
  621.     sSysIni = Left$(sBuff, nRet) + "\System.Ini"
  622.  
  623.   'Extract all device lines
  624.     hFile = FreeFile
  625.     Open sSysIni For Input As hFile
  626.     Do While Not EOF(hFile)
  627.       Line Input #hFile, sBuff
  628.       sBuff = UCase$(Trim$(sBuff))
  629.       If InStr(sBuff, "DEVICE=") = 1 Then
  630.         ReDim Preserve sTable(0 To nCnt)
  631.         sTable(nCnt) = StripComment$(Mid$(sBuff, 8))
  632.         nCnt = nCnt + 1
  633.       End If
  634.     Loop
  635.     Close hFile
  636.  
  637.   'Make final assignment
  638.     SysDevGetList = nCnt
  639.  
  640. End Function
  641.  
  642. Function SysDevLoaded (ByVal sDevChk As String) As Integer
  643.  
  644.   'Set up some variables
  645.     Dim nCnt As Integer
  646.     Dim nLoop As Integer
  647.     Dim dTable() As String
  648.     Dim sTemp As String
  649.     
  650.   'Example of usage
  651.     'SysIniRegister True   'Enforce path checking
  652.     'If SysDevLoaded("VShare.386") Then
  653.     '  MsgBox "VShare.386 *IS* Loaded!"
  654.     'Else
  655.     '  MsgBox "VShare.386 *NOT* Loaded!"
  656.     'End If
  657.   
  658.   'Get list of all devices loaded
  659.     nCnt = SysDevGetList(dTable())
  660.  
  661.   'Check for specific one
  662.     For nLoop = 0 To nCnt - 1
  663.       If nmSysPath Then
  664.         sTemp = dTable(nLoop)
  665.       Else
  666.         sTemp = ExtractName$(dTable(nLoop), False)
  667.         sDevChk = ExtractName$(sDevChk, False)
  668.       End If
  669.       If sTemp = UCase$(sDevChk) Then
  670.         SysDevLoaded = True
  671.         Exit For
  672.       End If
  673.     Next nLoop
  674.  
  675. End Function
  676.  
  677. Function SysDevRemove (ByVal sOldDev$, sBAK$) As Integer
  678.   
  679.   'Setup some variables
  680.     Dim sSysIni As String
  681.     Dim sSysBak As String
  682.     Dim sBuff() As String
  683.     Dim sTemp As String
  684.     Dim nTempFlag As Integer
  685.     Dim nRet As Integer
  686.     Dim hFile As Integer
  687.     Dim nCnt As Integer
  688.     Dim fRemoved As Integer
  689.  
  690.   'Trim path off device if not comparing paths
  691.     If Not nmSysPath Then
  692.       sOldDev = ExtractName$(sOldDev, False)
  693.     End If
  694.  
  695.   'Make sure it's there (somewhere)!
  696.     nTempFlag = nmSysPath  'Store and temp set path flag
  697.     SysIniRegister False
  698.       nRet = SysDevLoaded(sOldDev)
  699.     SysIniRegister nTempFlag
  700.     If Not nRet Then       'Definately not there
  701.       SysDevRemove = True
  702.       Exit Function
  703.     End If
  704.   
  705.   'Find System.Ini, and make backup
  706.     sTemp = String$(Max_EntryBuffer, 0)
  707.     nRet = kpGetWindowsDirectory(sTemp, Max_EntryBuffer)
  708.     sSysIni = Left$(sTemp, nRet) + "\System.Ini"
  709.     If Len(Trim$(sBAK)) Then
  710.       sSysBak = Left$(sTemp, nRet) + "\System." + sBAK
  711.       On Local Error Resume Next
  712.         FileCopy sSysIni, sSysBak
  713.         If Err Then
  714.           SysDevRemove = False
  715.           Exit Function
  716.         End If
  717.       On Local Error GoTo 0
  718.     End If
  719.  
  720.   'Read entire file, and remove old device line
  721.     hFile = FreeFile
  722.     Open sSysIni For Input As hFile
  723.     Do While Not EOF(hFile)
  724.       nCnt = nCnt + 1
  725.       ReDim Preserve sBuff(1 To nCnt)
  726.       Line Input #hFile, sBuff(nCnt)
  727.       If Not fRemoved Then
  728.         sTemp = UCase$(Trim$(sBuff(nCnt)))
  729.         If InStr(sTemp, "DEVICE=") = 1 Then
  730.           'Get what follows & strip comments
  731.           sTemp = StripComment$(Mid$(sTemp, 8))
  732.           If Not nmSysPath Then 'Ignore path
  733.             sTemp = ExtractName$(sTemp, False)
  734.           End If
  735.           If sTemp = UCase(sOldDev) Then
  736.             nCnt = nCnt - 1
  737.             ReDim Preserve sBuff(1 To nCnt)
  738.             fRemoved = True
  739.           End If
  740.         End If
  741.       End If
  742.     Loop
  743.     Close hFile
  744.  
  745.   'Write file back out
  746.     hFile = FreeFile
  747.     Open sSysIni For Output As hFile
  748.     For nCnt = LBound(sBuff) To UBound(sBuff)
  749.       Print #hFile, sBuff(nCnt)
  750.     Next nCnt
  751.     Close hFile
  752.  
  753.   'Make sure all went well
  754.     If fRemoved Then
  755.       nTempFlag = nmSysPath  'Store and temp set path flag
  756.       SysIniRegister False
  757.         nRet = SysDevLoaded(sOldDev)
  758.       SysIniRegister nTempFlag
  759.       SysDevRemove = Not nRet
  760.     End If
  761.  
  762. End Function
  763.  
  764. Sub SysIniRegister (nPathFlag%)
  765.  
  766.   'Store module-level flag for future reference
  767.     nmSysPath = nPathFlag
  768.  
  769. End Sub
  770.  
  771. Sub WinClearEntry (sEntryName As String)
  772.  
  773.   'Bail if not initialized
  774.     If Not nmWinInit Then
  775.       WinIniNotReg
  776.       Exit Sub
  777.     End If
  778.  
  779.   'Sets a specific entry in Win.Ini to Nothing or Blank
  780.     Dim nRetVal As Integer
  781.     nRetVal = kpWriteProfileString(smWinSection, sEntryName, "")
  782.     WinIniChanged
  783.  
  784. End Sub
  785.  
  786. Sub WinDeleteEntry (sEntryName As String)
  787.  
  788.   'Bail if not initialized
  789.     If Not nmWinInit Then
  790.       WinIniNotReg
  791.       Exit Sub
  792.     End If
  793.  
  794.   'Deletes a specific entry in Win.Ini
  795.     Dim nRetVal As Integer
  796.     nRetVal = kpWriteProfileString(smWinSection, sEntryName, 0&)
  797.     WinIniChanged
  798.  
  799. End Sub
  800.  
  801. Sub WinDeleteSection ()
  802.  
  803.   'Bail if not initialized
  804.     If Not nmWinInit Then
  805.       WinIniNotReg
  806.       Exit Sub
  807.     End If
  808.  
  809.   'Deletes an *entire* [Section] and all its Entries in Win.Ini
  810.     Dim nRetVal As Integer
  811.     nRetVal = kpWriteProfileString(smWinSection, 0&, 0&)
  812.   
  813.   'Now Win.Ini needs to be reinitialized
  814.     smWinSection = ""
  815.     nmWinInit = False
  816.     WinIniChanged
  817.  
  818. End Sub
  819.  
  820. Function WinGetInt (sEntryName As String, nDefaultValue As Integer) As Integer
  821.  
  822.   'Bail if not initialized
  823.     If Not nmWinInit Then
  824.       WinIniNotReg
  825.       Exit Function
  826.     End If
  827.  
  828.   'Retrieves an Integer value from Win.Ini, range: 0-32767
  829.     WinGetInt = kpGetProfileInt(smWinSection, sEntryName, nDefaultValue)
  830.  
  831. End Function
  832.  
  833. Function WinGetSectEntries () As String
  834.  
  835.   'Bail if not initialized
  836.     If Not nmWinInit Then
  837.       WinIniNotReg
  838.       Exit Function
  839.     End If
  840.  
  841.   'Retrieves all Entries in a [Section] of Win.Ini
  842.   'Entries nul terminated; last entry double-terminated
  843.     Dim sTemp As String * Max_SectionBuffer
  844.     Dim nRetVal As Integer
  845.     nRetVal = kpGetProfileString(smWinSection, 0&, "", sTemp, Len(sTemp))
  846.     WinGetSectEntries = Left$(sTemp, nRetVal + 1)
  847.  
  848. End Function
  849.  
  850. Function WinGetSectEntriesEx (sTable() As String) As Integer
  851.  
  852.   'Bail if not initialized
  853.     If Not nmWinInit Then
  854.       WinIniNotReg
  855.       Exit Function
  856.     End If
  857.  
  858.   'Example of usage, note return is one higher than UBound
  859.     'Dim i%, n%
  860.     'Dim eTable() As String
  861.     'WinIniRegister "Windows"
  862.     'n% = WinGetSectionEntriesEx(eTable())
  863.     'For i = 0 To n - 1
  864.     '  Debug.Print eTable(0, i); "="; eTable(1, i)
  865.     'Next i
  866.  
  867.   'Retrieves all Entries in a [Section] of Win.Ini
  868.   'Entries nul terminated; last entry double-terminated
  869.     Dim sBuff As String * Max_SectionBuffer
  870.     Dim sTemp As String
  871.     Dim nRetVal As Integer
  872.     nRetVal = kpGetProfileString(smWinSection, 0&, "", sBuff, Len(sBuff))
  873.     sTemp = Left$(sBuff, nRetVal + 1)
  874.  
  875.   'Parse entries into first dimension of table
  876.   'and retrieve values into second dimension
  877.     Dim nEntries As Integer
  878.     Dim nNull As Integer
  879.     On Error Resume Next
  880.     Do While Asc(sTemp)
  881.   'Bail if buffer wasn't large enough!!!
  882.       If Err Then Exit Do
  883.       ReDim Preserve sTable(0 To 1, 0 To nEntries)
  884.       nNull = InStr(sTemp, Chr$(0))
  885.       sTable(0, nEntries) = Left$(sTemp, nNull - 1)
  886.       sTable(1, nEntries) = WinGetString(sTable(0, nEntries), "")
  887.       sTemp = Mid$(sTemp, nNull + 1)
  888.       nEntries = nEntries + 1
  889.     Loop
  890.   
  891.   'Make final assignment
  892.     WinGetSectEntriesEx = nEntries
  893.  
  894. End Function
  895.  
  896. Function WinGetSections$ ()
  897.  
  898.   'No real need to be initialized, Win.Ini *should* exist
  899.   
  900.   'Setup some variables
  901.     Dim sWinIni As String
  902.     Dim sRet As String
  903.     Dim sBuff As String
  904.     Dim hFile As Integer
  905.     Dim nRet As Integer
  906.   
  907.   'Find Win.Ini
  908.     sBuff = String$(Max_EntryBuffer, 0)
  909.     nRet = kpGetWindowsDirectory(sBuff, Max_EntryBuffer)
  910.     sWinIni = Left$(sBuff, nRet) + "\Win.Ini"
  911.  
  912.   'Extract all [Section] lines
  913.     hFile = FreeFile
  914.     Open sWinIni For Input As hFile
  915.     Do While Not EOF(hFile)
  916.       Line Input #hFile, sBuff
  917.       sBuff = StripComment$(sBuff)
  918.       If InStr(sBuff, "[") = 1 And InStr(sBuff, "]") = Len(sBuff) Then
  919.         sRet = sRet + Mid$(sBuff, 2, Len(sBuff) - 2) + Chr$(0)
  920.       End If
  921.     Loop
  922.     Close hFile
  923.  
  924.   'Assign return value
  925.     If Len(sRet) Then
  926.       WinGetSections = sRet + Chr$(0)
  927.     Else
  928.       WinGetSections = String$(2, 0)
  929.     End If
  930.  
  931. End Function
  932.  
  933. Function WinGetSectionsEx (sTable() As String) As Integer
  934.  
  935.   'Get "normal" list of all [Section]'s
  936.     Dim sSect As String
  937.     sSect = WinGetSections$()
  938.     If Len(sSect) = 0 Then
  939.       WinGetSectionsEx = 0
  940.       Exit Function
  941.     End If
  942.  
  943.   'Parse [Section]'s into table
  944.     Dim nEntries As Integer
  945.     Dim nNull As Integer
  946.     Do While Asc(sSect)
  947.       ReDim Preserve sTable(0 To nEntries)
  948.       nNull = InStr(sSect, Chr$(0))
  949.       sTable(nEntries) = Left$(sSect, nNull - 1)
  950.       sSect = Mid$(sSect, nNull + 1)
  951.       nEntries = nEntries + 1
  952.     Loop
  953.  
  954.   'Make function assignment
  955.     WinGetSectionsEx = nEntries
  956.   
  957. End Function
  958.  
  959. Function WinGetString (sEntryName As String, ByVal sDefaultValue As String) As String
  960.  
  961.   'Bail if not initialized
  962.     If Not nmWinInit Then
  963.       WinIniNotReg
  964.       Exit Function
  965.     End If
  966.  
  967.   'Retrieves Specific Entry from Win.Ini
  968.     Dim sTemp As String * Max_EntryBuffer
  969.     Dim nRetVal As Integer
  970.     nRetVal = kpGetProfileString(smWinSection, sEntryName, sDefaultValue, sTemp, Len(sTemp))
  971.     If nRetVal Then
  972.       WinGetString = Left$(sTemp, nRetVal)
  973.     End If
  974.  
  975. End Function
  976.  
  977. Function WinGetTF (sEntryName As String, nDefaultValue As Integer)
  978.   
  979.   'Retrieves Specific Entry as either True/False from Win.Ini
  980.   'local vars
  981.     Dim sTF As String
  982.     Dim sDefault As String
  983.  
  984.   'get string value from INI
  985.     If nDefaultValue Then
  986.       sDefault = "true"
  987.     Else
  988.       sDefault = "false"
  989.     End If
  990.     sTF = WinGetString(sEntryName, sDefault)
  991.  
  992.   'interpret return string
  993.     Select Case Trim$(UCase$(sTF))
  994.       Case "YES", "Y", "TRUE", "T", "ON", "1", "-1"
  995.         WinGetTF = True
  996.       Case "NO", "N", "FALSE", "F", "OFF", "0"
  997.         WinGetTF = False
  998.       Case Else
  999.         WinGetTF = False
  1000.     End Select
  1001.  
  1002. End Function
  1003.  
  1004. Private Sub WinIniChanged ()
  1005.   
  1006.   'Notify all other applications that Win.Ini has been changed
  1007.     Dim Rtn&
  1008.     Rtn = kpSendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal smWinSection)
  1009.  
  1010. End Sub
  1011.  
  1012. Sub WinIniFlushCache ()
  1013.  
  1014.   'Windows keeps a cached version of WIN.INI to improve performance.
  1015.   'If all three parameters are NULL, Windows flushes the cache.
  1016.     Dim nRetVal As Integer
  1017.     nRetVal = kpWriteProfileString(0&, 0&, 0&)
  1018.   
  1019. End Sub
  1020.  
  1021. Private Sub WinIniNotReg ()
  1022.  
  1023.   'Warn *PROGRAMMER* that there's a logic error!
  1024.     MsgBox "[Section] Not Registered in Win.Ini!", 16, "IniFile Logic Error"
  1025.  
  1026. End Sub
  1027.  
  1028. Sub WinIniRegister (sSectionName As String)
  1029.   
  1030.   'Store module-level for future reference
  1031.     smWinSection = Trim$(sSectionName)
  1032.     nmWinInit = True
  1033.  
  1034. End Sub
  1035.  
  1036. Function WinPutInt (sEntryName As String, nValue As Integer) As Integer
  1037.  
  1038.   'Bail if not initialized
  1039.     If Not nmWinInit Then
  1040.       WinIniNotReg
  1041.       Exit Function
  1042.     End If
  1043.  
  1044.   'Write an integer to Win.Ini
  1045.     WinPutInt = kpWriteProfileString(smWinSection, sEntryName, Format$(nValue))
  1046.     WinIniChanged
  1047.  
  1048. End Function
  1049.  
  1050. Function WinPutString (sEntryName As String, ByVal sValue As String) As Integer
  1051.  
  1052.   'Bail if not initialized
  1053.     If Not nmWinInit Then
  1054.       WinIniNotReg
  1055.       Exit Function
  1056.     End If
  1057.  
  1058.   'Write a string to Win.Ini
  1059.     WinPutString = kpWriteProfileString(smWinSection, sEntryName, sValue)
  1060.     WinIniChanged
  1061.  
  1062. End Function
  1063.  
  1064. Function WinPutTF (sEntryName As String, nValue As Integer) As Integer
  1065.   
  1066.   'Set an entry in Win.Ini to True/False
  1067.   'local vars
  1068.     Dim sTF As String
  1069.  
  1070.   'create INI string
  1071.     If nValue Then
  1072.       sTF = "true"
  1073.     Else
  1074.       sTF = "false"
  1075.     End If
  1076.  
  1077.   'write new value
  1078.     WinPutTF = WinPutString(sEntryName, sTF)
  1079.     WinIniChanged
  1080.  
  1081. End Function
  1082.  
  1083. Function WinSectExist () As Integer
  1084.  
  1085.   'Retrieve list of all [Section]'s
  1086.     Dim sSect As String
  1087.     sSect = WinGetSections$()
  1088.     If Len(sSect) = 0 Then
  1089.       WinSectExist = False
  1090.       Exit Function
  1091.     End If
  1092.  
  1093.   'Check for existence registered [Section]
  1094.     sSect = Chr$(0) + UCase$(sSect)
  1095.     If InStr(sSect, Chr$(0) + UCase$(smWinSection) + Chr$(0)) Then
  1096.       WinSectExist = True
  1097.     Else
  1098.       WinSectExist = False
  1099.     End If
  1100.  
  1101. End Function
  1102.  
  1103.