cstringbuffer.cls

vb做的网易评论自动采集软件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CStringBuffer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Module:        CStringBuffer
'Author:        [e-mail]
'Data:            2007-4-6
'Description:    字符串缓存类
'Dependence:
'Interface:
Option Explicit
Private sModuleName As String
Private m_sBuffer() As String '数组
Private m_lLength As Long
Private m_lBuffer As Long
Private m_lBufferInc As Long
Private m_bUserLength As Boolean  '用户是否设置过Length

Private Sub Class_Initialize()
    sModuleName = "CStringBuffer"
    m_lLength = 0
    m_lBuffer = 20
    m_lBufferInc = 20
    m_bUserLength = False
    'define in ASPClassLib.asp or other head file
    ReDim m_sBuffer(m_lBuffer)
End Sub

'设置或取得Array数组
Public Property Let BufferArray(ByRef vArray() As String)
    m_sBuffer = vArray
    m_lLength = UBound(vArray)
    m_lBuffer = m_lLength
End Property
Public Property Get BufferArray() As String()
    BufferArray = m_sBuffer
End Property

Public Function getArray() As String()
    Dim retArray
    retArray = m_sBuffer
    ReDim retArray(m_lLength)
    getArray = retArray
End Function



'长度
Public Property Let Length(ByVal vData As Long)
    m_bUserLength = False
    m_lBuffer = m_lLength + 1
    m_lLength = vData
    ReDim Preserve m_sBuffer(m_lBuffer)
End Property
Public Property Get Length() As Long
    Length = m_lLength
End Property


'缓存长度
Public Property Let Buffer(ByVal vData As Long)
    m_lBuffer = vData
    ReDim m_sBuffer(m_lBuffer)
End Property
Public Property Get Buffer() As Long
    Buffer = m_lBuffer
End Property

'缓存递增长度
Public Property Let BufferInc(ByVal vData As Long)
    m_lBufferInc = vData
End Property
Public Property Get BufferInc() As Long
    BufferInc = m_lBufferInc
End Property

'缓存内的字符串项目
Public Property Let Item(ByVal idx As Long, ByVal vData As String)
    m_bUserLength = False
    If idx > m_lLength Then m_lLength = idx
    If idx >= m_lBuffer Then
        m_lBuffer = m_lBuffer + m_lBufferInc
        ReDim Preserve m_sBuffer(m_lBuffer)
    End If
    m_sBuffer(idx) = vData
End Property
Public Property Get Item(ByVal idx As Long) As String
    Item = m_sBuffer(idx)
End Property

'总体字符串
Public Property Let Content(ByVal vData As String)
    ReDim Preserve m_sBuffer(1)
    m_lLength = 0
    m_sBuffer(0) = vData
End Property
Public Property Get Content() As String
    If m_bUserLength Then m_lLength = m_lLength - 1
    ReDim Preserve m_sBuffer(m_lLength)
    Content = Join(m_sBuffer, "")
End Property

'合并字符串
Public Function JoinString(ByVal sDelimiter As String) As String
    Dim sReturn
    If m_bUserLength Then m_lLength = m_lLength - 1
    If m_lLength > 0 Then
        ReDim Preserve m_sBuffer(m_lLength)
        sReturn = Join(m_sBuffer, sDelimiter)
    Else
        sReturn = ""
    End If
    ReDim Preserve m_sBuffer(m_lBuffer)
    JoinString = sReturn
End Function

'清空缓存
Public Sub Clear()
    m_lLength = 0
    m_lBuffer = 20
    ReDim m_sBuffer(m_lBuffer)
End Sub

'添加项目到缓存
Public Sub AddString(ByVal vData As String)
    m_bUserLength = True
    m_sBuffer(m_lLength) = vData
    m_lLength = m_lLength + 1
    If m_lLength >= m_lBuffer Then
        m_lBuffer = m_lBuffer + m_lBufferInc
        ReDim Preserve m_sBuffer(m_lBuffer)
    End If
End Sub