clsdes.cls

一个GPS监控系统中

  'Do nothing if the key is buffered
  If (m_KeyValue = New_Value) Then Exit Property
  
  'Store a string value of the buffered key
  m_KeyValue = New_Value
  
  'Convert the key to a binary array
  Call Byte2Bin(StrConv(New_Value, vbFromUnicode), IIf(Len(New_Value) > 8, 8, Len(New_Value)), KeyBin())

  'Apply the PC-2 permutation
  For a = 0 To 55
    KeySchedule(a) = KeyBin(m_PC1(a))
  Next
  
  'Split keyschedule into two halves, C[] and D[]
  Call CopyMem(C(0), KeySchedule(0), 28)
  Call CopyMem(D(0), KeySchedule(28), 28)
  
  'Calculate the key schedule (16 subkeys)
  For i = 1 To 16
    'Perform one or two cyclic left shifts on
    'both C[i-1] and D[i-1] to get C[i] and D[i]
    Call CopyMem(Temp(0), C(0), m_LeftShifts(i))
    Call CopyMem(C(0), C(m_LeftShifts(i)), 28 - m_LeftShifts(i))
    Call CopyMem(C(28 - m_LeftShifts(i)), Temp(0), m_LeftShifts(i))
    Call CopyMem(Temp(0), D(0), m_LeftShifts(i))
    Call CopyMem(D(0), D(m_LeftShifts(i)), 28 - m_LeftShifts(i))
    Call CopyMem(D(28 - m_LeftShifts(i)), Temp(0), m_LeftShifts(i))
    
    'Concatenate C[] and D[]
    Call CopyMem(CD(0), C(0), 28)
    Call CopyMem(CD(28), D(0), 28)
    
    'Apply the PC-2 permutation and store
    'the calculated subkey
    For a = 0 To 47
      m_Key(a, i) = CD(m_PC2(a))
    Next
  Next

End Property
Private Sub Class_Initialize()

  Dim i As Long
  Dim vE As Variant
  Dim vP As Variant
  Dim vIP As Variant
  Dim vPC1 As Variant
  Dim vPC2 As Variant
  Dim vIPInv As Variant
  Dim vSbox(0 To 7) As Variant
  
  'Initialize the permutation IP
  vIP = Array(58, 50, 42, 34, 26, 18, 10, 2, _
              60, 52, 44, 36, 28, 20, 12, 4, _
              62, 54, 46, 38, 30, 22, 14, 6, _
              64, 56, 48, 40, 32, 24, 16, 8, _
              57, 49, 41, 33, 25, 17, 9, 1, _
              59, 51, 43, 35, 27, 19, 11, 3, _
              61, 53, 45, 37, 29, 21, 13, 5, _
              63, 55, 47, 39, 31, 23, 15, 7)
  
  'Create the permutation IP
  For i = LBound(vIP) To UBound(vIP)
    m_IP(i) = (vIP(i) - 1)
  Next
  
  'Initialize the expansion function E
  vE = Array(32, 1, 2, 3, 4, 5, _
             4, 5, 6, 7, 8, 9, _
             8, 9, 10, 11, 12, 13, _
             12, 13, 14, 15, 16, 17, _
             16, 17, 18, 19, 20, 21, _
             20, 21, 22, 23, 24, 25, _
             24, 25, 26, 27, 28, 29, _
             28, 29, 30, 31, 32, 1)
  
  'Create the expansion array
  For i = LBound(vE) To UBound(vE)
    m_E(i) = (vE(i) - 1)
  Next
  
  'Initialize the PC1 function
  vPC1 = Array(57, 49, 41, 33, 25, 17, 9, _
               1, 58, 50, 42, 34, 26, 18, _
               10, 2, 59, 51, 43, 35, 27, _
               19, 11, 3, 60, 52, 44, 36, _
               63, 55, 47, 39, 31, 23, 15, _
               7, 62, 54, 46, 38, 30, 22, _
               14, 6, 61, 53, 45, 37, 29, _
               21, 13, 5, 28, 20, 12, 4)

  'Create the PC1 function
  For i = LBound(vPC1) To UBound(vPC1)
    m_PC1(i) = (vPC1(i) - 1)
  Next
  
  'Initialize the PC2 function
  vPC2 = Array(14, 17, 11, 24, 1, 5, _
               3, 28, 15, 6, 21, 10, _
               23, 19, 12, 4, 26, 8, _
               16, 7, 27, 20, 13, 2, _
               41, 52, 31, 37, 47, 55, _
               30, 40, 51, 45, 33, 48, _
               44, 49, 39, 56, 34, 53, _
               46, 42, 50, 36, 29, 32)
  
  'Create the PC2 function
  For i = LBound(vPC2) To UBound(vPC2)
    m_PC2(i) = (vPC2(i) - 1)
  Next
  
  'Initialize the inverted IP
  vIPInv = Array(40, 8, 48, 16, 56, 24, 64, 32, _
                 39, 7, 47, 15, 55, 23, 63, 31, _
                 38, 6, 46, 14, 54, 22, 62, 30, _
                 37, 5, 45, 13, 53, 21, 61, 29, _
                 36, 4, 44, 12, 52, 20, 60, 28, _
                 35, 3, 43, 11, 51, 19, 59, 27, _
                 34, 2, 42, 10, 50, 18, 58, 26, _
                 33, 1, 41, 9, 49, 17, 57, 25)
  
  'Create the inverted IP
  For i = LBound(vIPInv) To UBound(vIPInv)
    m_IPInv(i) = (vIPInv(i) - 1)
  Next
    
  'Initialize permutation P
  vP = Array(16, 7, 20, 21, _
             29, 12, 28, 17, _
             1, 15, 23, 26, _
             5, 18, 31, 10, _
             2, 8, 24, 14, _
             32, 27, 3, 9, _
             19, 13, 30, 6, _
             22, 11, 4, 25)

  'Create P
  For i = LBound(vP) To UBound(vP)
    m_P(i) = (vP(i) - 1)
  Next
  
  'Initialize the leftshifts array
  For i = 1 To 16
    Select Case i
    Case 1, 2, 9, 16
      m_LeftShifts(i) = 1
    Case Else
      m_LeftShifts(i) = 2
    End Select
  Next
  
  'Initialize the eight s-boxes
  vSbox(0) = Array(14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7, _
                   0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8, _
                   4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0, _
                   15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13)

  vSbox(1) = Array(15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10, _
                   3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5, _
                   0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15, _
                   13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9)

  vSbox(2) = Array(10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8, _
                   13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1, _
                   13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7, _
                   1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12)

  vSbox(3) = Array(7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15, _
                   13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9, _
                   10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4, _
                   3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14)

  vSbox(4) = Array(2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9, _
                   14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6, _
                   4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14, _
                   11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3)
  
  vSbox(5) = Array(12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11, _
                   10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8, _
                   9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6, _
                   4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13)
  
  vSbox(6) = Array(4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1, _
                   13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6, _
                   1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2, _
                   6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12)
  
  vSbox(7) = Array(13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7, _
                   1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2, _
                   7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8, _
                   2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11)
  
  Dim lBox As Long
  Dim lRow As Long
  Dim lColumn As Long
  Dim TheByte(0) As Byte
  Dim TheBin(0 To 7) As Byte
  Dim a As Byte, b As Byte, C As Byte, D As Byte, e As Byte, F As Byte
  
  'Create an optimized version of the s-boxes
  'this is not in the standard but much faster
  'than calculating the Row/Column index later
  For lBox = 0 To 7
    For a = 0 To 1
      For b = 0 To 1
        For C = 0 To 1
          For D = 0 To 1
            For e = 0 To 1
              For F = 0 To 1
                lRow = a * 2 + F
                lColumn = b * 8 + C * 4 + D * 2 + e
                TheByte(0) = vSbox(lBox)(lRow * 16 + lColumn)
                Call Byte2Bin(TheByte(), 1, TheBin())
                Call CopyMem(m_sBox(lBox, a, b, C, D, e, F), TheBin(4), 4)
              Next
            Next
          Next
        Next
      Next
    Next
  Next

