Option Explicit
'Purpose:
' INI File Utilities for DP5 Configurations.
'
'Example:
'
'Code:'==========================================================================
'Code:'Quick DP5 INI Utility Guide
'Code:'==========================================================================
'Code:'--------------------------------------------------------------------------
'Code:' All INI data arrays are string arrays and have the form:
'Code:' varData(Records,Fields)
'Code:' Where:
'Code:' Records is the Number of INI Section Entries
'Code:' Fields values are 0=INI Key, 1=INI Data
'Code:'--------------------------------------------------------------------------
'Code:' Note: varSectionNames is a string array of section names. (NOT INI DATA)
'Code:'--------------------------------------------------------------------------
'Code:'--------------------------------------------------------------------------
'Code:'
'Code:'----- HOW DO I ? -----
'Code:'
'Code:'--------------------------------------------------------------------------
'Code:'Read a configuration.
'Code: varConfig = GetDP5ConfigSection(strFilename, strSection, varComments)
'Code:'--------------------------------------------------------------------------
'Code:'Save a configuration.
'Code: Call SaveDP5ConfigSection(strFilename, strSection, varConfig, varComments)
'Code:'--------------------------------------------------------------------------
'Code:'Save ANY INI data array.
'Code: Call SaveIniDataArray(strFilename, strSection, varData)
'Code:'--------------------------------------------------------------------------
'Code:'Appends semicolons to configuration data.
'Code: varConfig = AppendSemicolonsToConfig(varConfig)
'Code:'--------------------------------------------------------------------------
'Code:'Set all keys and config data to upper case.
'Code: varConfig = ConfigToUCASE(varConfig)
'Code:'--------------------------------------------------------------------------
'Code:'Append comments array to configuration data.
'Code: varData = AppendDP5Comments(varConfig, varComments)
'Code:'--------------------------------------------------------------------------
'Code:'Search for data in ANY INI array by key.
'Code: strData = FindIniData(strKey, varData)
'Code:'--------------------------------------------------------------------------
'Code:'Convert ANY INI data array to a formatted text display string.
'Code: strDisplaySection = DataArrayString(strSection, varData)
'Code:'--------------------------------------------------------------------------
'Code:'Convert ANY INI data file (all sections) to a formatted text display string.
'Code: strDisplayIniFile = IniFileString(strFilename)
'Code:'--------------------------------------------------------------------------
'Code:'Read all INI file section names.
'Code: varSectionNames = GetSectionNames(strFilename)
'Code:'--------------------------------------------------------------------------
'Code:'Extract DP5 commands from a INI data array.
'Code: varData = GetDP5Commands(varData)
'Code:'--------------------------------------------------------------------------
'Code:'Extract DP5 comments from a INI data array.
'Code: varComments = GetDP5Comments(varData)
'Code:'--------------------------------------------------------------------------
'Code:'Create a copy of an INI array. Copies keys and data.
'Code: varDataNew = CreateIniArr(varData) (NOTE: bCopyData = True by default)
'Code:'--------------------------------------------------------------------------
'Code:'Create an empty INI array of varData size.
'Code: varDataNew = CreateIniArr(varData, False)
'Code:'--------------------------------------------------------------------------
'Code:'Display an INI file section to a list control.
'Code: Call GetIniListEx2(strFilename, strSection, objList, bRemComments)
'Code:'--------------------------------------------------------------------------
Public varConfig As Variant
Public varComments As Variant
Public varValues As Variant
Public varValComments As Variant
Public varCmdCtrls As Variant
Public varUnitsArray As Variant
Public Const IniSectionVal = "DP5 Configuration Values"
Public Const IniSectionCfg = "DP5 Configuration File"
Public Const IniSectionApp = "DP5 Application Settings"
Public strIniFilename As String
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSectionNames Lib "kernel32" Alias "GetPrivateProfileSectionNamesA" (ByVal lpReturnBuffer As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
'Purpose: Read INI configuration data and comments array from file.
'Returns INI configuration data array as return value and comments array as parameter.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
'Parameter: varComments INI comment data array.
Public Function GetDP5ConfigSection(strFilename As String, strSection As String, ByRef varComments As Variant) As Variant
Dim varData As Variant
Dim varConfig As Variant
varData = GetAllIniSettings(strFilename, strSection) 'get the configuration
If IsEmpty(varData) Then
GetDP5ConfigSection = varData
Exit Function
End If
varConfig = GetDP5Commands(varData) 'remove the comments
varComments = GetDP5Comments(varData) 'save the comments
GetDP5ConfigSection = varConfig
End Function
'Purpose: Saves INI data array to file with optional append comments to configuration
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
'Parameter: varConfig INI configuration data array.
'Parameter: varComments INI comment data array.
Public Sub SaveDP5ConfigSection(strFilename As String, strSection As String, varConfig As Variant, Optional varComments As Variant)
Dim varData As Variant
Dim bAppendComments As Boolean
If (IsMissing(varComments)) Then
bAppendComments = False
Else
bAppendComments = True
End If
If (bAppendComments) Then
If (IsArray(varComments)) Then 'create new array with comments
varData = AppendDP5Comments(varConfig, varComments)
SaveIniDataArray strFilename, strSection, varData
Else
bAppendComments = False 'shut off
End If
End If
If (Not bAppendComments) Then 'the configuration has not been saved
varData = AppendSemicolonsToConfig(varConfig)
SaveIniDataArray strFilename, strSection, varData
End If
End Sub
'Purpose: Saves INI data array to file.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
'Parameter: varData INI data array.
Public Sub SaveIniDataArray(strFilename As String, strSection As String, varData As Variant)
Dim strKey As String
Dim strData As String
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
If (Not IsArray(varData)) Then Exit Sub 'if data array is empty cannot save
idxLRec = LBound(varData, 1)
idxURec = UBound(varData, 1)
For idxRecord = idxLRec To idxURec
strKey = varData(idxRecord, 0)
strData = varData(idxRecord, 1)
SaveToIni strFilename, strSection, strKey, strData
Next
End Sub
'Purpose: Appends semicolons to configuration data array.
'Returns updated configuration array.
'Parameter: varConfig INI configuration data array.
Public Function AppendSemicolonsToConfig(varConfig As Variant) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim varData As Variant
If (Not IsArray(varConfig)) Then
AppendSemicolonsToConfig = Empty
Exit Function 'if data array is empty cannot save
End If
varData = CreateIniArr(varConfig) 'create a working copy of config array
idxLRec = LBound(varConfig, 1)
idxURec = UBound(varConfig, 1)
For idxRecord = idxLRec To idxURec
If (InStr(1, varData(idxRecord, 1), ";") = 0) Then
varData(idxRecord, 1) = varData(idxRecord, 1) & ";"
End If
Next
AppendSemicolonsToConfig = varData
End Function
'Purpose: Sets configuration data array keys and data to upper case.
'Returns updated configuration array.
'Parameter: varConfig INI configuration data array.
Public Function ConfigToUCASE(varConfig As Variant) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim varData As Variant
If (Not IsArray(varConfig)) Then
ConfigToUCASE = Empty
Exit Function 'if data array is empty cannot save
End If
varData = CreateIniArr(varConfig) 'create a working copy of config array
idxLRec = LBound(varConfig, 1)
idxURec = UBound(varConfig, 1)
For idxRecord = idxLRec To idxURec
varData(idxRecord, 0) = UCase(varData(idxRecord, 0))
varData(idxRecord, 1) = UCase(varData(idxRecord, 1))
Next
ConfigToUCASE = varData
End Function
'Purpose: Clears configuration data.
'Returns updated configuration array.
'Parameter: varConfig INI configuration data array.
Public Function ClearConfigData(varConfig As Variant) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim varData As Variant
If (Not IsArray(varConfig)) Then
ClearConfigData = Empty
Exit Function 'if data array is empty cannot save
End If
varData = CreateIniArr(varConfig) 'create a working copy of config array
idxLRec = LBound(varConfig, 1)
idxURec = UBound(varConfig, 1)
For idxRecord = idxLRec To idxURec
varData(idxRecord, 1) = ""
Next
ClearConfigData = varData
End Function
'Purpose: Appends comments to INI data array.
'Returns the Command Key (Field 0) and the Data (Field 1) with comments and semicolons.
'Parameter: varConfig INI configuration data array.
'Parameter: varComments INI comment data array.
Public Function AppendDP5Comments(varConfig As Variant, varComments As Variant) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim strKey As String
Dim strComment As String
Dim varData As Variant
If (Not IsArray(varConfig)) Then 'if config array is empty then cannot append
AppendDP5Comments = Empty
Exit Function
ElseIf (Not IsArray(varComments)) Then 'if comment array is empty no need to append
AppendDP5Comments = varConfig
Exit Function
End If
varData = CreateIniArr(varConfig) 'create a working copy of config array
idxLRec = LBound(varConfig, 1) 'the config array size is needed
idxURec = UBound(varConfig, 1)
For idxRecord = idxLRec To idxURec
strKey = varData(idxRecord, 0) 'get the key to search for comment
strComment = FindIniData(strKey, varComments) 'search the comments array by key
varData(idxRecord, 1) = varData(idxRecord, 1) & ";" & strComment 'append comment to config
Next
AppendDP5Comments = varData
End Function
'Purpose: Find Data for given Key in INI data array.
'Returns the Data (Field 1).
'Parameter: strKey INI item Key.
'Parameter: varData INI data array.
Public Function FindIniData(strKey As Variant, varData As Variant) As String
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim strData As String
If (Not IsArray(varData)) Then
FindIniData = ""
Exit Function
End If
idxLRec = LBound(varData, 1)
idxURec = UBound(varData, 1)
strData = ""
For idxRecord = idxLRec To idxURec
If (StrComp(strKey, varData(idxRecord, 0), vbTextCompare) = 0) Then
strData = varData(idxRecord, 1)
Exit For
End If
Next
FindIniData = strData
End Function
'Purpose: Creates a formatted display string of INI file Section.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI file Section.
Public Function SectionString(strFilename As String, strSection As String) As String
Dim varData As Variant
Dim idxKey As Long
Dim strData As String
varData = GetAllIniSettings(strFilename, strSection)
strData = vbNewLine & "[" & strSection & "]" & vbNewLine
If IsArray(varData) Then
For idxKey = LBound(varData, 1) To UBound(varData, 1)
strData = strData & varData(idxKey, 0) & "=" & varData(idxKey, 1) & vbNewLine
Next
End If
SectionString = strData
End Function
'Purpose: Creates a formatted display string of a INI data array.
'Parameter: strSection INI file Section.
'Parameter: varData INI data array.
Public Function DataArrayString(strSection As String, varData As Variant) As String
Dim idxKey As Long
Dim strData As String
strData = vbNewLine & "[" & strSection & "]" & vbNewLine
If IsArray(varData) Then
For idxKey = LBound(varData, 1) To UBound(varData, 1)
strData = strData & varData(idxKey, 0) & "=" & varData(idxKey, 1) & vbNewLine
Next
End If
DataArrayString = strData
End Function
'Purpose: Creates a formatted display string of INI file.
'Parameter: strFilename INI Filename.
Public Function IniFileString(strFilename As String) As String
Dim varSections As Variant
Dim idxSection As Long
Dim strSection As String
Dim strData As String
IniFileString = ""
strData = ""
varSections = GetSectionNames(strFilename)
If (IsArray(varSections)) Then
For idxSection = LBound(varSections) To UBound(varSections)
strSection = varSections(idxSection)
strData = strData & SectionString(strFilename, strSection)
Next
Else
strSection = varSections
If (Len(strSection) > 0) Then
strData = SectionString(strFilename, strSection)
End If
End If
IniFileString = strData
End Function
'Purpose: Returns the INI file section names.
'Parameter: strFilename INI Filename.
Public Function GetSectionNames(strFilename As String) As Variant
Dim lngRetVal As Long
Dim strBuffer As String
Dim strSections() As String
Dim strSectionName As String '
Dim idxSection As Long
Dim lPos As Long
Dim lNull As Long
Dim lBufSize As Long
idxSection = 0
lPos = 1
strBuffer = Space(2048)
lngRetVal = GetPrivateProfileSectionNames(strBuffer, Len(strBuffer), strFilename)
lBufSize = Len(strBuffer)
Do While (lPos < lBufSize)
lNull = InStr(lPos, strBuffer, vbNullChar)
If (lNull <> lPos) Then
ReDim Preserve strSections(0 To idxSection) As String
strSections(idxSection) = Mid$(strBuffer, lPos, lNull - lPos)
idxSection = idxSection + 1
lPos = lNull + 1
Else
Exit Do
End If
Loop
GetSectionNames = strSections
End Function
'Purpose: Removes comments from INI section data.
'Returns the Command Key (Field 0) and the Command Setting (Field 1) without semicolons.
'Parameter: varData INI Section array.
'Remarks: The comment whitespace is not trimmed.
Public Function GetDP5Commands(ByRef varData As Variant) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim lPos As Long
Dim varConfig As Variant
If (Not IsArray(varData)) Then
GetDP5Commands = Empty
Exit Function
End If
varConfig = CreateIniArr(varData)
idxLRec = LBound(varConfig, 1)
idxURec = UBound(varConfig, 1)
For idxRecord = idxLRec To idxURec
lPos = InStr(varConfig(idxRecord, 1), ";")
If lPos = 1 Then 'not data only comments
varConfig(idxRecord, 1) = ""
ElseIf (lPos > 1) Then
varConfig(idxRecord, 1) = Left(varConfig(idxRecord, 1), lPos - 1)
Else
'not found
End If
Next
GetDP5Commands = varConfig
End Function
'Purpose: Extracts comments from INI section data.
'Returns the Command Key (Field 0) and the Comments (Field 1) without semicolons.
'Parameter: varData INI Section array.
'Remarks: The comment whitespace is not trimmed.
Public Function GetDP5Comments(ByRef varData As Variant) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim lPos As Long
Dim varComments As Variant
If (Not IsArray(varData)) Then
GetDP5Comments = Empty
Exit Function
End If
varComments = CreateIniArr(varData)
idxLRec = LBound(varComments, 1)
idxURec = UBound(varComments, 1)
For idxRecord = idxLRec To idxURec
lPos = InStr(varComments(idxRecord, 1), ";")
If (lPos > 0) Then
varComments(idxRecord, 1) = Mid(varComments(idxRecord, 1), lPos + 1)
Else 'not found
varComments(idxRecord, 1) = ""
End If
Next
GetDP5Comments = varComments
End Function
'Purpose: Creates INI data array of existing array size. Optional copy of existing data.
'Returns a INI data array.
'Parameter: varData INI configuration data array.
'Parameter: bCopyData Copy existing data array.
Public Function CreateIniArr(varData As Variant, Optional bCopyData As Boolean = True) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim idxLFld As Long
Dim idxUFld As Long
Dim idxField As Long
Dim lPos As Long
Dim strData() As String
Dim strKey As String
Dim strComment As String
If (Not IsArray(varData)) Then 'if data array is empty then cannot create new array
CreateIniArr = Empty
Exit Function
End If
idxLRec = LBound(varData, 1) 'the config array size is needed
idxURec = UBound(varData, 1)
idxLFld = LBound(varData, 2)
idxUFld = UBound(varData, 2)
ReDim strData(idxURec, idxUFld) 'create new working array to hold combined data and comments
If (bCopyData) Then
For idxRecord = idxLRec To idxURec 'copy the config to the working array
For idxField = idxLFld To idxUFld
strData(idxRecord, idxField) = varData(idxRecord, idxField)
Next
Next
End If
CreateIniArr = strData
End Function
'Purpose: Creates INI data array of existing array size. Optional copy of existing data.
'Returns a INI data array.
'Parameter: varData INI configuration data array.
'Parameter: bCopyData Copy existing data array.
Public Function CopyIniArr(varData As Variant, Optional bCopyEmpty As Boolean = True) As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim idxLFld As Long
Dim idxUFld As Long
Dim idxField As Long
Dim lPos As Long
Dim strData() As String
Dim strKey As String
Dim strComment As String
Dim idxNotEmpty As Long
Dim idxNew As Long
If (Not IsArray(varData)) Then 'if data array is empty then cannot create new array
CopyIniArr = Empty
Exit Function
End If
idxLRec = LBound(varData, 1) 'the config array size is needed
idxURec = UBound(varData, 1)
idxLFld = LBound(varData, 2)
idxUFld = UBound(varData, 2)
If (bCopyEmpty) Then
ReDim strData(idxURec, idxUFld) 'create new working array to hold combined data and comments
For idxRecord = idxLRec To idxURec 'copy the config to the working array
For idxField = idxLFld To idxUFld
strData(idxRecord, idxField) = varData(idxRecord, idxField)
Next
Next
Else
idxNotEmpty = -1
For idxRecord = idxLRec To idxURec 'count the working array valid values
If (Len(Trim(varData(idxRecord, 1))) > 0) Then idxNotEmpty = idxNotEmpty + 1
Next
If (idxNotEmpty >= 0) Then
idxNew = 0
ReDim strData(idxNotEmpty, idxUFld) 'create new working array to hold combined data and comments
For idxRecord = idxLRec To idxURec 'copy the config to the working array
If (Len(Trim(varData(idxRecord, 1))) > 0) Then
If (idxNew <= idxNotEmpty) Then
For idxField = idxLFld To idxUFld
strData(idxNew, idxField) = varData(idxRecord, idxField)
Next
idxNew = idxNew + 1
End If
End If
Next
End If
End If
CopyIniArr = strData
End Function
'Purpose: Reads Ini Section, saves to List control.
'Parameter: strFilename INI Filename.
'Parameter: strSection INI Section requested.
'Parameter: objList INI Section display list.
'Parameter: bRemComments Remove comments from section data.
Public Sub GetIniListEx2(strFilename As String, strSection As String, objList As Object, bRemComments As Boolean)
Dim varData As Variant
Dim idxLRec As Long
Dim idxURec As Long
Dim idxRecord As Long
Dim strItem As String
Dim lPos As Long
objList.Clear
varData = GetAllIniSettings(strFilename, strSection)
If IsEmpty(varData) Then Exit Sub
idxLRec = LBound(varData, 1)
idxURec = UBound(varData, 1)
For idxRecord = idxLRec To idxURec
strItem = varData(idxRecord, 0) & "=" & varData(idxRecord, 1)
If (bRemComments) Then
lPos = InStr(strItem, ";")
If lPos = 1 Then
strItem = ""
ElseIf lPos > 1 Then
strItem = Left$(strItem, lPos - 1)
End If
End If
objList.AddItem strItem
Next
objList.ListIndex = objList.TopIndex
End Sub
Public Sub SaveToIni(strFilename As String, strSection As String, strKey As String, strData As String)
Dim lngRetVal As Long
lngRetVal = WritePrivateProfileString(strSection, strKey, strData, strFilename)
End Sub
Public Function GetFromIni(strFilename As String, strSection As String, strKey As String, Optional strDefault As String) As String
Dim lngRetVal As Long
Dim lngBuffSz As Long
Dim strBuff As String
strBuff = Space(255)
lngBuffSz = 255
lngRetVal = GetPrivateProfileString(strSection, strKey, strDefault, strBuff, lngBuffSz, strFilename)
lngBuffSz = InStr(1, strBuff, Chr(0), vbBinaryCompare)
If lngBuffSz > 0 Then
GetFromIni = Trim(Left(strBuff, lngBuffSz - 1))
Else
GetFromIni = strBuff
End If
End Function
Public Function GetAllIniSettings(strFilename As String, Section As String) As Variant
Dim lRet As Long
Dim strTemp As String
Dim Table() As String
Dim Table2() As String
Dim iPnt As Integer
Dim iPnt2 As Integer
Dim iPosit As Integer
strTemp = Space(32567)
lRet = GetPrivateProfileSection(Section, strTemp, Len(strTemp), strFilename)
iPnt = 0
'For Redim+Preserve tables only the las index can be changed
If Left(strTemp, 2) = Chr$(0) & Chr$(0) Then
Exit Function
End If
If (lRet = 0) Then
Exit Function
End If
Do While Left(strTemp, 1) <> Chr$(0)
ReDim Preserve Table(1, iPnt)
iPosit = InStr(strTemp, "=")
Table(0, iPnt) = Left$(strTemp, iPosit - 1)
strTemp = Mid$(strTemp, iPosit + 1)
iPosit = InStr(strTemp, Chr$(0))
Table(1, iPnt) = Left$(strTemp, iPosit - 1)
strTemp = Mid$(strTemp, iPosit + 1)
iPnt = iPnt + 1
Loop
ReDim Table2(iPnt - 1, 1)
For iPnt2 = 0 To iPnt - 1
Table2(iPnt2, 0) = Table(0, iPnt2)
Table2(iPnt2, 1) = Table(1, iPnt2)
Next
GetAllIniSettings = Table2
End Function
Public Function DeleteIniSetting(strFilename As String, Section As String, Optional Key As String)
Dim lRet As Long
If Key = "" Then
lRet = WritePrivateProfileString(Section, vbNullString, vbNullString, strFilename)
Else
lRet = WritePrivateProfileString(Section, Key, vbNullString, strFilename)
End If
End Function
Public Sub GetIniList(strFilename As String, strSection As String, objList As Object)
Dim varAllIni As Variant
Dim i As Integer
Dim j As Integer
Dim idxLRec As Long
Dim idxLFld As Long
Dim idxURec As Long
Dim idxUFld As Long
objList.Clear
varAllIni = GetAllIniSettings(strFilename, strSection)
If IsEmpty(varAllIni) Then Exit Sub
idxLRec = LBound(varAllIni, 1)
idxLFld = LBound(varAllIni, 2)
idxURec = UBound(varAllIni, 1)
idxUFld = UBound(varAllIni, 2)
For i = idxLRec To idxURec
objList.AddItem varAllIni(i, 1)
Next
objList.ListIndex = objList.TopIndex
End Sub
'------------------------------------------------------
' Function: ValidFilename as string
' arguments: strFilename a filename
' Result: ValidFilename returns a valid filename
'-------------------------------------------------------
Function ValidFilename(strFilename As String) As String
Dim i As Integer
Dim strFname As String
Dim legalChar As String
ValidFilename = strFilename
strFname = Trim(strFilename) 'remove white space
' Remove for illegal characters
legalChar = " !#$%&'()-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`{}~.�������"
For i = 1 To Len(strFname)
If InStr(legalChar, UCase(Mid(strFname, i, 1))) = 0 Then
Mid(strFname, i, 1) = " "
End If
Next i
ValidFilename = strFname
End Function
Public Sub SaveApplicationSettings(frm As Form, Optional AppSet As Boolean = True, _
Optional CfgSet As Boolean = True, _
Optional ComSet As Boolean = True)
Dim strFilename As String
strFilename = App.Path & "\" & App.EXEName & ".ini"
If (AppSet) Then
'Application Settings
SaveToIni strFilename, IniSectionApp, frm.Name & "_Top", frm.Top
SaveToIni strFilename, IniSectionApp, frm.Name & "_Left", frm.Left
End If
If (CfgSet) Then
'Configuration Settings
SaveToIni strFilename, IniSectionApp, "SendCoarseFineGain", s.profile.SendCoarseFineGain
SaveToIni strFilename, IniSectionApp, "SCAEnabled", s.SCAEnabled
End If
If (ComSet) Then
'Communications Interface Settings
SaveToIni strFilename, IniSectionApp, "CurrentInterface", s.CurrentInterface
SaveToIni strFilename, IniSectionApp, "ComPort", s.ComPort
SaveToIni strFilename, IniSectionApp, "SockAddr", s.SockAddr
SaveToIni strFilename, IniSectionApp, "cstrSockAddr", s.cstrSockAddr
SaveToIni strFilename, IniSectionApp, "InetPort", s.InetPort
End If
End Sub
Public Sub LoadApplicationSettings(frm As Form, Optional AppSet As Boolean = True, _
Optional CfgSet As Boolean = True, _
Optional ComSet As Boolean = True)
Dim strFilename As String
strFilename = App.Path & "\" & App.EXEName & ".ini"
If (AppSet) Then
'Application Settings
frm.Top = GetFromIni(strFilename, IniSectionApp, frm.Name & "_Top", frm.Top)
frm.Left = GetFromIni(strFilename, IniSectionApp, frm.Name & "_Left", frm.Left)
End If
If (CfgSet) Then
'Configuration Settings
s.profile.SendCoarseFineGain = GetFromIni(strFilename, IniSectionApp, "SendCoarseFineGain", False)
s.SCAEnabled = GetFromIni(strFilename, IniSectionApp, "SCAEnabled", False)
End If
If (ComSet) Then
'Communications Interface Settings
s.CurrentInterface = GetFromIni(strFilename, IniSectionApp, "CurrentInterface", USB)
s.ComPort = GetFromIni(strFilename, IniSectionApp, "ComPort", 1)
s.SockAddr = GetFromIni(strFilename, IniSectionApp, "SockAddr", &HC0A80064)
s.cstrSockAddr = GetFromIni(strFilename, IniSectionApp, "cstrSockAddr", "192.168.0.100")
s.InetPort = GetFromIni(strFilename, IniSectionApp, "InetPort", 10001)
End If
End Sub
'''Private Sub DefaultIpAddress()
''' Dim lSockAddr As Long
''' Dim bSockAddr As Variant
''' Dim strSockAddr As String
''' Dim strMsg As String
'''
''' lSockAddr = IpAddrConvert("192.168.0.100")
''' strMsg = Hex(lSockAddr) & vbNewLine
''' strSockAddr = IpAddrConvert(lSockAddr)
''' strMsg = strMsg & strSockAddr & vbNewLine
''' bSockAddr = IpAddrConvert(lSockAddr, True)
''' strMsg = strMsg & bSockAddr(0) & "." & bSockAddr(1) & "." & bSockAddr(2) & "." & bSockAddr(3) & vbNewLine
''' MsgBox strMsg
'''End Sub
'Saves all INI Settings - NOTE:OVERWRITES ENTIRE SECTION - Use with caution!
'Useage - copy all section settings IN ORDER to Settings array, overwrites section settings
'Settings Variant Type of String Array -> Setting(Index,0),Setting(Index,1) -> 0=key,1=data
Public Sub SaveAllIniSettingsEx(strFilename As String, Section As String, Settings As Variant)
Dim lngRetVal As Long
Dim strData As String
Dim strSettings As String
Dim strNULL As String
Dim idxSetting As Long
Dim strSep As String
strNULL = Chr$(0)
If (Not IsArray(Settings)) Then Exit Sub
If (UBound(Settings, 2) <> 1) Then Exit Sub
For idxSetting = LBound(Settings, 1) To UBound(Settings, 1)
strData = CStr(Settings(idxSetting, 1))
If (InStr(strData, ";") > 0) Then
strSep = ""
Else
strSep = ";"
End If
strSettings = strSettings & CStr(Settings(idxSetting, 0)) & "=" & strData & strSep & strNULL
Next
strSettings = strSettings & strNULL
lngRetVal = WritePrivateProfileSection(Section, strSettings, strFilename)
End Sub
Public Sub SaveToIniEx(strFilename As String, _
strSection As String, _
strKey As String, _
strData As String)
Dim lngRetVal As Long
lngRetVal = WritePrivateProfileString(strSection, _
strKey, _
strData, _
strFilename)
End Sub
Public Function GetFromIniEx(strFilename As String, _
strSection As String, _
strKey As String, _
Optional strDefault As String) As String
Dim lngRetVal As Long
Dim lngBuffSz As Long
Dim strBuff As String
strBuff = Space(255)
lngBuffSz = 255
lngRetVal = GetPrivateProfileString(strSection, _
strKey, _
strDefault, _
strBuff, _
lngBuffSz, _
strFilename)
lngBuffSz = InStr(1, strBuff, Chr(0), vbBinaryCompare)
If lngBuffSz > 0 Then
GetFromIniEx = Trim(Left(strBuff, lngBuffSz - 1))
Else
GetFromIniEx = strBuff
End If
End Function
Public Function DeleteIniSettingEx(strFilename As String, Section As String, Optional Key As String)
Dim lRet As Long
If Key = "" Then
lRet = WritePrivateProfileString(Section, vbNullString, vbNullString, strFilename)
Else
lRet = WritePrivateProfileString(Section, Key, vbNullString, strFilename)
End If
End Function
Public Function GetAllIniSettingsEx(strFilename As String, Section As String) As Variant
Dim lRet As Long
Dim strTemp As String
Dim Table() As String
Dim Table2() As String
Dim iPnt As Integer
Dim iPnt2 As Integer
Dim iPosit As Integer
strTemp = Space(32567)
lRet = GetPrivateProfileSection(Section, strTemp, Len(strTemp), strFilename)
iPnt = 0
'For Redim+Preserve tables only the las index can be changed
If Left(strTemp, 2) = Chr$(0) & Chr$(0) Then
Exit Function
End If
If (lRet = 0) Then
Exit Function
End If
Do While Left(strTemp, 1) <> Chr$(0)
ReDim Preserve Table(1, iPnt)
iPosit = InStr(strTemp, "=")
Table(0, iPnt) = Left$(strTemp, iPosit - 1)
strTemp = Mid$(strTemp, iPosit + 1)
iPosit = InStr(strTemp, Chr$(0))
Table(1, iPnt) = Left$(strTemp, iPosit - 1)
strTemp = Mid$(strTemp, iPosit + 1)
iPnt = iPnt + 1
Loop
ReDim Table2(iPnt - 1, 1)
For iPnt2 = 0 To iPnt - 1
Table2(iPnt2, 0) = Table(0, iPnt2)
Table2(iPnt2, 1) = Table(1, iPnt2)
Next
GetAllIniSettingsEx = Table2
End Function