如何用vb从ini文件中读取一条数据

时间:2020-12-08 04:22:57
有一个ini文件名称为 sjsx.ini 路径为 C:\sjsx\sjsx.ini  里面内容为
[config]
firsttime=20120822
sxsj=20120822110418
sjsxsj=20120822110418
xmsxsj=20120822110418

我现在想要从此ini文件中取sxsj 这条数据 然后跟系统时间进行比较。请教各位我怎么才能取到这条数据呢?

7 个解决方案

#1



'************************************************************************************
'GetINI(FileURL, Name)  获取需要的初始文件的值
    'FileURL    文件路径
    'Name   需要获取的记录名
'************************************************************************************

Function GetINI(FileURL, Name)
    Dim INIStr
    Dim StartPoint
    Dim EndPoint
    Dim Lenth
    Dim UpPart
    Dim MidPart
    Dim DownPart
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(FileURL) Then '确定文件存在
        Set file = FSO.opentextfile(FileURL, 1) '只读方式打开文件
        INIStr = vbCrLf & file.readall & vbCrLf
        
        StartPoint = InStr(1, INIStr, vbCrLf & Name & "=")
        If StartPoint > 0 Then  '搜索到插入点
        
            Lenth = Len(vbCrLf & Name & "=")
            
            UpPart = CutCL(Left(INIStr, StartPoint - 1))
            'MidPart = Mid(INIStr, StartPoint, Lenth)
            DownPart = Right(INIStr, Len(INIStr) - Lenth - StartPoint + 1)
            MidPart = Left(DownPart, InStr(1, DownPart, vbCrLf) - 1)
            DownPart = CutCL(Right(DownPart, Len(DownPart) - InStr(1, DownPart, vbCrLf) + 1))
        
            GetINI = MidPart
        Else
            GetINI = ""
        End If
    Else
        GetINI = ""
    End If
        
End Function

'************************************************************************************
'WriteINI(FileURL, Name,WriteValue)  写入需要的初始文件的值
    'FileURL    文件路径
    'Name   需要获取的记录名
    'WriteValue 写入记录的值
'************************************************************************************

Sub WriteINI(FileURL, Name, WriteValue)
    Dim OutINI
    
    Dim INIStr
    Dim StartPoint
    Dim EndPoint
    Dim Lenth
    Dim UpPart
    Dim MidPart
    Dim DownPart
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FileExists(FileURL) Then
        Set FS = CreateObject("Scripting.FileSystemObject")
        Set a = FS.CreateTextFile(FileURL, True)
        a.WriteLine ("[COMSet Information]" & vbCrLf & "CommPort=1" & vbCrLf & "BaudRate=9600" & vbCrLf & vbCrLf & "[Serial Code Settings]" & vbCrLf & "机器码=" & SNFormat(MotherCode()) & vbCrLf & "校验码=" & vbCrLf & "")
        a.Close
        Set FS = Nothing
    End If
    Set file = FSO.opentextfile(FileURL, 1)
    INIStr = vbCrLf & file.readall & vbCrLf
    file.Close
    
    If GetINI(FileURL, Name) <> "" Then
        'Name Exist and Name<>Empty
        StartPoint = InStr(1, INIStr, vbCrLf & Name & "=")
        Lenth = Len(vbCrLf & Name & "=")
        
        DownPart = Right(INIStr, Len(INIStr) - Lenth - StartPoint + 1)
        
        UpPart = CutCL(Left(INIStr, StartPoint - 1))
        MidPart = Left(DownPart, InStr(1, DownPart, vbCrLf) - 1)
        DownPart = CutCL(Right(DownPart, Len(DownPart) - InStr(1, DownPart, vbCrLf) + 1))
        OutINI = UpPart & vbCrLf & Name & "=" & WriteValue & vbCrLf & DownPart
    ElseIf InStr(1, INIStr, Name) <> 0 Then
        'Name Exist But Name=Empty
        StartPoint = InStr(1, INIStr, vbCrLf & Name & "=")
        Lenth = Len(vbCrLf & Name & "=")
        
        DownPart = Right(INIStr, Len(INIStr) - Lenth - StartPoint + 1)
        
        UpPart = CutCL(Left(INIStr, StartPoint - 1))
        MidPart = Left(DownPart, InStr(1, DownPart, vbCrLf) - 1)
        DownPart = CutCL(Right(DownPart, Len(DownPart) - InStr(1, DownPart, vbCrLf) + 1))
        OutINI = UpPart & vbCrLf & Name & "=" & WriteValue & vbCrLf & DownPart
    Else
        'Name Not Exist
        OutINI = CutCL(INIStr) & vbCrLf & Name & "=" & WriteValue
    End If
        
    Set file = FSO.opentextfile(FileURL, 2)
    file.WriteLine (OutINI)
    file.Close
