test.txt

高亮语法类 1）了解HASH函数在网络安全中的应用 （2）掌握HASH函数实现的原理 二、要求 （1）用任何语言编程完成实现HASH函数的功能 （2）输入任何8个字节（64位）的数据

'CSyntax.cls

Option Explicit

Option Compare Binary

Public Event Progress(ByVal Value As Integer) '*处理进度

Private m_initSTX As Boolean            '语法初始化标记
Private m_oString As CStringBuilder     '大字符串连接类

Private m_sTitle            As String   '*语法文件Title

Private m_sLnCommFlag1      As String   '*行注释头一
Private m_sLnCommFlag2      As String   '*行注释头二
Private m_sBlkCommHead1     As String   '*块注释头一
Private m_sBlkCommFoot1     As String   '*块注释尾一
Private m_sBlkCommHead2     As String   '*块注释头二
Private m_sBlkCommFoot2     As String   '*块注释尾二
Private m_objCommFont       As CFont    '*注释字体设置

Private m_sCommRtfHead      As String   '*注释字体RTF格式头
Private m_sCommRtfFoot      As String   '*注释字体RTF格式尾

Private m_objNumFont        As CFont    '*数字字体设置

Private m_sNumRtfHead       As String   '*数字字体RTF格式头
Private m_sNumRtfFoot       As String   '*数字字体RTF格式尾

Private m_iKwdCount         As Integer  '*关键字类型数
Private m_sKwdSet()         As String   '*存入一类关键字的全部组合(以chr(3)分隔)
Private m_sKwdTitle()       As String   '*此关键字类型的名称
Private m_objKwdFont()      As CFont    '*此关键字类型的字体设置
Private m_sKwdRtfHead()     As String   '*关键字字体RTF格式头
Private m_sKwdRtfFoot()     As String   '*关键字字体RTF格式尾

Private m_bCase             As Boolean  '*是否大小字敏感

Private m_sQuotFlag1        As String   '*字符串边界一
Private m_sQuotFlag2        As String   '*字符串边界二
Private m_bMultiLine        As Boolean  '*是否续行有效
Private m_objQuotFont       As CFont    '*字符串字体设置
Private m_sQuotRtfHead      As String   '*字符串字体RTF格式头
Private m_sQuotRtfFoot      As String   '*字符串字体RTF格式尾

Private m_sEscape           As String   '*后面跟敏感字符，此字符后面字符忽略

Private m_objColorManager   As CColor   '*颜色管理类
Private m_sColorRtf         As String   '*RTF内颜色信息

Private m_sWord()         As String     '*对一行字符串分隔成一个词数组

Private m_iQuotState        As Integer  '*当前是否在字符串内[0..不是字符串/1..在字符串一内/2..在字符串二内]
Private m_iCommState        As Integer  '*当前注释状态[0..无注释/1..单行注释一/2..单行注释二/3..多行注释一/4..多行注释二]

Private Const DELIMITER = ",(){}[]-+*%/='~!&|\<>?:;."

'*RTF文件头(First和Last之间插入颜色和字体信息
Private Const HEAD_FIRST = "{\rtf1\ansi\ansicpg936\deff0{\fonttbl}{\colortbl ;"
Private Const HEAD_LAST = "}\viewkind4\uc1\pard\lang2052\f0\fs"  'fs** 控制字体大小

Private Const HEAD_HTML = "<PRE>"
Private Const TAIL_HTML = "</PRE>"

'----------------------VB 语法常量------------------------
Private Const STX_BASE = "#QUOTATION1="",#QUOTATION2=,#CONTINUE_QUOTE=,#LINECOMMENT=',#LINECOMMENT2=rem,#COMMENTON=,#COMMENTOFF=,#COMMENTON2=,#COMMENTOFF2=,#ESCAPE=,#CASE=n"
Private Const STX_QUOTATION = "ForeColor=0,backcolor=,bold=,italic=,underline=,strike="
Private Const STX_COMMENT = "ForeColor=33280,backcolor=,bold=,italic=,underline=,strike="
Private Const STX_NUMBER = "ForeColor=0,backcolor=,bold=,italic=,underline=,strike="
Private Const STX_OPERATOR = "ForeColor=0,backcolor=,bold=,italic=,underline=,strike="
Private Const STX_KEYWORD = "ForeColor=8388608,backcolor=,bold=,italic=,underline=,strike="
Private Const STX_FUNCTION = "ForeColor=8388608,backcolor=,bold=,italic=,underline=,strike="

