Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private SettingsPath As String
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyS And Shift = vbCtrlMask Then
SaveFileData
MsgBox "Data writed in the " & SettingsPath & " successfully!"
End If
End Sub
Private Sub Form_Load()
SettingsPath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & "Settings.ini"
KeyPreview = True
End Sub
Private Sub LoadFileData()
Dim c As Control
Dim name As String
Dim values() As String
Dim text As String
Dim line As String
Dim i As Integer
Dim pos As Integer
Dim varname As String
If PathFileExists(SettingsPath) = 0 Then Exit Sub
For Each c In Controls
If TypeName(c) = "OptionButton" Then
If c.value = True Then
name = name & ControlName(c) & " "
End If
End If
Next
name = Trim(name)
If Len(name) = 0 Then Exit Sub
Open SettingsPath For Input As #1
Do Until EOF(1)
Line Input #1, line
If Left(line, Len(name) + 1) = name & "=" Then
values = Split(Mid(line, Len(name) + 2), "|~")
For i = 0 To UBound(values)
pos = InStr(values(i), "=")
If pos > 1 Then
varname = Left(values(i), pos - 1)
For Each c In Controls
If TypeName(c) = "TextBox" Then
If ControlName(c) = varname Then
c.text = Mid(values(i), pos + 1)
Exit For
End If
End If
Next
End If
Next
Exit Do
End If
Loop
Close #1
End Sub
Private Sub SaveFileData()
Dim c As Control
Dim name As String
Dim value As String
Dim text As String
Dim line As String
For Each c In Controls
If TypeName(c) = "OptionButton" Then
If c.value = True Then
name = name & ControlName(c) & " "
End If
ElseIf TypeName(c) = "TextBox" Then
value = value + ControlName(c) & "=" & c.text & "|~"
End If
Next
name = Trim(name)
If Len(name) = 0 Then Exit Sub
text = name & "=" & value
If PathFileExists(SettingsPath) <> 0 Then
Open SettingsPath For Input As #1
Do Until EOF(1)
Line Input #1, line
If Left(line, Len(name) + 1) <> name & "=" Then
text = text & vbNewLine & line
End If
Loop
Close #1
End If
Open SettingsPath For Output As #1
Print #1, text
Close #1
End Sub
Private Function ControlName(c As Object) As String
If c.Parent.Controls(c.name) Is c Then
ControlName = c.name
Else
ControlName = c.name & "(" & CStr(c.Index) & ")"
End If
End Function
