IDC资讯中心
文件名SourceDB.ini文件
PrivateDeclareFunctionGetPrivateProfileStringLib"kernel32"Alias
"GetPrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsAny,ByVal
lpDefaultAsString,ByVallpReturnedStringAsString,ByValnSizeAsLong,ByVal
lpFileNameAsString)AsLong
PrivateDeclareFunctionWritePrivateProfileStringLib"kernel32"Alias
"WritePrivateProfileStringA"(ByVallpApplicationNameAsString,ByVallpKeyNameAsAny,ByVal
lpStringAsAny,ByVallpFileNameAsString)AsLong
以下两个函数,读/写ini文件,固定节点setting,in_key为写入/读取的主键
仅仅针对是非值
Y：yes,N：no,E：error
PublicFunctionGetIniTF(ByValIn_KeyAsString)AsBoolean
OnErrorGoToGetIniTFErr
GetIniTF=True
DimGetStrAsString
GetStr=VBA.String(128,0)
GetPrivateProfileString"Setting",In_Key,"",GetStr,256,App.Path&"\SourceDB.ini"
GetStr=VBA.Replace(GetStr,VBA.Chr(0),"")
IfGetStr="1"Then
GetIniTF=True
GetStr=""
Else
GoToGetIniTFErr
EndIf
ExitFunction
GetIniTFErr:
Err.Clear
GetIniTF=False
GetStr=""
EndFunction
PublicFunctionWriteIniTF(ByValIn_KeyAsString,ByValIn_DataAsBoolean)AsBoolean
OnErrorGoToWriteIniTFErr
WriteIniTF=True
IfIn_Data=TrueThen
WritePrivateProfileString"Setting",In_Key,"1",App.Path&"\SourceDB.ini"
Else
WritePrivateProfileString"Setting",In_Key,"0",App.Path&"\SourceDB.ini"
EndIf
ExitFunction
WriteIniTFErr:
Err.Clear
WriteIniTF=False
EndFunction
以下两个函数,读/写ini文件,不固定节点,in_key为写入/读取的主键
针对字符串值
空值表示出错
PublicFunctionGetIniStr(ByValAppNameAsString,ByValIn_KeyAsString)AsString
OnErrorGoToGetIniStrErr
IfVBA.Trim(In_Key)=""Then
GoToGetIniStrErr
EndIf
DimGetStrAsString
GetStr=VBA.String(128,0)
GetPrivateProfileStringAppName,In_Key,"",GetStr,256,App.Path&"\SourceDB.ini"
GetStr=VBA.Replace(GetStr,VBA.Chr(0),"")
IfGetStr=""Then
GoToGetIniStrErr
Else
GetIniStr=GetStr
GetStr=""
EndIf
ExitFunction
GetIniStrErr:
Err.Clear
GetIniStr=""
GetStr=""
EndFunction
PublicFunctionWriteIniStr(ByValAppNameAsString,ByValIn_KeyAsString,ByValIn_DataAsString)AsBoolean
OnErrorGoToWriteIniStrErr
WriteIniStr=True
IfVBA.Trim(In_Data)=""OrVBA.Trim(In_Key)=""OrVBA.Trim(AppName)=""Then
GoToWriteIniStrErr
Else
WritePrivateProfileStringAppName,In_Key,In_Data,App.Path&"\SourceDB.ini"
EndIf
ExitFunction
WriteIniStrErr:
Err.Clear
WriteIniStr=False
EndFunction
->
