最近要编写个vbs小程序,但vbs程序的调试很麻烦,所以考虑用Excel的VBA调试,毕竟vbs和vba还是很相似的。一个要实现的功能就是从ini文件中读取信息,网上找到了一些很好的代码,这里收藏了!
功能实现函数如下
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
'********************************************************************
'* Sub : ReadFromIni and
WriteIntoIni '*
'* Purpose: 读写INI文件
'*
'********************************************************************
Public Function ReadFromIni(ByVal IniFile As String, ByVal Section
As String, ByVal Key As String, ByVal DefaultValue As String) As
String
Dim strRtn As String
strRtn = Space(256)
Dim lngRtn As Long
lngRtn = GetPrivateProfileString(Section, Key, DefaultValue,
strRtn, 255, IniFile)
If lngRtn > 0 Then
strRtn = Trim(strRtn)
ReadFromIni = Mid(strRtn, 1, Len(strRtn) - 1)
Else
ReadFromIni = DefaultValue
End If
End Function
Public Sub WriteIntoIni(ByVal IniFile As String, ByVal Section
As String, ByVal Key As String, ByVal Value As String)
Dim lngRtn As Long
lngRtn = WritePrivateProfileString(Section, Key, Value,
IniFile)
If lngRtn > 0 Then
Else
Call Err.Raise(-1, "IniFileUtil.WriteIntoIni", "Failed to
write")
End If
End Sub
函数使用测试如下
Sub Main()
Dim strIniFile As String
strIniFile = ActiveWorkbook.Path &
"\example.ini"
Dim strSection As String
strSection = "Application"
Dim strKey As String
strKey = "Version"
Dim strValue As String
strValue = "1.0.30"
Call WriteIntoIni(strIniFile, strSection, strKey, strValue)
strValue = ReadFromIni(strIniFile, strSection, strKey, "")
MsgBox "Version = " & strValue, vbInformation
End Sub
运行上面的函数,程序会在当前目录生成一个example.ini文件,并向里面写入如下信息
[Application]
Version=1.0.30
然后再读取显示出来,如下
不过很坑爹的是这个函数貌似在vbs中还运行不了,由于时间比较紧,所以又找了其他的代码实现。建立如下vbs脚本,从刚才的example.ini文件中读取信息
' 读INI文件
strIniFile = ".\example.ini"
strTemp = ReadINI(strIniFile, "Application", "Version")
MsgBox "Version = " & strTemp, vbInformation
' read函数
Function ReadINI(FilePath, Bar,
PrimaryKey)
Dim fso, sReadLine, i, j, ss
Set fso = CreateObject("Scripting.FileSystemObject")
Set IniFile = fso.opentextfile(FilePath, 1)
Do Until IniFile.atendofstream
sReadLine =
IniFile.readline
If sReadLine
= "" Then
IniFile.skipline
ElseIf
Trim(sReadLine) = "[" & Bar & "]"
Then '找到小节名
'查找该小节名下的键名
Do Until IniFile.atendofstream
sReadLine =
IniFile.readline '读取小节名后的行
j = InStr(sReadLine, "=")
If j > 0
Then '小节名后的文本行存在
If InStr(Left(sReadLine, j), PrimaryKey) > 0
Then '从"="左边字符串找到键名
ss = Trim(Right(sReadLine, Len(sReadLine) - InStr(sReadLine, "=")))
'读取等号后的部分
Exit Do
End If
End If
Loop
End If
Loop
IniFile.Close
Set fso = Nothing
ReadINI = ss
End Function
结果相同