汎用機メモっとくか

しごと用の(学習メモ&お気に入り保存)。

VBScriptでdec2bin(64bit)をできるようにしてみた(-2^63 ~ 2^63 - 1か0 ~ 2^64 - 1用)

2018年02月28日 06時37分30秒 | WSH

'<seed_digits19.vbs>Inputデータ
  Dim i
  Dim strPathIn
  Dim strPathOut
  strPathOut = "digits19.txt"
 
  Dim oADOST_R
 
  Dim oADOST_W
  Set oADOST_W = CreateObject("ADODB.Stream")
  Dim adWriteChar: adWriteChar = 0
  Dim adWriteLine: adWriteLine = 1
  oADOST_W.Type = 2  '-1--adTypeBinary , 2--adTypeText
  oADOST_W.Charset = "Shift-JIS"
  oADOST_W.LineSeparator = -1  '-1CrLf , 10 Lf , 13 Cr
  oADOST_W.Open
 
  Dim a01
  Dim a02
 
  For i = 1 To 2
   oADOST_W.WriteText  "18446744073709551614", adWriteLine  ' 2^64 - 2
   oADOST_W.WriteText  "18446744073709551615", adWriteLine  ' 2^64 - 1
   oADOST_W.WriteText  "18446744073709551616", adWriteLine  ' 2^64 
   oADOST_W.WriteText  "18446744073709551617", adWriteLine  ' 2^64 + 1
   oADOST_W.WriteText  " 9223372036854775806", adWriteLine  ' 2^63 - 2
   oADOST_W.WriteText  " 9223372036854775807", adWriteLine  ' 2^63 - 1
   oADOST_W.WriteText  " 9223372036854775808", adWriteLine  ' 2^63 
   oADOST_W.WriteText  " 9223372036854775809", adWriteLine  ' 2^63 + 1
   oADOST_W.WriteText  "-9223372036854775806", adWriteLine  '-2^63 + 2
   oADOST_W.WriteText  "-9223372036854775807", adWriteLine  '-2^63 + 1
   oADOST_W.WriteText  "-9223372036854775808", adWriteLine  '-2^63 
   oADOST_W.WriteText  "-9223372036854775809", adWriteLine  '-2^63 - 1
  Next
 
 
   For i = 1 To 3000
    a01 = CStr(Int(Rnd()*1000000000000000))
    a02 = CStr(Int(Rnd()*10000))

    oADOST_W.WriteText  a01  & a02, adWriteLine
  Next

  For i = 1  To 3000
   a01 = CStr(Int(Rnd()*1000000000000000))
   a02 = CStr(Int(Rnd()*10000))

   oADOST_W.WriteText "-" &  a01  & a02, adWriteLine
  Next
 

  Dim adSaveCreateNotExist:  adSaveCreateNotExist = 1
  Dim adSaveCreateOverWrite: adSaveCreateOverWrite = 2
  oADOST_W.SaveToFile strPathOut, adSaveCreateOverWrite
  oADOST_W.Close
  Set oADOST_W = Nothing
  MsgBox "処理終了"

過去記事2つを組み合わせただけ

'<d2b07.vbs>
Option Explicit

Dim oFS
Dim oFR
Dim oFW
Dim myData

Dim i

Dim x , y ,z
Dim bin16(15)
bin16(0)  = "0000"
bin16(1)  = "0001"
bin16(2)  = "0010"
bin16(3)  = "0011"
bin16(4)  = "0100"
bin16(5)  = "0101"
bin16(6)  = "0110"
bin16(7)  = "0111"
bin16(8)  = "1000"
bin16(9)  = "1001"
bin16(10) = "1010"
bin16(11) = "1011"
bin16(12) = "1100"
bin16(13) = "1101"
bin16(14) = "1110"
bin16(15) = "1111"

Dim bin256(255)
z = 0
For x = 0 TO 15
  For y = 0 To 15
    bin256(z) =  bin16(x) & bin16(y)
    z = z + 1
  Next
Next

Dim hex16(15)
hex16(0)  = "0"
hex16(1)  = "1"
hex16(2)  = "2"
hex16(3)  = "3"
hex16(4)  = "4"
hex16(5)  = "5"
hex16(6)  = "6"
hex16(7)  = "7"
hex16(8)  = "8"
hex16(9)  = "9"
hex16(10) = "A"
hex16(11) = "B"
hex16(12) = "C"
hex16(13) = "D"
hex16(14) = "E"
hex16(15) = "F"

Dim hex256(255)
z = 0
For x = 0 TO 15
    For y = 0 To 15
        hex256(z) =  hex16(x) & hex16(y)
        z = z + 1
    Next
Next

Dim aQuo32
Dim aQuo32Quo16
Dim aQuo32Mod16

Dim aMod32
Dim aMod32Quo16
Dim aMod32Mod16

