var.bas

中国石化IC开发程序

Attribute VB_Name = "var"
Public glIcdev As Long       '全局串口句柄
Public giRet As Integer      '全局函数返回值
Public gsErrHint As String   '全局错误提示

Public gbInput(200) As Byte  '全局指令字节存储变量
Public gbOutput(200) As Byte '全局指令字节返回存储变量

Public gsHex As String * 400 '全局
Public gsErrorNO As String   '全局错误号
Public giLength As Integer   '

Public Function Get_Result(psHex As String, piLength As Integer) As Boolean
If Mid(psHex, piLength * 2 + 3, 4) = "9000" Then
    Get_Result = True
Else
    gsErrorNO = Mid(psHex, piLength * 2 + 3, 4)
End If
End Function

Public Function Mac_encrypt(key() As Byte, inittext() As Byte, Source() As Byte, le%, destin() As Byte) As Integer
Dim m As Integer
Dim i As Integer
Dim n As Integer
Dim data(8) As Byte
Dim Tdata(8) As Byte
Dim keyA(8) As Byte
Dim keyB(8) As Byte


n = (le - le Mod 8) / 8
m = le Mod 8
If m = 0 Then
   Source(le + 0) = &H80
   Source(le + 1) = &H0
   Source(le + 2) = &H0
   Source(le + 3) = &H0
   Source(le + 4) = &H0
   Source(le + 5) = &H0
   Source(le + 6) = &H0
   Source(le + 7) = &H0
   
Else
   For i = 1 To (8 - m - 1)
       Source(le + i) = &H0
   Next
   Source(le) = &H80
End If
keyA(0) = key(0)
keyA(1) = key(1)
keyA(2) = key(2)
keyA(3) = key(3)
keyA(4) = key(4)
keyA(5) = key(5)
keyA(6) = key(6)
keyA(7) = key(7)

keyB(0) = key(8)
keyB(1) = key(9)
keyB(2) = key(10)
keyB(3) = key(11)
keyB(4) = key(12)
keyB(5) = key(13)
keyB(6) = key(14)
keyB(7) = key(15)


For i = 0 To n
   data(0) = Source(0 + 8 * i)
   data(1) = Source(1 + 8 * i)
   data(2) = Source(2 + 8 * i)
   data(3) = Source(3 + 8 * i)
   data(4) = Source(4 + 8 * i)
   data(5) = Source(5 + 8 * i)
   data(6) = Source(6 + 8 * i)
   data(7) = Source(7 + 8 * i)
   st = Xor_encrypt(inittext, data, Tdata)
   If st <> 0 Then
       Mac_encrypt = -1
       Exit Function
   End If
   st = DES_Encrypt(keyA(0), 8, Tdata(0), 8, inittext(0))
   If st <> 8 Then
      Mac_encrypt = -2
      Exit Function
   End If
  Next

st = DES_Decrypt(keyB(0), 8, inittext(0), 8, Tdata(0))
If st <> 8 Then
   Mac_encrypt = -3
   Exit Function
End If
st = DES_Encrypt(keyA(0), 8, Tdata(0), 8, inittext(0))
If st <> 8 Then
   Mac_encrypt = -4
   Exit Function
End If
destin(0) = inittext(0)
destin(1) = inittext(1)
destin(2) = inittext(2)
destin(3) = inittext(3)
Mac_encrypt = 0
End Function

Public Function Xor_encrypt(Text1() As Byte, Text2() As Byte, Text3() As Byte) As Integer
Text3(0) = Text1(0) Xor Text2(0)
Text3(1) = Text1(1) Xor Text2(1)
Text3(2) = Text1(2) Xor Text2(2)
Text3(3) = Text1(3) Xor Text2(3)
Text3(4) = Text1(4) Xor Text2(4)
Text3(5) = Text1(5) Xor Text2(5)
Text3(6) = Text1(6) Xor Text2(6)
Text3(7) = Text1(7) Xor Text2(7)
Xor_encrypt = 0
End Function

Public Function TDes_Encrypt(key() As Byte, random() As Byte, lenth As Integer, Destext() As Byte) As Integer
'Triple Des
Dim piI As Integer
Dim keyA(8) As Byte
Dim keyB(8) As Byte

keyA(0) = key(0)
keyA(1) = key(1)
keyA(2) = key(2)
keyA(3) = key(3)
keyA(4) = key(4)
keyA(5) = key(5)
keyA(6) = key(6)
keyA(7) = key(7)

