VBS小练习

绝地灬酷狼 2023-01-15 03:44 85阅读 0赞

## 任务1 实现VERIFY( condition) 的子函数。 ##

如果condition 为TRUE 则 正常结束
    如果condition 为FALSE， 则弹出Msgbox 文字对应Condition条件，图标为警告消息图标，vbs内置实现。

## 任务2.实现某个整型值取位，和设置位。 ##

**2.1实现一个子函数，判断整型值第n位是 0或1 ——》GetStatus（value，nbitIndex）**

Option Explicit
    
    
    
    Dim value,nbitIndex,judgeInt
    value = 1024
    nbitIndex = 0
    judgeInt = GetStatus(value,nbitIndex)
    
    Function GetStatus(value,nbitIndex)
        Dim bitStr,binStr
    	nbitIndex = nbitIndex + 1
        binStr = GetBinarry(value)
        bitStr = Mid(binStr,nbitIndex,1)
        
        If bitStr = 1 Then
            GetStatus = True
        ElseIf bitStr = 0 Then
            GetStatus = False
        Else
            MsgBox "既不是0也不是1！"
        End If
    End Function
    
    rem 十进制数字转二进制
    Function GetBinarry(intValue)
        Dim valueStr,t
        Rem 转换二进制
        Do
            t = intValue \ 2
            valueStr = valueStr & intValue Mod 2
            intValue = t
        Loop Until intValue < 1
        
        Rem 取出需要的位
        GetBinarry = StrReverse(valueStr)
    End Function
    
    MsgBox judgeInt

**2.2实现一个子函数, 对整型值第n位写 0或1——》SetStatus（value，nbitIndex, nbitval）**

Option Explicit
    
    Dim value,nbitIndex,result,nbitval
    value = 1024
    nbitIndex = 5
    nbitval = 1
    
    Rem 二进制
    
    result = SetStatus(value,nbitIndex,nbitval)
    
    Function SetStatus(value,nbitIndex,nbitva)
        Dim bitStr,binarry
        binarry = GetBinarry(value)
        Rem 取指定位
        bitStr = Mid(binarry,nbitIndex + 1,1)
        bitStr = nbitva
        SetStatus = Left(binarry,nbitIndex) & bitStr & Right(binarry,Len(binarry) - 1 - nbitIndex)
    End Function
    
    Rem 十进制数字转二进制
    Function GetBinarry(intValue)
        Dim valueStr,t
        Rem 转换二进制
        Do
            t = intValue \ 2
            valueStr = valueStr & intValue Mod 2
            intValue = t
        Loop Until intValue < 1
        
        Rem 取出需要的位
        GetBinarry = StrReverse(valueStr)
    End Function
    
    MsgBox result

**2.3实现一个子函数，整型值与特定整型值 实现与逻辑。SetMask（value，nMask）**  
**在监控中调用对应子函数，实现数据变化显示。**

Option Explicit
    
    Dim value,nMask
    Rem 4二进制为100
    value = 4
    Rem 5二进制为101，按位相与结果应为110
    nMask = 5
    MsgBox SetMask(value,nMask)
    
    Rem 返回相与结果0 / 1
    Function SetMask(value,nMask)
        Dim i,j,k
        Dim chrV,chrN,result
        Rem 转二进制
        value = GetBinarry(value)
        nMask = GetBinarry(nMask)
        i = Len(value)
        j = Len(nMask)
        If i < j Then
            i = j
        End If
        For k = 1 To i
            chrV = Mid(value,k,1)
            chrN = Mid(nMask,k,1)
            If chrN <> chrV Then
                SetMask = SetMask & 0
            Else
                SetMask = SetMask & 1
            End If
        Next
    End Function
    
    Rem 十进制数字转二进制
    Function GetBinarry(intValue)
        Dim valueStr,t
        Rem 转换二进制
        Do
            t = intValue \ 2
            valueStr = valueStr & intValue Mod 2
            intValue = t
        Loop Until intValue < 1
        
        Rem 取出需要的位
        GetBinarry = StrReverse(valueStr)
    End Function

## 任务3.实现3个函数的测试代码 ##

**比如 VerifyGetStatus( )  
\{  
VERIFY(FALSE =GetStatus（1024，0）) '取1024的低位0位，返回false为正确代码  
VERIFY(TRUE =GetStatus（1024，1）) '取1024的低位1位，返回true为错误代码  
\}**

