Private IsGOD As Boolean
Public Function CheckRTC() As Boolean
' Application.StatusBar = "Professional usage All rights reserved by ASB. Consultation Tel:021-50554520-4308 Version 4.1.1"
IsGOD = True
'sanity check
'HASPInitial
If IsGOD Then
CheckRTC = True
Exit Function
End If
CheckRTC = False
'If (Nothing Is hasp) Then
' HSAPClose hasp
' MsgBox "No HASP dongle"
' Exit Function
'End If
'If (Not hasp.IsLoggedIn) Then
' HSAPClose hasp
' MsgBox "HASP dongle failed to login"
' Exit Function
'End If
'Dim result As AKSHASP.HaspData
'Set result = hasp.GetRtc
'ReportStatus (result.status)
'If (AKSHASP.haspStatusOk = result.status) Then
' MsgBox "Real Time Clock is " & _
FormatDateTime(result.Date, vbLongDate) & " " & _
FormatDateTime(result.Date, vbLongTime)
' CheckRTC = True
'Else
' MsgBox "No HASP dongle"
'End If
'HSAPClose hasp
Dim licFileName As String
licFileName = ThisWorkbook.path & "\License.dat"
On Error GoTo NOTFILE
'Open licFileName For Input As #1
Open licFileName For Binary As #1
Dim str() As Byte
Dim licstr As String
If LOF(1) > 0 Then
ReDim str(LOF(1)) As Byte
Get #1, 1, str
Dim i As Integer
Dim lavl As Long
Dim cval As String
For i = 0 To LOF(1) - 4
lval = str(i) + 256 (str(i + 1) + 256 (str(i + 2) + 256 str(i + 3)))
cval = Chr(lval / 255)
licstr = licstr & cval
i = i + 3
Next i
' While Not EOF(1)
'Line Input #1, str
' licstr = licstr & str
' Wend
Else
FrmShowSN.Show
Exit Function
End If
Close #1
Dim sn As String
Dim omcr As String
Dim time_limit As String
Dim macro_licence As Variant
macro_licence = Split(licstr, ",")
sn = macro_licence(0)
omcr = macro_licence(1)
time_limit = macro_licence(2)
Dim driver As String
Dim volumnno As String
Dim volumnsn As Long
Dim sysname As String
Dim filelen As Long
Dim filetype As Long
driver = "c:\"
GetVolumeInformation driver, volumnno, 256, volumnsn, filelen, filetype, sysanme, 256
volumnsn = Abs(volumnsn)
Dim rel As Long
Dim rndval As Long
Dim pos As Integer
Dim res As Long
pos = InStr(1, sn, "-")
rel = Mid(sn, pos + 1, Len(sn))
rndval = Mid(sn, pos - 4, 4)
res = Mid(sn, 1, pos - 5)
res = res rndval + rel
If res (volumnsn + 12315) Then
FrmShowSN.Show
Exit Function
End If
Dim time_sys As String
time_sys = Format(Now, "yyyy-mm-dd")
If time_sys > time_limit Then
MsgBox "The licence was unavailable.Please apply it again."
FrmShowSN.Show
Exit Function
End If
CheckRTC = True
Exit Function
NOTFILE:
' MsgBox "Notfile"
FrmShowSN.Show
CheckRTC = False
Close #1
End Function
'Public Sub HSAPClose(key As AKSHASP.hasp)
' If (Nothing Is key) Then
' Exit Sub
' End If
' If (Not key.IsLoggedIn) Then
' Exit Sub
' End If
' Dim status As Long
' status = key.Logout()
' Set key = Nothing
' Set haspApp = Nothing
' Set feature = Nothing
' Set feature = Nothing
'End Sub
联系我们 - 问通信专家 | Powered by MSCBSC 移动通信网 © 2006 - |