www.pudn.com > dog_oper.rar > dog_oper.bas

Const Daoqi As String = "汪！汪！，请与本公司联系！" 
 
Sub Exist_Dog_YN()   '检查是否存在软件狗 
    Dim DogAddr(5) As Integer 
    Dim Address As Integer 
    Dim DogBytes As Long 
    Dim DogData As String 
    Dim y As Long, addResult As Integer, xorResult As Integer 
    DogBytes = 1 
    Address = 1 
    DogData = "A" 
    y = DogRead(DogBytes, Address, DogData) 
    If y <> 0 Then 
        MsgBox Daoqi 
        SetRegValue 
        hasDog = False 
    Else 
        DogAddr(0) = 3 : DogAddr(1) = 12 : DogAddr(2) = 21 : DogAddr(3) = 38 : DogAddr(4) = 97 
        DogBytes = 1 :  DogData = "A" 
        addResult = 0 
        For i = 0 To 4 
            Address = DogAddr(i) 
            y = DogRead(DogBytes, Address, DogData) 
            addResult = addResult + Asc(DogData) 
        Next i 
         
        DogAddr(0) = 16 :  DogAddr(1) = 38 : DogAddr(2) = 62:DogAddr(3) = 77:DogAddr(4) = 88 
        xorResult = 0 
        For i = 0 To 4 
            Address = DogAddr(i) 
            y = DogRead(DogBytes, Address, DogData) 
            xorResult = xorResult Xor Asc(DogData) 
        Next i 
        If addResult <> 140 Or xorResult <> 51 Then 
            SetRegValue 
            hasDog = False 
        Else 
            hasDog = True 
        End If 
    End If 
End Sub 
 
Sub SET_Dog()    ' 设置狗参数 
    On Error Resume Next 
    sysFileNum = FreeFile 
    RemainTimes = RemainTimes + 1 
    SetKeyValue HKEY_CURRENT_USER, "Software\dog", "XXSS", CStr(RemainTimes), REG_SZ 
    Open sysFileName For Random As sysFileNum Len = Len(sysFileNum) 
    Put sysFileNum, 388, CByte(RemainTimes) 
    If RemainTimes > 144 Then 
        RemainDays = RemainDays - 1 
        Put sysFileNum, 388, CByte(0) 
        Put sysFileNum, 288, CByte((RemainDays + 13) * 3 + 18) 
        SetKeyValue HKEY_CURRENT_USER, "Software\dog", QQWW, CStr((RemainDays + 20) * 5 + 10), REG_SZ 
        If RemainDays = 0 Then 
            MsgBox Daoqi 
            End 
        End If 
        RemainTimes = 0 
    End If 
    Close sysFileNum 
    lblRemainDays.ToolTipText = "还有大约" & RemainDays & "天可用" 
End Sub