Private Const VB_OPERATORS = "&,+,-,*,/,\,^,>,<,>=,<=,<>,=,%"
Private Const VB_KEYWORDS = "Access,AddressOf,Alias,And,Any,AppActivate,Append,Array,As,Base,Beep,Binary,Boolean,ByRef,ByVal,Byte," _
        & "Cancel,Call,Case,ChDir,ChDrive,Choose,Close,Collection,Compare,Const,Currency,Declare,Dim,Do,DoEvents,Double," _
        & "Each,Else,ElseIf,Empty,End,Enum,Environ,Erase,Err,Error,Exit,Explicit,False,FileCopy,For,Form,Function,Get,GoSub,GoTo," _
        & "If,In,Input,Integer,Is,Kill,Let,Lib,Like,Line,Load,Lock,Long,Loop,Me,MkDir,Mod,Module,MsgBox,New,Next," _
        & "Not,Nothing,Null,Object,On,Open,Option,Optional,Or,Output,Print,Print,Private,Property,Public,Put," _
        & "ReDim,Read,Reset,Resume,Return,RmDir,Seek,Select,SendKeys,Set,SetAttr,Shared,Shell,Single,Static,Step,Stop,String," _
        & "Sub,Switch,Tab,Then,To,True,Type,TypeName,Unlock,Until,Variant,Wend,While,With,Write,Xor"
Private Const VB_FUNCTIONS = "Abs,Asc,Atn,CBool,CByte,CCur,CDate,CDbl,CDec,CInt,CLng,CSng,CStr,CVErr,CVar,Chr,Command," _
        & "Cos,CreateObject,CurDir,DDB,Date,DateAdd,DateDiff,DatePart,DateSerial,DateValue,Day,DeleteSetting,EOF," _
        & "Eqv,Exp,FV,FileAttr,FileDateTime,FileLen,Filter,Fix,Format,FormatCurrency,FormatDateTime,FormatNumber,FormatPercent,FreeFile," _
        & "GetAllSettings,GetAttr,GetObject,GetSetting,Hex,Hour,IIf,IPmt,IRR,Imp,InStr,InStrRev,InputBox," _
        & "IsArray,IsDate,IsEmpty,IsError,IsMissing,IsNull,IsNumeric,IsObject,Join,LBound,LCase,LOF,LSet,LTrim,Left,Len," _
        & "LoadPicture,LoadResData,LoadResPicture,LoadResString,Loc,Log,MIRR,MacID,MacScript,Mid,Minute,Month,MonthName," _
        & "NPV,NPer,Now,Oct,PPmt,QBColor,RGB,RSet,RTrim,Random,Randomize,Rate,Replace,Right,Rnd,Round,SLN,SYD,SaveSetting,Second," _
        & "Sgn,Sin,Space,Split,Sqr,StrComp,StrConv,StrReverse,Tan,Time,TimeSerial,TimeValue,UBound,UCase,Val,VarPtr,VarType," _
        & "Weekday,WeekdayName,,Year"

'**************************************************************
'*HighLightRichEdit
'*功能：对控件进行语法高亮显示
'*说明：
'*传入参数：
'*    ctrl      类型：RichTextBox
'*返回参数：
'*
'*作者：progame  日期：2002-09-29  17:38:22
'**************************************************************
Public Sub HighLightRichEdit(ByRef ctrl As RichTextBox)
Dim oLoc As Long
Dim oLen As Long
    
    If Not m_initSTX Then ReadSTX     '读入语法
    
    oLoc = ctrl.SelStart
    oLen = ctrl.SelLength

    HighLightCtrl ctrl
    
    ctrl.SelStart = oLoc
    ctrl.SelLength = oLen
