[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")
1、读取ini文件的内容:
GetPrivateProfileString "config", "firsttime", "", strval, Len(strval), "C:\sjsx\sjsx.ini"
2、对日期时间格式化后进行比较
格式化日期时间:
Format$(Now(), "yyyymmddhhmmss")
#5
我这样编辑了一个 您看对吗?为啥我一执行就会系统报错。退出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
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
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")
1、读取ini文件的内容:
GetPrivateProfileString "config", "firsttime", "", strval, Len(strval), "C:\sjsx\sjsx.ini"
2、对日期时间格式化后进行比较
格式化日期时间:
Format$(Now(), "yyyymmddhhmmss")
#5
我这样编辑了一个 您看对吗?为啥我一执行就会系统报错。退出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
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
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