Dim aQuo32Quo16Quo8
Dim aQuo32Quo16Mod8
Dim aQuo32Mod16Quo8
Dim aQuo32Mod16Mod8
Dim aMod32Quo16Quo8
Dim aMod32Quo16Mod8
Dim aMod32Mod16Quo8
Dim aMod32Mod16Mod8

Set oFS = CreateObject("Scripting.FileSystemObject")

Set oFR = oFS.OpenTextFile("C:\Users\user\Desktop\digits19.txt")
Set oFW = oFS.CreateTextFile("C:\Users\user\Desktop\OUT_digits19.txt")

Do Until oFR.AtEndOfStream
    myData = oFR.ReadLine
    oFW.WriteLine( myData & vbTab & dec2bin(myData))
    'oFW.WriteLine(dec2bin(myData))
Loop

oFR.Close
oFW.Close

Set oFR = Nothing
Set oFW = Nothing
Set oFS = Nothing

MsgBox "処理終了"

Function dec2bin(myNum)
 Dim myNum01
 Dim myNum02
 Dim myNum03
 Dim myNum51(3)
 Dim myNum52(3)
 Dim bQuo2_16(3)
 Dim bMod2_16(3)
 Dim cQuo2_16(3)
 Dim cMod2_16(3)
    
 Dim myMod1(4)
 Dim myMod2(4)
 Dim flg_minus
    
 Dim wkMod1(4)
 Dim wkMod2(4)
    
 Dim sv2_32Quo
 Dim sv2_32Mod
 
 If Instr(myNum,"-") > 0 Then
   flg_minus = "1"
 Else
   flg_minus = "0"

 End If
   
 myNum01 = Trim(Replace(myNum,"-",""))
 myNum02 = Right(String(20,"0") & myNum01,20)
 myNum51(0) = Mid(myNum02,01,5)
 myNum51(1) = Mid(myNum02,06,5)
 myNum51(2) = Mid(myNum02,11,5)
 myNum51(3) = Mid(myNum02,16,5)
    
 myMod1(0) = myNum51(0)
 For i = 0 To 2
   bQuo2_16(i) = Int(myMod1(i) / 2^16)
   bMod2_16(i) = myMod1(i) - (bQuo2_16(i) * 2^16)
   myMod1(i+1) = bMod2_16(i) & myNum51(i+1)
 Next
 bQuo2_16(3)  = Int(myMod1(3) / 2^16)
 bMod2_16(3)  = myMod1(3) - (bQuo2_16(3) * 2^16)
    
 myNum52(0) = Right(String(5,"0") & bQuo2_16(0), 5)
 myNum52(1) = Right(String(5,"0") & bQuo2_16(1), 5)
 myNum52(2) = Right(String(5,"0") & bQuo2_16(2), 5)
 myNum52(3) = Right(String(5,"0") & bQuo2_16(3), 5)

 myMod2(0) = myNum52(0)
 For i = 0 To 2
   cQuo2_16(i) = Int(myMod2(i) / 2^16)
   cMod2_16(i) = myMod2(i) - (cQuo2_16(i) * 2^16)
   myMod2(i+1) = cMod2_16(i) & myNum52(i+1)
 Next
 cQuo2_16(3) = Int(myMod2(3) / 2^16)
 cMod2_16(3) = myMod2(3) - (cQuo2_16(3) * 2^16)
    
 sv2_32Quo = Right(String(5,"0") & cQuo2_16(0), 5) & _
             Right(String(5,"0") & cQuo2_16(1), 5) & _
             Right(String(5,"0") & cQuo2_16(2), 5) & _
             Right(String(5,"0") & cQuo2_16(3), 5)

 sv2_32Mod = cMod2_16(3) * 2^16 + bMod2_16(3)
 
 
  Dim j
  Dim minus(7)
  Dim kuriage(7)
  aQuo32 = sv2_32Quo
  aQuo32Quo16 = Int(aQuo32 / 2^16)
  aQuo32Quo16Quo8 = aQuo32Quo16 \   2^8
  aQuo32Quo16Mod8 = aQuo32Quo16 Mod 2^8
    
  aQuo32Mod16 = aQuo32 - (aQuo32Quo16 * 2^16)
  aQuo32Mod16Quo8 = aQuo32Mod16 \   2^8
  aQuo32Mod16Mod8 = aQuo32Mod16 Mod 2^8
    
  aMod32 = sv2_32Mod
  aMod32Quo16 = Int(aMod32 / 2^16)
  aMod32Quo16Quo8 = aMod32Quo16 \   2^8
  aMod32Quo16Mod8 = aMod32Quo16 Mod 2^8
    
  aMod32Mod16 = aMod32 - (aMod32Quo16 * 2^16)
  aMod32Mod16Quo8 = aMod32Mod16 \   2^8
  aMod32Mod16Mod8 = aMod32Mod16 Mod 2^8
    
  If flg_minus = "1" Then
    If aQuo32Quo16Quo8 > 127 Then
      If aQuo32Quo16Quo8 = 128 And _
         aQuo32Quo16Mod8 =   0 And _
         aQuo32Mod16Quo8 =   0 And _
         aQuo32Mod16Mod8 =   0 And _
         aMod32Quo16Quo8 =   0 And _
         aMod32Quo16Mod8 =   0 And _
         aMod32Mod16Quo8 =   0 And _
         aMod32Mod16Mod8 =   0 Then
      Else
         dec2bin  =  "範囲外" & vbTab  & "範囲外" & _
         aQuo32Quo16Quo8  & vbTab & _
         aQuo32Quo16Mod8  & vbTab & _
         aQuo32Mod16Quo8  & vbTab & _
         aQuo32Mod16Mod8  & vbTab & _
         aMod32Quo16Quo8  & vbTab & _
         aMod32Quo16Mod8  & vbTab & _
         aMod32Mod16Quo8  & vbTab & _
         aMod32Mod16Mod8
               
         Exit Function
      End If
    End If
  Else
    If aQuo32Quo16Quo8 > 127 Then   '-2^63 ~ 2^63 - 1用
    'If aQuo32Quo16Quo8 > 255 Then   '    0 ~ 2^64 - 1用
      dec2bin  =  "範囲外" & vbTab  & "範囲外" & _
      aQuo32Quo16Quo8  & vbTab & _
      aQuo32Quo16Mod8  & vbTab & _
      aQuo32Mod16Quo8  & vbTab & _
      aQuo32Mod16Mod8  & vbTab & _
      aMod32Quo16Quo8  & vbTab & _
      aMod32Quo16Mod8  & vbTab & _
      aMod32Mod16Quo8  & vbTab & _
      aMod32Mod16Mod8
               
      Exit Function
    End If
  End If

  If flg_minus = "1" Then
     For j = 0 To 7
         minus(j) = 0
         kuriage(j)  = 0
     Next
     kuriage(7)  = 1
 
     minus(0) = 255 - aQuo32Quo16Quo8
     minus(1) = 255 - aQuo32Quo16Mod8
     minus(2) = 255 - aQuo32Mod16Quo8
     minus(3) = 255 - aQuo32Mod16Mod8
     minus(4) = 255 - aMod32Quo16Quo8
     minus(5) = 255 - aMod32Quo16Mod8
     minus(6) = 255 - aMod32Mod16Quo8
     minus(7) = 255 - aMod32Mod16Mod8
    
     If minus(7) + kuriage(7) > 255 Then
        kuriage(6)  = 1
        minus(7)    = 0
     Else
        minus(7) = minus(7) + kuriage(7)
     End If
     For j = 6 To 1 Step -1
       If minus(j) + kuriage(j) > 255 Then
          kuriage(j - 1)  = 1
          minus(j) = 0
       Else
          minus(j) = minus(j) + kuriage(j)
       End If
     Next
     If minus(0) + kuriage(0) > 255 Then
        'こんなのは、範囲外
        'kuriage(0)  = 1
        minus(0)    = 0
     Else
        minus(0) = minus(0) + kuriage(0)
     End If

 

     dec2bin = _
       bin256(minus(0)) & _
       bin256(minus(1)) & _
       bin256(minus(2)) & _
       bin256(minus(3)) & _
       bin256(minus(4)) & _
       bin256(minus(5)) & _
       bin256(minus(6)) & _
       bin256(minus(7)) & _
       vbTab & _
       hex256(minus(0)) & _
       hex256(minus(1)) & _
       hex256(minus(2)) & _
       hex256(minus(3)) & _
       hex256(minus(4)) & _
       hex256(minus(5)) & _
       hex256(minus(6)) & _
       hex256(minus(7))
  Else
     dec2bin =  _
       bin256(aQuo32Quo16Quo8) & _
       bin256(aQuo32Quo16Mod8) & _
       bin256(aQuo32Mod16Quo8) & _
       bin256(aQuo32Mod16Mod8) & _
       bin256(aMod32Quo16Quo8) & _
       bin256(aMod32Quo16Mod8) & _
       bin256(aMod32Mod16Quo8) & _
       bin256(aMod32Mod16Mod8) & _
       vbTab & _
       hex256(aQuo32Quo16Quo8) & _
       hex256(aQuo32Quo16Mod8) & _
       hex256(aQuo32Mod16Quo8) & _
       hex256(aQuo32Mod16Mod8) & _
       hex256(aMod32Quo16Quo8) & _
       hex256(aMod32Quo16Mod8) & _
       hex256(aMod32Mod16Quo8) & _
       hex256(aMod32Mod16Mod8)
  End If              
End Function

 残り100文字くらい