問題已開啟
(普通問題)
需要幫忙把EXCEL宏工具32位轉換成64位,謝謝大佬
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
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
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
提問者: 18603590154 提問時間: 2022-01-13
問題答案
( 0 )
• 廣東南方通信建設有限公司
聘:日常項目系統中高級工程師
需求人數:2 人 地點:百色市
• 北京電旗通訊技術股份有限公司 聘:網優(yōu)實習生通信應屆生(云南)
需求人數:1 人 地點:昆明市,思茅市,昭通市
• 西安長河通訊有限責任公司 聘:網絡優(yōu)化工程師
需求人數:2 人 地點:安康市
• 成都旗訊通信技術有限公司 聘:電聯招聘督導、傳輸、維護轉網優(yōu)
需求人數:12 人 地點:浙江省,江蘇省,河北省,山西省,遼寧省
• 嘉環(huán)科技股份有限公司 聘:湖南電信原廠優(yōu)化招聘
需求人數:10 人 地點:長沙市,永州市,郴州市,衡陽市
• 重慶信科通信工程有限公司 聘:南昌電信中興原廠高級
需求人數:2 人 地點:南昌市
• 西安中興精誠通訊有限公司 聘:重慶-網優(yōu)高級工程師
需求人數:2 人 地點:重慶市
• 杭州東信網絡技術有限公司 聘:LTE/5G網絡中高級優(yōu)化工程師
需求人數:2 人 地點:上海市
• 安徽引途科技有限公司 聘:皖北地區(qū)單驗測試工程師
需求人數:20 人 地點:安徽省
• 南京華蘇科技有限公司 聘:中興中高級優(yōu)化工程師
需求人數:20 人 地點:山東省
需求人數:2 人 地點:百色市
• 北京電旗通訊技術股份有限公司 聘:網優(yōu)實習生通信應屆生(云南)
需求人數:1 人 地點:昆明市,思茅市,昭通市
• 西安長河通訊有限責任公司 聘:網絡優(yōu)化工程師
需求人數:2 人 地點:安康市
• 成都旗訊通信技術有限公司 聘:電聯招聘督導、傳輸、維護轉網優(yōu)
需求人數:12 人 地點:浙江省,江蘇省,河北省,山西省,遼寧省
• 嘉環(huán)科技股份有限公司 聘:湖南電信原廠優(yōu)化招聘
需求人數:10 人 地點:長沙市,永州市,郴州市,衡陽市
• 重慶信科通信工程有限公司 聘:南昌電信中興原廠高級
需求人數:2 人 地點:南昌市
• 西安中興精誠通訊有限公司 聘:重慶-網優(yōu)高級工程師
需求人數:2 人 地點:重慶市
• 杭州東信網絡技術有限公司 聘:LTE/5G網絡中高級優(yōu)化工程師
需求人數:2 人 地點:上海市
• 安徽引途科技有限公司 聘:皖北地區(qū)單驗測試工程師
需求人數:20 人 地點:安徽省
• 南京華蘇科技有限公司 聘:中興中高級優(yōu)化工程師
需求人數:20 人 地點:山東省
熱點問題
更多精彩
聯系我們 - 問通信專家 | Powered by MSCBSC 移動通信網 © 2006 - |