End Sub

Private Sub ReadSTX()
'*将语法读入
Dim i As Integer
    
    '读语法细节
    Call ReadDetail
    
    '*对字体的字符串预先生成
    m_sQuotRtfHead = m_objQuotFont.getRtfHead(m_objColorManager)
    m_sQuotRtfFoot = m_objQuotFont.getRtfTail
    m_sCommRtfHead = m_objCommFont.getRtfHead(m_objColorManager)
    m_sCommRtfFoot = m_objCommFont.getRtfTail
    
    m_sNumRtfHead = m_objNumFont.getRtfHead(m_objColorManager)
    m_sNumRtfFoot = m_objNumFont.getRtfTail
    
    m_sColorRtf = m_objColorManager.ComStr
    
    For i = 1 To m_iKwdCount
        m_sKwdRtfHead(i) = m_objKwdFont(i).getRtfHead(m_objColorManager)
        m_sKwdRtfFoot(i) = m_objKwdFont(i).getRtfTail
    Next i
    
    m_initSTX = True
End Sub

Private Sub ReadDetail()
'*读取语法的具体实现
Dim sTmp        As String
Dim i           As Integer
Dim l           As Integer
Dim lstr        As String
Dim rstr        As String
Dim readArr()   As String

    
    '*读取字符串的字体配置
    readArr = Split(STX_QUOTATION, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
        
        '读取详细内容
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objQuotFont)
    Next
    
     '*读取注释的字体配置
    readArr = Split(STX_COMMENT, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
            
        '读取详细内容
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objCommFont)
    Next
    
     '*读取数字的字体配置
    readArr = Split(STX_NUMBER, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
        
        '读取详细内容
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objNumFont)
    Next
    
    '*读取关键字
    ReadKeys "Keyword", STX_KEYWORD, VB_KEYWORDS
    ReadKeys "Operator", STX_OPERATOR, VB_OPERATORS
    ReadKeys "Function", STX_FUNCTION, VB_FUNCTIONS
    'ReadKeys "Propertie", STX_PROPERTIE, VB_PROPERTIES
    
    '*读取基本配置
    readArr = Split(STX_BASE, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        i = InStr(sTmp, "=")
        
        lstr = Trim(Left(sTmp, i - 1))
        rstr = Trim(Right(sTmp, Len(sTmp) - i))
        
        Select Case UCase(lstr)
            Case "#TITLE"
                rstr = rstr
            Case "#QUOTATION1"
                m_sQuotFlag1 = rstr
            Case "#QUOTATION2"
                m_sQuotFlag2 = rstr
            Case "#CONTINUE_QUOTE"
                m_bMultiLine = IIf(LCase(rstr) = "y", True, False)
            Case "#LINECOMMENT"
                m_sLnCommFlag1 = rstr
            Case "#LINECOMMENT2"
                m_sLnCommFlag2 = rstr
            Case "#COMMENTON"
                m_sBlkCommHead1 = rstr
            Case "#COMMENTOFF"
                m_sBlkCommFoot1 = rstr
            Case "#COMMENTON2"
                m_sBlkCommHead2 = rstr
            Case "#COMMENTOFF2"
                m_sBlkCommFoot2 = rstr
            Case "#CASE"
                m_bCase = IIf(LCase(rstr) = "y", True, False)
            Case "#ESCAPE"
                m_sEscape = rstr
            Case Else
               '
        End Select
    Next
End Sub

Private Sub PreFormat(ByRef s As String)
'*进语法文件预处理，因为到时候代码会先进行格式化以适应"}" "{" "\"
    s = Replace(Replace(Replace(s, "\", "\\"), "{", "\{"), "}", "\}")
End Sub

Private Sub ReadKeys(ByVal KeyName As String, ByVal KeySTX As String, ByVal Keywords As String)
'*读取关键字

Dim sTmp As String
Dim readArr() As String
Dim i As Integer
Dim l As Integer

    sTmp = KeyName
    m_iKwdCount = m_iKwdCount + 1
    
    ReDim Preserve m_sKwdSet(1 To m_iKwdCount)
    ReDim Preserve m_sKwdTitle(1 To m_iKwdCount)
    ReDim Preserve m_objKwdFont(1 To m_iKwdCount)
    ReDim Preserve m_sKwdRtfHead(1 To m_iKwdCount)
    ReDim Preserve m_sKwdRtfFoot(1 To m_iKwdCount)
    
    Set m_objKwdFont(m_iKwdCount) = New CFont
    
    m_sKwdTitle(m_iKwdCount) = sTmp
    m_sKwdSet(m_iKwdCount) = Chr(3)
    
    '关键字的字体配置
    readArr = Split(KeySTX, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        Call PreFormat(sTmp)
        
        i = InStr(sTmp, "=")
        Call ReadFont(sTmp, i, m_objKwdFont(m_iKwdCount))
    Next
    
    '读取关键字的详细内容
    readArr = Split(Keywords, ",")
    For l = 0 To UBound(readArr)
        sTmp = readArr(l)
        m_sKwdSet(m_iKwdCount) = m_sKwdSet(m_iKwdCount) & IIf(m_bCase, Trim(sTmp), UCase(Trim(sTmp))) & Chr(3)
    Next

End Sub

Private Sub ReadFont(ByVal sValue As String, ByVal i As Integer, ByRef Font As CFont)
'*读取文件中的字体设置
'*      i       --"="所在位置
'*      font    --要传入的字体类

Dim lstr        As String
Dim rstr        As String
    lstr = Trim(Left(sValue, i - 1))
    rstr = Trim(Right(sValue, Len(sValue) - i))
    If lstr <> "" And rstr <> "" Then
        Select Case LCase(lstr)
            Case "forecolor"
                Font.bForecolor = True
                Font.ForeColor = rstr
                m_objColorManager.AddColor CLng(rstr)
            Case "backcolor"
                Font.bBackcolor = True
                Font.BackColor = rstr
                m_objColorManager.AddColor CLng(rstr)
            Case "bold"
                Font.bold = IIf(LCase(rstr) = "y", True, False)
            Case "italic"
                Font.italic = IIf(LCase(rstr) = "y", True, False)
            Case "underline"
                Font.underline = IIf(LCase(rstr) = "y", True, False)
            Case "strike"
                Font.strike = IIf(LCase(rstr) = "y", True, False)
            Case Else
                '
                
        End Select
    End If
End Sub

Private Sub Class_Initialize()
    Set m_objColorManager = New CColor
    Set m_objCommFont = New CFont
    Set m_objQuotFont = New CFont
    Set m_objNumFont = New CFont
    Set m_oString = New CStringBuilder
End Sub

Private Sub Class_Terminate()
Dim i   As Integer

    Set m_objColorManager = Nothing
    Set m_objCommFont = Nothing
    Set m_objQuotFont = Nothing
    Set m_objNumFont = Nothing
    Set m_oString = Nothing
    
    For i = 1 To m_iKwdCount
        Set m_objKwdFont(i) = Nothing
    Next i
    
    Erase m_objKwdFont
    Erase m_sKwdTitle
    Erase m_sKwdSet
    Erase m_sKwdRtfHead
    Erase m_sKwdRtfFoot
    Erase m_sWord
End Sub

'**************************************************************
'*HighLightCtrl
'*功能：对控件进行语法高亮显示
'*说明：
'*传入参数：
'*    ctrl           类型：RichTextBox      --控件
'*返回参数：
'*
'*作者：progame  日期：2002-09-29  17:38:22
'**************************************************************
Private Sub HighLightCtrl(ByRef ctrl As RichTextBox)
Dim sLine() As String
Dim i       As Long