keyB(0) = key(8)
keyB(1) = key(9)
keyB(2) = key(10)
keyB(3) = key(11)
keyB(4) = key(12)
keyB(5) = key(13)
keyB(6) = key(14)
keyB(7) = key(15)

st = DES_Encrypt(keyA(0), 8, random(0), lenth, Destext(0))
st = DES_Decrypt(keyB(0), 8, Destext(0), lenth, random(0))
st = DES_Encrypt(keyA(0), 8, random(0), lenth, Destext(0))
TDes_Encrypt = st
End Function

Public Function SMac_encrypt(key() As Byte, inittext() As Byte, Source() As Byte, le%, destin() As Byte) As Integer
Dim m As Integer
Dim i As Integer
Dim n As Integer
Dim data(8) As Byte
Dim Tdata(8) As Byte
Dim keyA(8) As Byte


n = (le - le Mod 8) / 8
m = le Mod 8
If m = 0 Then
   Source(le + 0) = &H80
   Source(le + 1) = &H0
   Source(le + 2) = &H0
   Source(le + 3) = &H0
   Source(le + 4) = &H0
   Source(le + 5) = &H0
   Source(le + 6) = &H0
   Source(le + 7) = &H0
   
Else
   For i = 1 To (8 - m - 1)
       Source(le + i) = &H0
   Next
   Source(le) = &H80
End If
keyA(0) = key(0)
keyA(1) = key(1)
keyA(2) = key(2)
keyA(3) = key(3)
keyA(4) = key(4)
keyA(5) = key(5)
keyA(6) = key(6)
keyA(7) = key(7)



For i = 0 To n
   data(0) = Source(0 + 8 * i)
   data(1) = Source(1 + 8 * i)
   data(2) = Source(2 + 8 * i)
   data(3) = Source(3 + 8 * i)
   data(4) = Source(4 + 8 * i)
   data(5) = Source(5 + 8 * i)
   data(6) = Source(6 + 8 * i)
   data(7) = Source(7 + 8 * i)
   st = Xor_encrypt(inittext, data, Tdata)
   If st <> 0 Then
       SMac_encrypt = -1
       Exit Function
   End If
   st = DES_Encrypt(keyA(0), 8, Tdata(0), 8, inittext(0))
   If st <> 8 Then
      SMac_encrypt = -2
      Exit Function
   End If
  Next


destin(0) = inittext(0)
destin(1) = inittext(1)
destin(2) = inittext(2)
destin(3) = inittext(3)
SMac_encrypt = 0
End Function

Function MAC(rflag As Integer, key As String, kle As Integer, data As String, le As Integer) As String
Dim wdata(100) As Byte
Dim rdata(100) As Byte
Dim hexdata As String * 100

Dim data0(8)           As String * 16
Dim inter              As String
Dim key1(7)            As Byte
Dim key2(7)            As Byte
Dim ptrdest(7)         As Byte
Dim inter1(8)          As Byte
Dim i1, i, j, k, st    As Integer
 
st = asc_hex(key, key1(0), 8)
st = asc_hex(Mid(key, 17, 16), key2(0), 8)        '生成 key1，key2

st = asc_hex("0040050084000004c5", wdata(0), 9)
If rflag = 0 Then
   st = cpu_protocol(glIcdev, 9, wdata(0), rdata(0))
   st = hex_asc(rdata(0), hexdata, 19)
   st = asc_hex(Mid(hexdata, 7, 8), inter1(0), 4)
   inter1(4) = &H0
   inter1(5) = &H0
   inter1(6) = &H0
   inter1(7) = &H0
Else
   For i = 0 To 7
    inter1(i) = &H0
   Next i
End If

st = hex_asc(inter1(0), hexdata, 16)
data0(0) = Mid(hexdata, 1, 16)                    '生成初始值
 
If (le Mod 16 <> 0) Then
    data = data + "80"
    le = le + 2
    Do While (le Mod 16 <> 0)
       data = data + "00"
       le = le + 2
    Loop
End If                                            '不够8个字节的补"800000.."

i = 1
j = 1
Do While i <= le
   data0(j) = Mid(data, i, 16)
   i = i + 16
   j = j + 1
Loop                                              '生成数据块

st = asc_hex(data0(0), inter1(0), 8)
st = asc_hex(data0(1), ptrdest(0), 8)
For i = 0 To 7
    inter1(i) = inter1(i) Xor ptrdest(i)