End Sub



'''''''''''''''''''''''''''''''''''
Public Sub GetSomeEncryptFile(SourceFile As String, DestFile As String, EncryptLen As Integer, Optional Key As String)

  Dim Filenr As Integer
  Dim ByteArray() As Byte
  DestFile = SourceFile
  'Make sure the source file do exist
  If (Not FileExist(SourceFile)) Then
    Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
    Exit Sub
  End If
  
  'Open the source file and read the content
  'into a bytearray to pass onto encryption
  Filenr = FreeFile
  Open SourceFile For Binary As #Filenr
  If LOF(Filenr) > 0 Then
      ReDim ByteArray(0 To EncryptLen - 1)
      Dim ilen As Integer
      ilen = LOF(Filenr) - 1
      Get #Filenr, , ByteArray()
      Close #Filenr
      
      'Encrypt the bytearray
      Call EncryptByte(ByteArray(), Key)
    
      'If the destination file already exist we need
      'to delete it since opening it for binary use
      'will preserve it if it already exist
'      If (FileExist(DestFile)) Then Kill DestFile
      
      'Store the encrypted data in the destination file
      Filenr = FreeFile
      Open DestFile For Binary As #Filenr
      Put #Filenr, , ByteArray()
      Close #Filenr
  Else
    Close #Filenr
    Filenr = FreeFile
    Open DestFile For Binary As #Filenr
    Close #Filenr
  End If
End Sub
Public Sub PutSomeDecryptFile(SourceFile As String, DestFile As String, ilen As Integer, Optional Key As String)

  Dim Filenr As Integer
  Dim ByteArray() As Byte
  DestFile = SourceFile
  'Make sure the source file do exist
  If (Not FileExist(SourceFile)) Then
    Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
    Exit Sub
  End If
  
  'Open the source file and read the content
  'into a bytearray to decrypt
  Filenr = FreeFile
  Open SourceFile For Binary As #Filenr
  If LOF(Filenr) > 0 Then
      ReDim ByteArray(0 To ilen - 1)
      
      Get #Filenr, , ByteArray()
      Close #Filenr
      
      'Decrypt the bytearray
      Call DecryptByte(ByteArray(), Key)
    
      'If the destination file already exist we need
      'to delete it since opening it for binary use
      'will preserve it if it already exist
'      If (FileExist(DestFile)) Then Kill DestFile
    
      'Store the decrypted data in the destination file
      Filenr = FreeFile
      Open DestFile For Binary As #Filenr
      Put #Filenr, , ByteArray()
      Close #Filenr
  Else
    Close #Filenr
    Filenr = FreeFile
    Open DestFile For Binary As #Filenr
    Close #Filenr
  End If

End Sub