敬业的IT人 互联网 佚名 2008-4-17 17:10:36

'文件名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

最新文章

计算两个日期间的工作日[04-17]

用VisualBasic设计个性化文件夹图标[04-17]

用Winsock控件实现文件的下载[04-17]

VB的坐标系统综述[04-17]

如何在VB6.0中创建和使用文本资源文件[04-17]

在VB6.0中实现动态统计报表[04-17]

相关文章