Next i                                            '初始值与第一个数据块异或
st = hex_asc(inter1(0), hexdata, 16)

j = j - 1                                         '已用去一个数据块
i = 2                                             '下面从第二块数据块开始
Do While j >= 2
   st = asc_hex(key, key1(0), 8)
   st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0)) '异或值进行加密
   
   st = asc_hex(data0(i), inter1(0), 8)
   k = 0
   For k = 0 To 7
       inter1(k) = inter1(k) Xor ptrdest(k)
   Next k                                                '加密值与下一个数据块进行异或
   st = hex_asc(inter1(0), hexdata, 16)
     
   j = j - 1
   i = i + 1
Loop

st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0))       '用key1进行数据加密
If (kle = 32) Then
   st = DES_Decrypt(key2(0), 8, ptrdest(0), 8, inter1(0))    '用key2进行数据解密
   st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0))    '用key1进行数据加密
End If

st = hex_asc(ptrdest(0), hexdata, 8)
MAC = Mid(hexdata, 1, 8)                                     '生成MAC码
End Function

Function SESPK(psKey As String, psData As String) As String
'过程密钥的计算,DES计算.
Dim pbKey(7) As Byte
Dim pbKeyA(7) As Byte
Dim pbKeyB(7) As Byte
Dim pbData(100) As Byte
Dim pbExdest(100) As Byte
If Len(psKey) / 2 = 8 Then
    giRet = asc_hex(psKey, pbKey(0), 8)
    giRet = asc_hex(psData, pbData(0), Len(psData) / 2)
    giRet = ic_encrypt(pbKey(0), pbData(0), Len(psData) / 2, pbExdest(0))
    giRet = hex_asc(pbExdest(0), gsHex, Len(psData) / 2)
    SESPK = Mid(gsHex, 1, Len(psData))
End If
If Len(psKey) / 2 = 16 Then
    giRet = asc_hex(Mid(psKey, 1, 16), pbKeyA(0), 8)
    giRet = asc_hex(Mid(psKey, 17, 16), pbKeyB(0), 8)
    giRet = asc_hex(psData, pbData(0), Len(psData) / 2)
    giRet = ic_encrypt(pbKeyA(0), pbData(0), Len(psData) / 2, pbExdest(0))
    giRet = ic_decrypt(pbKeyB(0), pbExdest(0), Len(psData) / 2, pbData(0))
    giRet = ic_encrypt(pbKeyA(0), pbData(0), Len(psData) / 2, pbExdest(0))
    giRet = hex_asc(pbExdest(0), gsHex, Len(psData) / 2)
    SESPK = Mid(gsHex, 1, Len(psData))
End If
End Function

Function Sam_MAC(rflag As Integer, key As String, kle As Integer, data As String, le As Integer) As String
Dim wdata(100) As Byte
Dim rdata(100) As Byte
Dim hexdata As String * 100

Dim data0(8)           As String * 16
Dim inter              As String
Dim key1(7)            As Byte
Dim key2(7)            As Byte
Dim ptrdest(7)         As Byte
Dim inter1(8)          As Byte
Dim i1, i, j, k, st    As Integer
 
st = asc_hex(key, key1(0), 8)
st = asc_hex(Mid(key, 17, 16), key2(0), 8)        '生成 key1，key2

st = asc_hex("0040050084000004c5", wdata(0), 9)
If rflag = 0 Then
   st = sam_protocol(glIcdev, 9, wdata(0), rdata(0))
   st = hex_asc(rdata(0), hexdata, 19)
   st = asc_hex(Mid(hexdata, 7, 8), inter1(0), 4)
   inter1(4) = &H0
   inter1(5) = &H0
   inter1(6) = &H0
   inter1(7) = &H0
Else
   For i = 0 To 7
    inter1(i) = &H0
   Next i
End If

st = hex_asc(inter1(0), hexdata, 16)
data0(0) = Mid(hexdata, 1, 16)                    '生成初始值
 
If (le Mod 16 <> 0) Then
    data = data + "80"
    le = le + 2
    Do While (le Mod 16 <> 0)
       data = data + "00"
       le = le + 2
    Loop
End If                                            '不够8个字节的补"800000.."

i = 1
j = 1
Do While i <= le
   data0(j) = Mid(data, i, 16)
   i = i + 16
   j = j + 1
