VBAでクソな暗号処理を作っていた件について

## VBAでクソな暗号処理を作っていた件について

HDD整理していたらかなり昔(十数年前)につくった
謎のVBA暗号処理が発掘されたので
お焚き上げをかねてちょっと載せてみる

まずはコード

<details><summary>VBA</summary>
iniRandumDouble()とiniRandumLong()はそれぞれ別の
疑似乱数系列生成でDouble,Longに深い意味は無い。


```vb
Public Function enCrypt(nstr As String, key As Long)
  Dim cSize As Long
  Dim lA As Long
  Dim lB As Long
  Dim cChr As String
  Dim mtR As Long
  Dim cAC As Long
  Dim lChr As Long
  Dim dKey As Long
  Dim snList() As Long
  Dim stList() As Boolean
  Dim shStr As String
  Dim stN As String
  Dim stX As Long
  Dim lDummy As Long
  Dim lDstr As String
  Dim rDummy As Long
  Dim rDstr As String
  Dim cSum(9) As Long
  Dim cCode As Long
  Dim addSum As Long
  Dim chkSumStr As String
  Dim rndDum As Long
  Dim hStr As String
  Dim stY As String
  
  Dim dbg As Variant
  
  iniRandumDouble (GetTickCount())
  rndDum = Int((93 - 34) * getRandumDouble + 34)
  hStr = ChrW(rndDum)
  '変数初期化
  lChr = 0
  cSum(0) = 0
  cSum(1) = 0
  cSum(2) = 0
  cSum(3) = 0
  cSum(4) = 0
  cSum(5) = 0
  cSum(6) = 0
  cSum(7) = 0
  cSum(8) = 0
  cSum(9) = 0
  cChr = ""
  lDstr = ""
  rDstr = ""
  
  cSize = Len(nstr)
  If cSize > 0 Then
    If versionLimit >= 4 Then
      stY = ""
      For lA = 1 To cSize
      cCode = AscW(Mid(nstr, lA, 1))
        If cCode >= 32 And cCode <= 125 Then
          stY = stY + Mid(nstr, lA, 1)
        Else
          stY = stY + "~" + Hex(AscW(Mid(nstr, lA, 1))) + "~"
        End If
      Next
      nstr = stY
      stY = ""
    End If
  End If
  
  
  
  'Keyで乱数初期化
  iniRandumLong (key Xor systemKey)

  For lA = 1 To systemKey Mod 9941
    cSum(0) = cSum(0) Xor getRandumLong
    cSum(1) = cSum(1) Xor getRandumLong
    cSum(2) = cSum(2) Xor getRandumLong
    cSum(3) = cSum(3) Xor getRandumLong
    cSum(4) = cSum(4) Xor getRandumLong
    cSum(5) = cSum(5) Xor getRandumLong
    cSum(6) = cSum(6) Xor getRandumLong
    cSum(7) = cSum(7) Xor getRandumLong
    cSum(8) = cSum(8) Xor getRandumLong
    cSum(9) = cSum(9) Xor getRandumLong
  Next
  cSum(0) = cSum(0) Xor Val("&H" + Mid(getHash(nstr), 2, 7))
  
  'ダミー生成
  lDummy = (getRandumLong Mod 5) + 1
  rDummy = (getRandumLong Mod 5) + 1
  If lDummy > 0 Then
    For lA = 1 To lDummy
      lDstr = lDstr + Chr((getRandumLong Mod 95) + 32)
    Next
  End If
  If rDummy > 0 Then
    For lA = 1 To rDummy
      rDstr = rDstr + Chr((getRandumLong Mod 95) + 32)
    Next
  End If
  nstr = lDstr + nstr + rDstr


  'チェックサム付与
  For lA = 1 To Len(nstr)
    cSum(0) = cSum(0) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 1, 7))
    cSum(1) = cSum(1) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 3, 7))
    cSum(2) = cSum(2) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 5, 7))
    cSum(3) = cSum(3) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 7, 7))
    cSum(4) = cSum(4) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 9, 7))
    cSum(5) = cSum(5) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 11, 7))
    cSum(6) = cSum(6) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 13, 7))
    cSum(7) = cSum(7) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 15, 7))
    cSum(8) = cSum(8) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 17, 7))
    cSum(9) = cSum(9) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 19, 7))
  Next
  
  addSum = ((cSum(0) Mod 95) + 32) Mod 8
  chkSumStr = Chr((cSum(0) Mod 95) + 32) + Chr((cSum(1) Mod 95) + 32)
  For lA = 1 To addSum
    chkSumStr = chkSumStr + Chr((cSum(lA + 1) Mod 95) + 32)
  Next
  nstr = chkSumStr + nstr

  

  '文字順シャッフル
  cSize = Len(nstr)
  For lA = 1 To cSize
    getRandumLong
  Next
  If versionLimit >= 3 Then
    getRandumLong
  End If
  ReDim snList(cSize - 1)
  ReDim stList(cSize - 1)
  snList(0) = 0
  stList(0) = True
  For lA = 1 To (cSize - 1)
    stX = getRandumLong
    stX = (stX Mod (cSize - lA)) + 1
    For lB = 0 To (cSize - 1)
      If stList(lB) = False Then
        stX = stX - 1
        If stX < 1 Then
          stList(lB) = True
          snList(lB) = lA
          Exit For
        End If
      End If
    Next
  Next
  stN = ""
  For lA = 1 To cSize
    stN = stN + Mid(nstr, snList(lA - 1) + 1, 1)
  Next
  If versionLimit >= 3 Then
    stN = hStr + stN
  End If


  '文字置換
  cSize = Len(stN)
  If cSize > 0 Then
    For lA = 1 To cSize
      If lA > 1 Then
        lChr = Abs((AscW(Mid(stN, lA - 1, 1)))) Mod 12
        For lB = 0 To lChr
          getRandumLong
        Next
      End If
      cCode = AscW(Mid(stN, lA, 1))
      If cCode >= 0 And cCode < 256 Then
        'ASCII
        mtR = getRandumLong Mod 95
        cAC = cCode + mtR - 32
        If cAC > 94 Then
          cAC = cAC - 95
        End If
        cAC = cAC + 32
        cChr = cChr + ChrW(cAC)
      Else
        mtR = getRandumLong Mod 65536
        cAC = cCode + mtR
        If cAC > 32767 Then
          cAC = cAC - 65536
        End If
        If cAC >= 0 And cAC <= 256 Then
          cAC = cAC + 256
        End If
        If (cSum(0) Mod 65536) > cAC Then
        End If
        cChr = cChr + ChrW(cAC)
      End If
    Next
    enCrypt = cChr
  Else
    enCrypt = Null
  End If
End Function
```
```vb
Public Function deCrypt(nstr As String, key As Long)
'復号
  Dim cSize As Long
  Dim lA As Long
  Dim lB As Long
  Dim lC As Long
  Dim cChr As String
  Dim mtR As Long
  Dim cAC As Long
  Dim lChr As Long
  Dim dKey As Long
  Dim snList() As Long
  Dim stList() As Boolean
  Dim shStr As String
  Dim stN As String
  Dim stX As Long
  Dim lDummy As Long
  Dim lDstr As String
  Dim rDummy As Long
  Dim rDstr As String
  Dim cSum(9) As Long
  Dim cCode As Long
  Dim dbg As Variant
  Dim addSum As Long
  Dim stY As String
  
  lChr = 0
  cSum(0) = 0
  cSum(1) = 0
  cSum(2) = 0
  cSum(3) = 0
  cSum(4) = 0
  cSum(5) = 0
  cSum(6) = 0
  cSum(7) = 0
  cSum(8) = 0
  cSum(9) = 0
  cChr = ""
  iniRandumLong (key Xor systemKey)
  For lA = 1 To systemKey Mod 9941
    cSum(0) = cSum(0) Xor getRandumLong
    cSum(1) = cSum(1) Xor getRandumLong
    cSum(2) = cSum(2) Xor getRandumLong
    cSum(3) = cSum(3) Xor getRandumLong
    cSum(4) = cSum(4) Xor getRandumLong
    cSum(5) = cSum(5) Xor getRandumLong
    cSum(6) = cSum(6) Xor getRandumLong
    cSum(7) = cSum(7) Xor getRandumLong
    cSum(8) = cSum(8) Xor getRandumLong
    cSum(9) = cSum(9) Xor getRandumLong
  Next
  
  lDummy = (getRandumLong Mod 5) + 1
  rDummy = (getRandumLong Mod 5) + 1
  If lDummy > 0 Then
    For lA = 1 To lDummy
      lDstr = lDstr + Chr((getRandumLong Mod 95) + 32)
    Next
  End If
  If rDummy > 0 Then
    For lA = 1 To rDummy
      rDstr = rDstr + Chr((getRandumLong Mod 95) + 32)
    Next
  End If
  
  
  
  cSize = Len(nstr)
  For lA = 1 To cSize
    getRandumLong
  Next
  If versionLimit >= 3 Then
    cSize = cSize - 1
  End If
  ReDim snList(cSize - 1)
  ReDim stList(cSize - 1)
  snList(0) = 0
  stList(0) = True
  For lA = 1 To (cSize - 1)
    stX = getRandumLong
    stX = (stX Mod (cSize - lA)) + 1
    For lB = 0 To (cSize - 1)
      If stList(lB) = False Then
        stX = stX - 1
        If stX < 1 Then
          stList(lB) = True
          snList(lB) = lA
          Exit For
        End If
      End If
    Next
  Next
  
  If versionLimit >= 3 Then
    cSize = cSize + 1
  End If
  If cSize > 0 Then
    For lA = 1 To cSize
      If lA > 1 Then
        lChr = Abs((AscW(Mid(cChr, lA - 1, 1)))) Mod 12
        For lB = 0 To lChr
          getRandumLong
        Next
      End If
      dbg = Mid(nstr, lA, 1)
      cCode = AscW(Mid(nstr, lA, 1))
      If cCode >= 0 And cCode < 256 Then
        mtR = getRandumLong Mod 95
        cAC = AscW(Mid(nstr, lA, 1)) - 32 - mtR
        If cAC < 0 Then
          cAC = 95 + cAC
        End If
        cAC = cAC + 32
        cChr = cChr + Chr(cAC)
      Else
        mtR = getRandumLong Mod 65536
        If cCode >= 256 And cCode <= 512 Then
          cCode = cCode - 256
        End If
        cAC = cCode - mtR
        If cAC < -32768 Then
          cAC = cAC + 65536
        End If
        cChr = cChr + ChrW(cAC)
      End If
    Next
    If versionLimit >= 3 Then
      cChr = Mid(cChr, 2)
    End If
    stN = ""
    If versionLimit >= 3 Then
      cSize = cSize - 1
    End If
    For lB = 0 To (cSize - 1)
      lC = 0
      Do While lC < cSize
        If snList(lC) = lB Then
          stN = stN + Mid(cChr, lC + 1, 1)
          lC = cSize
        End If
        lC = lC + 1
      Loop
    Next
    
    addSum = Asc(Mid(stN, 1, 1)) Mod 8
   
    nstr = Mid(stN, addSum + 3)
    For lA = 1 To Len(nstr)
      cSum(0) = cSum(0) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 1, 7))
      cSum(1) = cSum(1) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 3, 7))
      If versionLimit >= 2 Then
        cSum(2) = cSum(2) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 5, 7))
        cSum(3) = cSum(3) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 7, 7))
        cSum(4) = cSum(4) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 9, 7))
        cSum(5) = cSum(5) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 11, 7))
        cSum(6) = cSum(6) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 13, 7))
        cSum(7) = cSum(7) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 15, 7))
        cSum(8) = cSum(8) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 17, 7))
        cSum(9) = cSum(9) Xor Val("&H" + Mid(getHash(Mid(nstr, lA, 1)), 19, 7))
      End If
    Next
    cSum(0) = cSum(0) Xor Val("&H" + Mid(getHash(Mid(nstr, lDummy + 1, Len(nstr) - lDummy - rDummy)), 2, 7))
    If Chr((cSum(0) Mod 95) + 32) = Mid(stN, 1, 1) And Chr((cSum(1) Mod 95) + 32) = Mid(stN, 2, 1) Then
      cChr = Mid(nstr, lDummy + 1, Len(nstr) - lDummy - rDummy)
     If versionLimit >= 4 Then
        stY = ""
        cSize = Len(cChr)
        For lA = 1 To cSize
        cCode = AscW(Mid(cChr, lA, 1))
          If cCode >= 32 And cCode <= 125 Then
            stY = stY + Mid(cChr, lA, 1)
          Else
            stY = stY + ChrW(Val("&H" + Mid(cChr, lA + 1, InStr(lA + 1, cChr, "~") - (lA + 1))))
            lA = lA + 1 + Len(CStr(Mid(cChr, lA + 1, InStr(lA + 1, cChr, "~") - (lA + 1))))
          End If
        Next
        deCrypt = stY
        stY = ""
      End If
    Else
      deCrypt = Null
    End If
  Else
    deCrypt = Null
  End If
End Function
```
</details>

疑似乱数系列シードを鍵として
乱数を元に、入力文字列を文字順を入れ替えて
それぞれの文字をローテーション(乱数分文字コードをずらす)する。

***

もう作った当時の意図とかほぼ忘れているんだけど
普通ユーザーがアクセス出来てしまう場所に、
とあるシステムのユーザーID,パスワードを保管しておく事が目的で
簡単の読まないようにするのと、変なデータに書き換えられても検出出来ること
それと処理後も表示文字の範囲に収まる、が要件だったはず。
***
ダミー生成となっている部分は
同じ鍵と平文でも別の暗号文にする為だったはず。

ダミーの長さもランダムなので、
暗号処理する度に出てくる文字数すら変わるとしたのはのは謎。

***
まあ、VBA実装上の大問題として鍵が疑似乱数系列シードで
その処理がVBAのビット演算の制限を受けて
鍵長が31bit(符号32bitのうち正の値)と短すぎで
確か作ったときのベンチマークでも1年以内にPC1台で全数探索出来る程度
とよわよわだったはず。
なので、暗号化というか難読化として使っていた。

たぶん、いまならもっと早く全数探索出来るんだろうな。
試す気は無いけど。