profile.cls

通用抽奖程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Profile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private 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
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 WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, 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
'注意:这里每一项定义前都加上了"Private"关键字,原因是在类模块中进行定义,"P rivate"关键字是必要的。这几个API函数的用法 ,可查阅Win32 API帮助文件。
'为了能从API函数中返回字符串 , 调用时参数一定要使用VB中的定长字符串变量?为了减少内存的分配次数, 可定义一个类中的全局变量来保存数据:
Const BufSize = 10240
Dim buf As String * BufSize
'buf长度定义为10K , 该长度可以根据具体需要来增大或减少?
'由于.ini是以文件的形式存在 , 故可为这个类定义一个变量来保存文件名及其路径:
Public FileName As String
'注意:该定义使用了"Public"关键字,说明使用该类时可以读写该变量。另有两个变量是为下面的算法定义的,它们是:
Dim Ret As Long
Dim Start As Long


'接下来为该类实现两个最基本的功能函数:
Public Sub SetValue(ByVal clsName As String, ByVal key As String, ByVal V As String)
    Ret = WritePrivateProfileString(clsName, key, V, FileName)
End Sub

Public Function GetValue(ByVal clsName As String, ByVal key As String) As String
    Ret = GetPrivateProfileString(clsName, key, "", buf, BufSize, FileName)
    Start = 1
    GetValue = RetStr()
End Function

'SetValue是根据指定的主题(clsName),增加或修改一条"变量名/ 对应值"对(Key/Va lue)。这一过程仅仅是调用了相应的API函数,比较容易理解。GetValue函数与其互补,是根据指定的主题和变量名,提取对应的值。该函数除了调用了API函数之外,还调用了该类中的RetS tr()函数,该函数形式如下:
Private Function RetStr() As String
    Dim i As Long
    i = InStr(Start, buf, Chr(0))
    If i > Start Then
      RetStr = Mid(buf, Start, i - Start)
    End If
    Start = i + 1
End Function

'RetStr函数的一个功能是返回一个正确长度的字符串。因为buf 被定义为固定长度,而实际的数据应该小于这一长度,所以要根据C字符串的零结尾符(‘\0’),提取正确长度的字符串,以便为下面的两个函数提供方便。
'有时候需要知道在一个主题下,有多少个"变量名/对应值"对,API 函数GetPrivatePr ofileSection就是来实现这一点的,它将指定主题下的所有"变量名/对应值"对一起返回,之间用零(‘0\’)隔开,分解时比较麻烦,但可用下面两个函数来简化这一过程:
Public Function FirstValue(ByVal clsName As String) As String
 Ret = GetPrivateProfileSection(clsName, buf, BufSize, FileName)
 Start = 1
 FirstValue = RetStr()
End Function

Public Function NextValue() As String
 NextValue = RetStr()
End Function
'调用FirstValue来提取指定主题的第一个"变量名/对应值"对,形式为:
'Key=Value,
'然后再调用NextValue提取下一个 , 直到返回一个零长的字符串为止, 表示提取结束?
'到此 , 这个ProFile类就完成了?