现金求INI操作程序我的QQ 3337976可以先发淘宝支付。。。求一个能对INI操作的程序,并能读取MS SQL 与 MYSQL[
现金求INI操作程序
我的QQ 3337976
可以先发淘宝支付。。。
求一个能对INI操作的程序,并能读取MS SQL 与 MYSQL
[解决办法]
- VB code
Option ExplicitPrivate 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 pFileName As String) As LongPrivate Declare Function WritePrivateProfileString Lib "KERNEL32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As LongPrivate Declare Function GetPrivateProfileSection Lib "KERNEL32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long'************************************* '目的:写入数据至Ini文件 '输入: FileName 文件名 ' AppName 项目名 ' In_Key 键名 ' In_Data 键名上的数值 '返回: 写入成功 True ' 写入失败 False '*************************************Public Function WriteIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As BooleanOn Error GoTo WriteIniStrErrWriteIniStr = TrueIf VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then GoTo WriteIniStrErrElse WritePrivateProfileString AppName, In_Key, In_Data, FileNameEnd IfExit FunctionWriteIniStrErr: Err.Clear WriteIniStr = FalseEnd Function'************************************* '目的:从Ini文件中读取数据 '输入: FileName 文件名 ' AppName 项目名 ' In_Key 键名 '返回: 取得给定键名上的数据 '*************************************Public Function GetIniStr(ByVal FileName As String, ByVal AppName As String, ByVal In_Key As String) As StringOn Error GoTo GetIniStrErrIf VBA.Trim(In_Key) = "" Then GoTo GetIniStrErrEnd IfDim GetStr As String GetStr = VBA.String(128, 0) GetPrivateProfileString AppName, In_Key, "", GetStr, 256, FileName GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")If GetStr = "" Then GoTo GetIniStrErrElse GetIniStr = GetStr GetStr = ""End IfExit FunctionGetIniStrErr: Err.Clear GetIniStr = "" GetStr = ""End Function'************************************* '目的:编历Ini文件中的某个主键 '输入: FileName 文件名 ' AppName 项目名 '返回:某个项目下的所有键及值 '*************************************Public Function GetInfoSection(AppName As String, FileName As String) As String() Dim strReturn As String * 32767 Dim strTmp As String Dim nStart As Integer Dim nEnd As Integer Dim i As Integer Dim sArray() As String Call GetPrivateProfileSection(AppName, strReturn, Len(strReturn), FileName) strTmp = strReturn i = 1 Do While strTmp <> "" nStart = nEnd + 1 nEnd = InStr(nStart, strReturn, vbNullChar) strTmp = Mid$(strReturn, nStart, nEnd - nStart) If Len(strTmp) > 0 Then ReDim Preserve sArray(1 To i) sArray(i) = strTmp i = i + 1 End If Loop GetInfoSection = sArray End Function
[解决办法]
