mdlinifunction.bas

针对银行排队

Attribute VB_Name = "mdlINIFunction"
Option Explicit

'**************************************************************
'**************************************************************
'************************  作    者：吴明远    *****************
'************************  功能简介：读写INI文件  ***************
'************************  开发时间：2002-10  ******************
'**************************************************************
'**************************************************************

Public Const DSNINIFile = ".\config.ini" '数据库INI文件
Public Const TempParaINIFile = "Temp.INI"       '临时配置文件
Public Const ParaINIFile = "Para2.INI"      '配置文件
Public Const ParaINIDir = "Config\Parameter\"   '配置文件所在文件夹

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 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 StrLen Lib "kernel32" Alias "lstrlenA" _
        (ByVal Ptr As Long) As Long

Public Function GetINI(strINIFile As String, strSection As String, _
            strKey As String, strDefault As String)
On Error GoTo ErrMsg
    Dim strTemp As String
    Dim intLength As Integer
    
    '判断INI文件是否存在
    If Dir(strINIFile) = "" Then
        MsgBox "INI文件“" & strINIFile & "”已被损坏，请联系管理人员或开发人员！", vbExclamation, "警告！"
'        RepairINIFile strINIFile
        Exit Function
    End If
    strTemp = String(256, Chr(0))
    intLength = GetPrivateProfileString(strSection, strKey, strDefault, strTemp, 255, strINIFile)
        
    GetINI = Left(strTemp, InStr(1, strTemp, Chr(0)) - 1)
    Exit Function
ErrMsg:
    MsgBox "从INI文件“" & strINIFile & "”文件读取数据时出现异常，请检查是否删除或移动了该文件！" & vbCrLf & _
            Err.Description, vbExclamation, "提示"
End Function

Public Function WriteINI(strINIFile As String, strSection As String, _
            strKey As String, strValue As String) As Boolean
On Error GoTo ErrMsg
    Dim n As Integer
    
    WriteINI = False
    'Replace any CR/LF characters with spaces
    If Len(strValue) >= 1 Then
        For n = Len(strValue) To 1
            If Mid$(strValue, n, 1) = vbCr Or Mid(strValue, n, 1) = vbLf Then
                Mid$(strValue, n, 1) = ""
            End If
        Next n
    End If
    
    n = WritePrivateProfileString(strSection, strKey, strValue, strINIFile)
    WriteINI = True
    Exit Function
ErrMsg:
    MsgBox "向INI文件“" & gstrCurrPath & strINIFile & "”文件写入数据时出现异常，请检查是否删除或移动了该文件！" & vbCrLf & _
            Err.Description, vbExclamation, "提示"
End Function

'修复配置文件
Public Function RepairConfig(ByVal strINIFile As String) As Boolean
    Dim f As Integer
    Dim clsEncrypt As New CEncrypt
    
    RepairConfig = False
    
    f = FreeFile
    '首先检查是否存在
    If Dir(strINIFile) <> "" Then
        Kill strINIFile
    End If
    
    Open strINIFile For Output As #f
    Print #f, "[Database]"
    Print #f, "Server=127.0.0.1"
    Print #f, "UseWinnt=True"
    Print #f, "UID=sa"
    Print #f, "PWD=" & clsEncrypt.Encode("sa", PasswordDepth)
    Close #f
    
    RepairConfig = True
End Function