End Sub

#2


这个看不太懂呀。能不能给个详细点的示例?我是不是还要添加类模块??

#3


看不太懂呀。能不能给个详细的例子。另外我是不是要添加类模块??????????

#4


LZ想多了,只要用2个函数就可以解决:
1、读取ini文件的内容:
GetPrivateProfileString "config", "firsttime", "", strval, Len(strval), "C:\sjsx\sjsx.ini"

2、对日期时间格式化后进行比较
格式化日期时间:
Format$(Now(), "yyyymmddhhmmss")

#5


引用 4 楼  的回复:
LZ想多了,只要用2个函数就可以解决:
1、读取ini文件的内容:
GetPrivateProfileString "config", "firsttime", "", strval, Len(strval), "C:\sjsx\sjsx.ini"

2、对日期时间格式化后进行比较
格式化日期时间:
Format$(Now(), "yyyymmddhhmmss")


我这样编辑了一个 您看对吗?为啥我一执行就会系统报错。退出vb

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
Dim a As String
Dim b As String
a = String(255, 0)
Private Sub Command1_Click()
b = GetPrivateProfileString("config", "firsttime", "", a, 255, "F:\sjsx\sjsx.ini")
msgbox b
End Sub

#6


通用部分有点问题,你改成:
Private Sub Command1_Click()
Dim a As String * 255
Dim b As String

b = GetPrivateProfileString("config", "firsttime", "", a, 255, "F:\sjsx\sjsx.ini")
msgbox b
End Sub

#7


另外,你的msgbox想显示出的返回值不知道是不是应该是获取ini文件里的值,如果是的话应该返回a。

Private Sub Command1_Click()
Dim a As String
Dim b As String
a = String(255, 0)
b = GetPrivateProfileString("config", "firsttime", "", a, 255, "F:\sjsx\sjsx.ini")
MsgBox a
MsgBox b
End Sub

#1



'************************************************************************************
'GetINI(FileURL, Name)  获取需要的初始文件的值
    'FileURL    文件路径
    'Name   需要获取的记录名
'************************************************************************************

Function GetINI(FileURL, Name)
    Dim INIStr
    Dim StartPoint
    Dim EndPoint
    Dim Lenth
    Dim UpPart
    Dim MidPart
    Dim DownPart
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(FileURL) Then '确定文件存在
        Set file = FSO.opentextfile(FileURL, 1) '只读方式打开文件
        INIStr = vbCrLf & file.readall & vbCrLf
        
        StartPoint = InStr(1, INIStr, vbCrLf & Name & "=")
        If StartPoint > 0 Then  '搜索到插入点
        
            Lenth = Len(vbCrLf & Name & "=")
            
            UpPart = CutCL(Left(INIStr, StartPoint - 1))
            'MidPart = Mid(INIStr, StartPoint, Lenth)
            DownPart = Right(INIStr, Len(INIStr) - Lenth - StartPoint + 1)
            MidPart = Left(DownPart, InStr(1, DownPart, vbCrLf) - 1)
            DownPart = CutCL(Right(DownPart, Len(DownPart) - InStr(1, DownPart, vbCrLf) + 1))
        
            GetINI = MidPart
        Else
            GetINI = ""
        End If
    Else
        GetINI = ""
    End If
        
End Function

'************************************************************************************
'WriteINI(FileURL, Name,WriteValue)  写入需要的初始文件的值
    'FileURL    文件路径
    'Name   需要获取的记录名
    'WriteValue 写入记录的值
'************************************************************************************