Option Explicit
    
    
    msgbox Verify(false=GetStatus(1024,1))
    
    Function Verify(condition)
        If condition = True Then
    	Verify = true
            Exit Function
        ElseIf condition = False Then
    	Verify = false
            MsgBox condition,vbExclamation
        Else
            MsgBox "参数错误"
        End If
    End Function
    
    Function GetStatus(value,nbitIndex)
        Dim str,bitStr
        Rem 转换字符串
        str = CStr(value)
        Rem 取左边字符串
        bitStr = Left(str,nbitIndex + 1)
        Rem 取右边第一个字符
        bitStr = Right(bitStr,1)
        If bitStr = "1" Then
            GetStatus = True
        Else
            GetStatus = False
        End If
    End Function

## 任务4.读取一个文本文件， ##

**找到文档里含有ABC的字符串的信息，存储在数组中，最终返回含有“ABC”字串的个数。  
注1.不考虑字母大小写，只要大小写完全匹配，  
注2.需考虑文件读取异常处理  
函数名 参数定义如下  
int GetStringCount(filename ,deststring)  
'filename 文件路径  
',deststring 目标字串  
返回值： 含有特定文字的行数。**

Option Explicit
    
    Dim filename,destString
    filename = "test.txt"
    destString = "ABC"
    Call GetStringCount(filename,destString)
    
    Function GetStringCount(filename,destString)
        On Error Resume Next
        Dim fs,file,readStr,regEx,num,matches,match
        Rem 创建文件对象
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set file = fs.OpenTextFile(filename, 1, False)
        readStr = file.readall
        Set fs = Nothing
        file.close
        If   Err <> 0   Then
            MsgBox   "文件读取失败，请检查文件路径"
        Else
            Rem 记录字串个数
            num = 0
            Set regEx = New RegExp
            
            regEx.Pattern = destString
            regEx.Global = True
            Rem 正则取得的字串
            Set matches = regEx.execute(readStr)
            For Each match  In matches
                num = num + 1
            Next
            MsgBox "字串个数为：" & num
            GetStringCount = num
        End If
    End Function

## 5、在本vbs文件调用另一个vbs脚本的function方法 ##

Option Explicit
    
    Rem 引入需要的vbs脚本函数
    Function Include(strFileName)
        Dim objFileContent
        Set objFileContent = CreateObject("Scripting.FileSystemObject").OpenTextFile(strFileName,1,False)
        ExecuteGlobal objFileContent.ReadAll
        Set objFileContent = Nothing
    End Function
    
    Rem 默认引用脚本在当前同目录，也可以修改为绝对路径
    Dim dirPath
    dirPath = CreateObject("Scripting.FileSystemObject").GetFile(WScript.ScriptFullName).ParentFolder.Path
    
    Rem 引入A.vbs
    Call Include(dirPath & "\A.vbs")
    
    Dim result
    result = total(1)
    MsgBox result
    
    Function total(a)
        Dim ret,I
        For I = 1 To a
            ret = add(I,I + 1)
        Next    
        total = ret
    End Function

**A.vbs:**

Option Explicit
    
    Function add(a,b)
    	add = a+b
    end Function

## 6、二进制转十进制以及移位计算 ##

Option Explicit
    
    Dim value,nMask
    value = 101
    nMask = 5
    MsgBox LShift(B2D(value),1)
    MsgBox LShift(nMask,1)
    Function LShift(Value, Shift)
        Dim sc
        Set sc = CreateObject("MSScriptControl.ScriptControl")
        sc.Language = "JScript"
        LShift = sc.Eval(Value & "<<" & Shift)
    End Function
    
    Function RShift(Value, Shift)
        Dim sc
        Set sc = CreateObject("MSScriptControl.ScriptControl")
        sc.Language = "JScript"
        RShift = sc.Eval(Value & ">>" & Shift)
    End Function
    
    Public Function B2D(vBStr)
        Dim vLen  '串长 Dim vDec '结果
        Dim vG      '权值 Dim vI '位数
        Dim vTmp   '临时串 Dim vN '中间值
        vLen = Len(vBStr)
        vG = 1 '初始权值 vDec = 0 '结果初值
        B2D = vDec '返回初值 For vI = vLen To 1 Step - 1 vTmp = Mid(vBStr, vI, 1) '取出当前位
            vN = vTmp
            If vN < 2 Then  '判断是不是合法二进制串,貌似不严谨,E文和符号会被判0而合法 vDec = vDec + vG * vN '得到中间结果
            vG = vG + vG
        Else
            vDec = 0
            'msgbox "不是有效的二进制数",vbokonly
            Exit Function
        End If
    Next
    
    B2D = vDec
    End Function