問(wèn)題已開(kāi)啟
(普通問(wèn)題)
需要幫忙把EXCEL宏工具32位轉(zhuǎn)換成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
提問(wèn)者: 18603590154 提問(wèn)時(shí)間: 2022-01-13
問(wèn)題答案
( 0 )
• 成都旗訊通信技術(shù)有限公司
聘:電聯(lián)招聘督導(dǎo)、傳輸、維護(hù)轉(zhuǎn)網(wǎng)優(yōu)
需求人數(shù):12 人 地點(diǎn):浙江省,江蘇省,河北省,山西省,遼寧省
• 杭州東信網(wǎng)絡(luò)技術(shù)有限公司 聘:急聘!華為項(xiàng)目(江蘇區(qū)域)
需求人數(shù):30 人 地點(diǎn):江蘇省
• 北京宜通華瑞科技有限公司 聘:專(zhuān)項(xiàng)優(yōu)化中高級(jí)(江西急聘)
需求人數(shù):5 人 地點(diǎn):上饒市,景德鎮(zhèn)市,南昌市,鷹潭市
• 福建省鴻官通信工程有限公司 聘:網(wǎng)絡(luò)優(yōu)化工程師
需求人數(shù):2 人 地點(diǎn):牡丹江市
• 廣州瀚信通信科技股份有限公司 聘:項(xiàng)目經(jīng)理(廣東)
需求人數(shù):2 人 地點(diǎn):廣東省
• 西安長(zhǎng)河通訊有限責(zé)任公司 聘:網(wǎng)絡(luò)優(yōu)化工程師
需求人數(shù):2 人 地點(diǎn):安康市
• 浙江明訊網(wǎng)絡(luò)技術(shù)有限公司 聘:浙江網(wǎng)絡(luò)優(yōu)化工程師
需求人數(shù):8 人 地點(diǎn):寧波市,舟山市,湖州市,紹興市
• 重慶信科通信工程有限公司 聘:后臺(tái)優(yōu)化
需求人數(shù):2 人 地點(diǎn):南昌市
• 山東省郵電工程有限公司 聘:竣工資料結(jié)算員
需求人數(shù):5 人 地點(diǎn):福州市
• 南京格安信息系統(tǒng)有限責(zé)任公司 聘:5G工程單驗(yàn)人員
需求人數(shù):10 人 地點(diǎn):北京市
需求人數(shù):12 人 地點(diǎn):浙江省,江蘇省,河北省,山西省,遼寧省
• 杭州東信網(wǎng)絡(luò)技術(shù)有限公司 聘:急聘!華為項(xiàng)目(江蘇區(qū)域)
需求人數(shù):30 人 地點(diǎn):江蘇省
• 北京宜通華瑞科技有限公司 聘:專(zhuān)項(xiàng)優(yōu)化中高級(jí)(江西急聘)
需求人數(shù):5 人 地點(diǎn):上饒市,景德鎮(zhèn)市,南昌市,鷹潭市
• 福建省鴻官通信工程有限公司 聘:網(wǎng)絡(luò)優(yōu)化工程師
需求人數(shù):2 人 地點(diǎn):牡丹江市
• 廣州瀚信通信科技股份有限公司 聘:項(xiàng)目經(jīng)理(廣東)
需求人數(shù):2 人 地點(diǎn):廣東省
• 西安長(zhǎng)河通訊有限責(zé)任公司 聘:網(wǎng)絡(luò)優(yōu)化工程師
需求人數(shù):2 人 地點(diǎn):安康市
• 浙江明訊網(wǎng)絡(luò)技術(shù)有限公司 聘:浙江網(wǎng)絡(luò)優(yōu)化工程師
需求人數(shù):8 人 地點(diǎn):寧波市,舟山市,湖州市,紹興市
• 重慶信科通信工程有限公司 聘:后臺(tái)優(yōu)化
需求人數(shù):2 人 地點(diǎn):南昌市
• 山東省郵電工程有限公司 聘:竣工資料結(jié)算員
需求人數(shù):5 人 地點(diǎn):福州市
• 南京格安信息系統(tǒng)有限責(zé)任公司 聘:5G工程單驗(yàn)人員
需求人數(shù):10 人 地點(diǎn):北京市
熱點(diǎn)問(wèn)題
更多精彩
聯(lián)系我們 - 問(wèn)通信專(zhuān)家 | Powered by MSCBSC 移動(dòng)通信網(wǎng) © 2006 - |