Sub WriteINI(FileURL, Name, WriteValue)
    Dim OutINI
    
    Dim INIStr
    Dim StartPoint
    Dim EndPoint
    Dim Lenth
    Dim UpPart
    Dim MidPart
    Dim DownPart
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FileExists(FileURL) Then
        Set FS = CreateObject("Scripting.FileSystemObject")
        Set a = FS.CreateTextFile(FileURL, True)
        a.WriteLine ("[COMSet Information]" & vbCrLf & "CommPort=1" & vbCrLf & "BaudRate=9600" & vbCrLf & vbCrLf & "[Serial Code Settings]" & vbCrLf & "机器码=" & SNFormat(MotherCode()) & vbCrLf & "校验码=" & vbCrLf & "")
        a.Close
        Set FS = Nothing
    End If
    Set file = FSO.opentextfile(FileURL, 1)
    INIStr = vbCrLf & file.readall & vbCrLf
    file.Close
    
    If GetINI(FileURL, Name) <> "" Then
        'Name Exist and Name<>Empty
        StartPoint = InStr(1, INIStr, vbCrLf & Name & "=")
        Lenth = Len(vbCrLf & Name & "=")
        
        DownPart = Right(INIStr, Len(INIStr) - Lenth - StartPoint + 1)
        
        UpPart = CutCL(Left(INIStr, StartPoint - 1))
        MidPart = Left(DownPart, InStr(1, DownPart, vbCrLf) - 1)
        DownPart = CutCL(Right(DownPart, Len(DownPart) - InStr(1, DownPart, vbCrLf) + 1))
        OutINI = UpPart & vbCrLf & Name & "=" & WriteValue & vbCrLf & DownPart
    ElseIf InStr(1, INIStr, Name) <> 0 Then
        'Name Exist But Name=Empty
        StartPoint = InStr(1, INIStr, vbCrLf & Name & "=")
        Lenth = Len(vbCrLf & Name & "=")
        
        DownPart = Right(INIStr, Len(INIStr) - Lenth - StartPoint + 1)
        
        UpPart = CutCL(Left(INIStr, StartPoint - 1))
        MidPart = Left(DownPart, InStr(1, DownPart, vbCrLf) - 1)
        DownPart = CutCL(Right(DownPart, Len(DownPart) - InStr(1, DownPart, vbCrLf) + 1))
        OutINI = UpPart & vbCrLf & Name & "=" & WriteValue & vbCrLf & DownPart
    Else
        'Name Not Exist
        OutINI = CutCL(INIStr) & vbCrLf & Name & "=" & WriteValue
    End If
        
    Set file = FSO.opentextfile(FileURL, 2)
    file.WriteLine (OutINI)
    file.Close
End Sub

#2


这个看不太懂呀。能不能给个详细点的示例?我是不是还要添加类模块??

#3


看不太懂呀。能不能给个详细的例子。另外我是不是要添加类模块??????????

#4


LZ想多了,只要用2个函数就可以解决:
1、读取ini文件的内容:
GetPrivateProfileString "config", "firsttime", "", strval, Len(strval), "C:\sjsx\sjsx.ini"

2、对日期时间格式化后进行比较
格式化日期时间:
Format$(Now(), "yyyymmddhhmmss")

#5


引用 4 楼  的回复:
LZ想多了,只要用2个函数就可以解决:
1、读取ini文件的内容:
GetPrivateProfileString "config", "firsttime", "", strval, Len(strval), "C:\sjsx\sjsx.ini"

2、对日期时间格式化后进行比较
格式化日期时间:
Format$(Now(), "yyyymmddhhmmss")


我这样编辑了一个 您看对吗?为啥我一执行就会系统报错。退出vb

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
Dim a As String
Dim b As String
a = String(255, 0)
Private Sub Command1_Click()
b = GetPrivateProfileString("config", "firsttime", "", a, 255, "F:\sjsx\sjsx.ini")
msgbox b
End Sub

#6


通用部分有点问题,你改成:
Private Sub Command1_Click()
Dim a As String * 255
Dim b As String

b = GetPrivateProfileString("config", "firsttime", "", a, 255, "F:\sjsx\sjsx.ini")
msgbox b
End Sub

#7


另外,你的msgbox想显示出的返回值不知道是不是应该是获取ini文件里的值,如果是的话应该返回a。

Private Sub Command1_Click()
Dim a As String
Dim b As String
a = String(255, 0)
b = GetPrivateProfileString("config", "firsttime", "", a, 255, "F:\sjsx\sjsx.ini")
MsgBox a
MsgBox b
End Sub