Loop                                              '生成数据块

st = asc_hex(data0(0), inter1(0), 8)
st = asc_hex(data0(1), ptrdest(0), 8)
For i = 0 To 7
    inter1(i) = inter1(i) Xor ptrdest(i)
Next i                                            '初始值与第一个数据块异或
st = hex_asc(inter1(0), hexdata, 16)

j = j - 1                                         '已用去一个数据块
i = 2                                             '下面从第二块数据块开始
Do While j >= 2
   st = asc_hex(key, key1(0), 8)
   st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0)) '异或值进行加密
   
   st = asc_hex(data0(i), inter1(0), 8)
   k = 0
   For k = 0 To 7
       inter1(k) = inter1(k) Xor ptrdest(k)
   Next k                                                '加密值与下一个数据块进行异或
   st = hex_asc(inter1(0), hexdata, 16)
     
   j = j - 1
   i = i + 1
Loop

st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0))       '用key1进行数据加密
If (kle = 32) Then
   st = DES_Decrypt(key2(0), 8, ptrdest(0), 8, inter1(0))    '用key2进行数据解密
   st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0))    '用key1进行数据加密
End If

st = hex_asc(ptrdest(0), hexdata, 8)
Sam_MAC = Mid(hexdata, 1, 8)                                     '生成MAC码
End Function

Function Cpu_MAC(rflag As Integer, key As String, kle As Integer, data As String, le As Integer) As String
Dim wdata(100) As Byte
Dim rdata(100) As Byte
Dim hexdata As String * 100

Dim data0(8)           As String * 16
Dim inter              As String
Dim key1(7)            As Byte
Dim key2(7)            As Byte
Dim ptrdest(7)         As Byte
Dim inter1(8)          As Byte
Dim i1, i, j, k, st    As Integer
 
st = asc_hex(key, key1(0), 8)
st = asc_hex(Mid(key, 17, 16), key2(0), 8)        '生成 key1，key2

st = asc_hex("0040050084000004c5", wdata(0), 9)
If rflag = 0 Then
   st = cpu_protocol(glIcdev, 9, wdata(0), rdata(0))
   st = hex_asc(rdata(0), hexdata, 19)
   st = asc_hex(Mid(hexdata, 7, 8), inter1(0), 4)
   inter1(4) = &H0
   inter1(5) = &H0
   inter1(6) = &H0
   inter1(7) = &H0
Else
   For i = 0 To 7
    inter1(i) = &H0
   Next i
End If

st = hex_asc(inter1(0), hexdata, 16)
data0(0) = Mid(hexdata, 1, 16)                    '生成初始值
 
If (le Mod 16 <> 0) Then
    data = data + "80"
    le = le + 2
    Do While (le Mod 16 <> 0)
       data = data + "00"
       le = le + 2
    Loop
End If                                            '不够8个字节的补"800000.."

i = 1
j = 1
Do While i <= le
   data0(j) = Mid(data, i, 16)
   i = i + 16
   j = j + 1
Loop                                              '生成数据块

st = asc_hex(data0(0), inter1(0), 8)
st = asc_hex(data0(1), ptrdest(0), 8)
For i = 0 To 7
    inter1(i) = inter1(i) Xor ptrdest(i)
Next i                                            '初始值与第一个数据块异或
st = hex_asc(inter1(0), hexdata, 16)

j = j - 1                                         '已用去一个数据块
i = 2                                             '下面从第二块数据块开始
Do While j >= 2
   st = asc_hex(key, key1(0), 8)
   st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0)) '异或值进行加密
   
   st = asc_hex(data0(i), inter1(0), 8)
   k = 0
   For k = 0 To 7
       inter1(k) = inter1(k) Xor ptrdest(k)
   Next k                                                '加密值与下一个数据块进行异或
   st = hex_asc(inter1(0), hexdata, 16)
     
   j = j - 1
   i = i + 1
Loop

st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0))       '用key1进行数据加密
If (kle = 32) Then
   st = DES_Decrypt(key2(0), 8, ptrdest(0), 8, inter1(0))    '用key2进行数据解密
   st = DES_Encrypt(key1(0), 8, inter1(0), 8, ptrdest(0))    '用key1进行数据加密
End If

st = hex_asc(ptrdest(0), hexdata, 8)
Cpu_MAC = Mid(hexdata, 1, 8)                                     '生成MAC码
End Function