Private Type ssSetType
ssSet
As String
ssValue
As String
End Type
Enum ssERRORs
ssNone = 0
ssUnknown = 1
ssSetNameIncorrect = 11
ssValueNameIncorrect = 12
ssSetExists = 21
ssResourceNotFound = 51
ssFileNotContainSettings = 61
ssPathNotFound = 71
ssFileNotFound = 72
End Enum
Private sINIFName
As String
Private Const sUpdFName
As String = "~UpdP.exe"
Private vSetVar()
As ssSetType
Private nSetCount
As Long
Private bWithRegister
As Boolean
Private vData()
As Byte
Private vDat
As String
Private vINIData
As String
Private Sub Class_Initialize()
ReDim vSetVar(0)
As ssSetType
bWithRegister =
False
sINIFName = "~SSSet.dat"
End Sub
Private Function GetAppPath()
As String
If Right(App.Path, 1) = "\"
Then
GetAppPath = App.Path
Else
GetAppPath = App.Path & "\"
End If
End Function
Public Function CreateSet(sSetting
As String,
Optional ReplaceSet
As Boolean =
False)
As Boolean
If UBound(vSetVar) = 0
Then SaveInList sSetting, "", 1: CreateSet =
True:
Exit Function
If bWithRegister =
True Then
For i = 1
To UBound(vSetVar)
If vSetVar(i).ssSet = sSetting
Then
If ReplaceSet =
True Then vSetVar(i).ssValue = "": CreateSet =
True
Exit Function
End If
Next i
For i = 1
To UBound(vSetVar)
If Trim$(vSetVar(i).ssSet) = ""
Then
vSetVar(i).ssSet = sSetting: vSetVar(i).ssValue = "": CreateSet =
True
Exit Function
End If
Next i
Else
For i = 1
To UBound(vSetVar)
If LCase(vSetVar(i).ssSet) = LCase(sSetting)
Then
If ReplaceSet =
True Then vSetVar(i).ssValue = "": CreateSet =
True
Exit Function
End If
Next i
For i = 1
To UBound(vSetVar)
If Trim$(vSetVar(i).ssSet) = ""
Then
vSetVar(i).ssSet = sSetting: vSetVar(i).ssValue = "": CreateSet =
True
Exit Function
End If
Next i
End If
SaveInList sSetting, "",
UBound(vSetVar) + 1: CreateSet =
True
End Function
Public Function DelSet(sSetting
As String)
As Boolean
If UBound(vSetVar) = 0
Then Exit Function
If bWithRegister =
True Then
For i = 1
To UBound(vSetVar)
If vSetVar(i).ssSet = sSetting
Then vSetVar(i).ssSet = "": vSetVar(i).ssValue = "": DelSet =
True:
Exit Function
Next i
Else
For i = 1
To UBound(vSetVar)
If LCase(vSetVar(i).ssSet) = LCase(sSetting)
Then vSetVar(i).ssSet = "": vSetVar(i).ssValue = "": DelSet =
True:
Exit Function
Next i
End If
End Function
Public Function DoGetSet(
Optional sFile
As String = "ME"
As ssERRORs
On Error GoTo errr
Dim sFormat
As eCodingFormat, Start
As Long
ff = FreeFile
sFile = Trim$(sFile)
Open IIf(UCase(sFile) = "ME", GetAppPath & App.EXEName & ".exe", sFile)
For Binary Access Read As ff
vDat$ =
Input(LOF(ff), ff)
Close ff
Start = InStr(1, vDat$, "!|/:#*/&%@
'`~($)~`'@%&\*#:\|!", vbTextCompare)
If Start < 1
Then DoGetSet = ssFileNotContainSettings:
Exit Function
Start = Start +
Len("!|/:#*/&%@
'`~($)~`'@%&\*#:\|!"
Start = InStr(Start, vDat$, "|", vbTextCompare) + 1
sFormat =
CLng(
Mid(vDat, Start, InStr(Start, vDat$, "|", vbTextCompare) - Start))
Start = InStr(Start, vDat$, "|", vbTextCompare) + 1
vINIData =
Mid(vDat, Start)
If Not sFormat = cNone
Then vINIData = DecodingString(vINIData, sFormat)
vINIData = Replace(vINIData, Chr(5), vbCrLf)
Open GetAppPath & sINIFName
For Output As ff: Close ff
Open GetAppPath & sINIFName
For Binary As ff
Put ff, , vINIData
Close ff
nSetCount =
CLng(sGetINI(GetAppPath & sINIFName, "Sets", "SC", "?"
)
If nSetCount < 1
Then DoGetSet = ssFileNotContainSettings:
Exit Function
ReDim vSetVar(0)
As ssSetType
For i = 1
To nSetCount
ReDim Preserve vSetVar(i)
As ssSetType
vSetVar(i).ssSet = sGetINI(GetAppPath & sINIFName, "Sets", "S" &
CStr(i) & "N", "?"
vSetVar(i).ssValue = sGetINI(GetAppPath & sINIFName, "Sets", "S" &
CStr(i) & "V", "?"
Next i
Kill GetAppPath & sINIFName
Exit Function
errr:
If Err.Number = 53
Then DoGetSet = ssFileNotFound:
Exit Function
 
oGetSet = ssUnknown
End Function
Public Function GetSet(sSetting
As String,
Optional sDefault
As String = ""
As String
'On Error GoTo 9
GetSet = sDefault
If Trim$(sSetting) = ""
Then Exit Function
If UBound(vSetVar) = 0
Then Exit Function
If bWithRegister =
True Then
For i = 1
To UBound(vSetVar)
If vSetVar(i).ssSet = sSetting
Then GetSet = vSetVar(i).ssValue:
Exit Function
Next i
Else
For i = 1
To UBound(vSetVar)
If LCase(vSetVar(i).ssSet) = LCase(sSetting)
Then GetSet = vSetVar(i).ssValue:
Exit Function
Next i
End If
9
End Function
Public Function GetSetCount()
As Long
GetSetCount =
UBound(vSetVar)
End Function
Public Function DoSaveSet(
Optional tEncryptFormat
As eCodingFormat = cNone,
Optional ExecuteMeAgain
As Boolean =
False,
Optional sCommandLine
As String = "",
Optional sFile
As String = "ME",
Optional nID
As Long = 1,
Optional sType
As String = "SUpdFileExe"
As ssERRORs
On Error GoTo errr
fd = FreeFile
sFile = Trim$(sFile)
Open GetAppPath & sINIFName
For Output As fd: Close fd
If UCase(sFile) = "ME"
Then
writeINI GetAppPath & sINIFName, "General", "FN", App.EXEName & ".exe"
writeINI GetAppPath & sINIFName, "General", "EA",
CStr(
CLng(ExecuteMeAgain))
writeINI GetAppPath & sINIFName, "General", "FF",
CStr(tEncryptFormat)
End If
writeINI GetAppPath & sINIFName, IIf(UCase(sFile) = "ME", "General", "Sets"
, "SC",
CStr(
UBound(vSetVar))
If UCase(sFile) = "ME"
Then If Not Trim$(sCommandLine) = ""
Then writeINI GetAppPath & sINIFName, "General", "CL", Trim$(sCommandLine)
If UBound(vSetVar) < 1
Then GoTo 1
For i = 1
To UBound(vSetVar)
writeINI GetAppPath & sINIFName, "Sets", "S" &
CStr(i) & "N", vSetVar(i).ssSet
writeINI GetAppPath & sINIFName, "Sets", "S" &
CStr(i) & "V", vSetVar(i).ssValue
Next i
1
If UCase(sFile) = "ME"
Then
vData = LoadResData(nID, sType)
Open GetAppPath & sUpdFName
For Output As fd: Close fd
Open GetAppPath & sUpdFName
For Binary As fd
Put fd, , vData
Close fd
Shell GetAppPath & sUpdFName, vbHide
End
Exit Function
End If
Open GetAppPath & sINIFName
For Binary Access Read As fd
vDat$ =
Input(LOF(fd), fd)
Close fd
Kill GetAppPath & sINIFName
vDat = Replace(vDat, vbCrLf, Chr$(5))
If Not tEncryptFormat = cNone
Then vDat$ = CodingString(vDat, tEncryptFormat)
Open sFile
For Output As fd: Close fd
Open sFile
For Binary Access Write As fd
Put fd, , "!|/:#*/&%@
'`~($)~`'@%&\*#:\|!"
Put fd, , "|" &
CStr(tEncryptFormat) & "|"
Put fd, , vDat
Close fd
errr:
If Err.Number = 326
Then DoSaveSet = ssResourceNotFound:
Exit Function
If Err.Number = 76
Then DoSaveSet = ssPathNotFound:
Exit Function
 
oSaveSet = ssUnknown
End Function
Public Function SaveSet(sSetting
As String, sValue
As String,
Optional ReplaceSet
As Boolean =
False,
Optional SaveNow
As Boolean =
False)
As ssERRORs
On Error GoTo errr
If Trim$(sSetting) = ""
Then SaveSet = ssSetNameIncorrect:
Exit Function
If Trim$(sValue) = ""
Then SaveSet = ssValueNameIncorrect:
Exit Function
If UBound(vSetVar) = 0
Then SaveInList sSetting, sValue, 1:
GoTo 999
If bWithRegister =
True Then
For i% = 1
To UBound(vSetVar)
If vSetVar(i
.ssSet = sSetting
Then If ReplaceSet =
True Then SaveInList sSetting, sValue, i%,
False:
GoTo 999
Else SaveSet = ssSetExists:
Exit Function
Next i%
Else
For i% = 1
To UBound(vSetVar)
If LCase(vSetVar(i
.ssSet) = LCase(sSetting)
Then If ReplaceSet =
True Then SaveInList sSetting, sValue, i%,
False:
GoTo 999
Else SaveSet = ssSetExists:
Exit Function
Next i%
End If
SaveInList sSetting, sValue,
UBound(vSetVar) + 1:
GoTo 999
Exit Function
999
If SaveNow =
True Then DoSaveSet
Exit Function
errr:
SaveSet = ssUnknown
End Function
Private Sub SaveInList(sSetting
As String, sValue
As String, nIndex
As Integer,
Optional bReDim
As Boolean =
True)
If bReDim =
True Then ReDim Preserve vSetVar(nIndex)
As ssSetType
vSetVar(nIndex).ssSet = sSetting
vSetVar(nIndex).ssValue = sValue
End Sub
Public Function GetSetByIndex(nIndex
As Long)
As String
If nIndex < 1
Then Exit Function
GetSetByIndex = vSetVar(nIndex).ssSet
End Function
Public Function ClearSetList(
Optional SetWithRegister
As Boolean =
False)
ReDim vSetVar(0)
As ssSetType
bWithRegister = SetWithRegister
End Function
Private Sub Class_Terminate()
ClearSetList
End Sub