by Dny/Ken (1 Submission)
Category: Files/File Controls/Input/Output
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Tue 23rd January 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Reads INI file and Stores the Values as an array.
VBcoders
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
************
Public Function Read_INIFile(ls_strINIFile As String) As Variant
On Error GoTo ESR
Dim ll_Ret As Long
Dim ls_iniInfo As String
Dim ls_strTempINI As String * 128 ' Data Collector DSN
Dim ls_INIConstant As String
Dim ls_INIValue As String
Dim ls_INIChar As String
Dim ls_sINIVal As String
Dim lb_pass1 As Boolean
Dim li_i As Integer
'Initialize all the Variables used in this function
lb_pass1 = True
ls_INIValue = Space$(128)
ls_strTempINI = Space$(128)
'ReDim the Array
ReDim gv_ini_file_array(1, 0)
' Open the Input File for Reading each line
Open ls_strINIFile For Input Access Read As #1
'Fetch each line till the end of File
Do While Not EOF(1)
Input #1, ls_iniInfo
ls_INIChar = Mid(ls_iniInfo, 1, 1)
' Check if the Char is a start of a Header Token "["
If ls_INIChar = "[" Then
ls_INIConstant = Mid(ls_iniInfo, 2, Len(ls_iniInfo) - 2)
'ElseIf INIChar <> " " And INIChar <> ";" Then
ElseIf ls_INIChar <> " " And ls_INIChar <> ";" And Len(Trim(ls_INIChar)) <> 0 Then
ls_INIValue = ""
ls_strTempINI = ""
ls_INIValue = Mid(ls_iniInfo, 1, InStr(1, ls_iniInfo, "=") - 1)
ll_Ret = GetPrivateProfileString("" + ls_INIConstant + "", "" + ls_INIValue + "", "-1", ls_strTempINI, 128, ls_strINIFile)
If Left$(ls_strTempINI, 2) = "-1" Then
ls_strTempINI = ""
Exit Function
End If
If Not lb_pass1 Then
ReDim Preserve gv_ini_file_array(1, UBound(gv_ini_file_array, 2) + 1)
End If
gv_ini_file_array(0, li_i) = ls_INIValue
gv_ini_file_array(1, li_i) = Mid$(Trim(ls_strTempINI), 1, Len(Trim(ls_strTempINI)) - 1)
lb_pass1 = False
li_i = li_i + 1
End If
Loop
'Assign the loaded array back to the function to return it as a variant
Read_INIFile = gv_ini_file_array()
Exit Function
' Error Routine to be called
ESR:
Debug.Print Err.Description
Debug.Print Err.Number
End Function
***************Put this Code in a CLASS MODULE*************
Public Sub write_log(ls_str As String, ls_filename As String)
Dim ls_fdir As String
Dim ls_filedir As String
Dim ls_tempdir As String
Dim ls_tempname As String
Dim li_cnt As Integer
'Initialize all the variables
li_cnt = 1
'Get the Current Directory and the file
Do While li_cnt > 0
li_cnt = InStr(1, ls_filename, "\")
If li_cnt > 0 Then
ls_tempdir = Mid(ls_filename, 1, InStr(1, ls_filename, "\"))
ls_filename = Mid(ls_filename, Len(ls_tempdir) + 1)
ls_filedir = ls_filedir + ls_tempdir
End If
Loop
ls_filedir = Left(ls_filedir, Len(ls_filedir) - 1)
ls_filename = ls_filedir + "\" + ls_filename
On Error Resume Next
ls_fdir = Dir(ls_filedir, vbDirectory)
If Len(ls_fdir) = 0 Then
MkDir (ls_filedir)
End If
Open ls_filename For Append Access Write As #1
Write #1, ls_str
Close #1
End Sub
************
Public Function get_val_from_ini(ls_cmp_val As String) As String
'Define Local variables
Dim ll_str_cmp As Long
Dim ll_i As Long
On Error GoTo ERR_GET_VAL
'Get the Error and do a Search and returns a string whole array
For ll_i = 0 To UBound(gv_ini_file_array, 2) + 1
' String compare each array element
ll_str_cmp = StrComp(gv_ini_file_array(0, ll_i), ls_cmp_val) ' Returns 0 if success
If (ll_str_cmp = 0) Then
get_val_from_ini = gv_ini_file_array(1, ll_i)
Exit Function
Else
get_val_from_ini = ll_str_cmp
End If
Next ll_i
ERR_GET_VAL:
Debug.Print Err.Description
Debug.Print Err.Number
get_val_from_ini = "ERROR # IN EXTRACT in INI FILE: " & Str(Err.Number)
On Error Resume Next
End Function
************
Public Function write_debug_Info(ls_strDbg_Lvl As String, ls_input_str As String) As Long
On Error GoTo ESR
Dim ls_dbg_level As String
Dim ls_dbg_file_nm As String
' Get the values from the Array of INI file.
ls_dbg_level = get_val_from_ini("DEBUG_LEVEL")
ls_dbg_file_nm = get_val_from_ini("DEBUG_LOG_FILE")
If ls_strDbg_Lvl <= ls_dbg_level Then
Call write_log(ls_input_str, ls_dbg_file_nm)
End If
write_debug_Info = 0
Exit Function
ESR:
write_debug_Info = 1
End Function
************
Public Function read_ini(ls_strINIFile As String) As Variant
Read_INIFile (ls_strINIFile)
End Function