'对下位机的配置文件进行碎片整理
'功能：把后面的通道信息往前移动
Public Sub CheckParameter(ByVal strINIFile As String)
On Error GoTo ErrMsg
    Dim Status
    Dim strTemp As String
    Dim strTemp2 As String
    Dim i As Integer, j As Integer
    
    '循环10个通道
    For i = 1 To 10
        '循环4个段
        For j = 1 To 3
            '先读出不同段的相同通道
            If j = 1 Then
                strTemp = GetINI(strINIFile, "Channel Information", "Channel" & i, "?")
            Else
                strTemp = GetINI(strINIFile, "Channel Information" & j, "Channel" & i, "?")
            End If
            strTemp2 = GetINI(strINIFile, "Channel Information" & j + 1, "Channel" & i, "?")
            strTemp = Trim(strTemp)
            strTemp2 = Trim(strTemp2)
                
            '然后进行比较，查看是否需要移动
            If strTemp = "0" And strTemp2 <> "0" Then
                '如果前一个段的等于零，而后一个段的不等于零，则进行移动
                '先在最前面加一个空格
                strTemp2 = " " & strTemp2
                If j = 1 Then
                    WriteINI strINIFile, "Channel Information", "Channel" & i, strTemp2
                Else
                    WriteINI strINIFile, "Channel Information" & j, "Channel" & i, strTemp2
                End If
                
                '接下来清除后一个段的内容
                WriteINI strINIFile, "Channel Information" & j + 1, "Channel" & i, " 0"
            End If
        Next j
    Next i
    
    Exit Sub
ErrMsg:
    MsgBoxW Err, vbExclamation
End Sub

'配置文件模板，用于生成配置文件
Public Function ParaTemplate(ByVal strINIFile As String) As Boolean
On Error GoTo ErrMsg
    Dim Status
    Dim f As Integer
    
    ParaTemplate = False
    
    '是否INI文件
    If UCase(Right(strINIFile, 4)) <> ".INI" Then
        MsgBox "这不是INI文件，请核查！", vbInformation, "提示"
        Exit Function
    End If
    
    '是否已经存在该文件
    If Dir(strINIFile) <> "" Then
        Kill strINIFile
    End If
    
    f = FreeFile
    Open strINIFile For Output As #f
    Print #f, "[Setting]"
    Print #f, "B-port= 0,0,0,0"
    Print #f, "Price= 0.24"
    Print #f, "Timer= 5"
    Print #f, ""
    
    Print #f, "[Channel Information]"
    Print #f, "Channel0= 0"
    Print #f, "Channel1= 0"
    Print #f, "Channel2= 0"
    Print #f, "Channel3= 0"
    Print #f, "Channel4= 0"
    Print #f, "Channel5= 0"
    Print #f, "Channel6= 0"
    Print #f, "Channel7= 0"
    Print #f, "Channel8= 0"
    Print #f, "Channel9= 0"
    Print #f, "Channel10= 0"
    Print #f, ""
    
    Print #f, "[Channel Information2]"
    Print #f, "Channel0= 0"
    Print #f, "Channel1= 0"
    Print #f, "Channel2= 0"
    Print #f, "Channel3= 0"
    Print #f, "Channel4= 0"
    Print #f, "Channel5= 0"
    Print #f, "Channel6= 0"
    Print #f, "Channel7= 0"
    Print #f, "Channel8= 0"
    Print #f, "Channel9= 0"
    Print #f, "Channel10= 0"
    Print #f, ""
    
    Print #f, "[Channel Information3]"
    Print #f, "Channel0= 0"
    Print #f, "Channel1= 0"
    Print #f, "Channel2= 0"
    Print #f, "Channel3= 0"
    Print #f, "Channel4= 0"
    Print #f, "Channel5= 0"
    Print #f, "Channel6= 0"
    Print #f, "Channel7= 0"
    Print #f, "Channel8= 0"
    Print #f, "Channel9= 0"
    Print #f, "Channel10= 0"
    Print #f, ""
    
    Print #f, "[Channel Information4]"
    Print #f, "Channel0= 0"
    Print #f, "Channel1= 0"
    Print #f, "Channel2= 0"
    Print #f, "Channel3= 0"
    Print #f, "Channel4= 0"
    Print #f, "Channel5= 0"
    Print #f, "Channel6= 0"
    Print #f, "Channel7= 0"
    Print #f, "Channel8= 0"
    Print #f, "Channel9= 0"
    Print #f, "Channel10= 0"
    Print #f, ""
    
    Print #f, "[Value Information]"
    Print #f, "Value1= 1,1.2,0.3"
    Print #f, "Value2= 0"
    Print #f, "Value3= 0"
    Print #f, "Value4= 0"
    Close #f
    Exit Function
ErrMsg:
    MsgBoxW Err
End Function