汎用機メモっとくか

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

VBScriptで10進数15桁+-のdec2bin(64bit)をできるようにしてみた。

2018年01月04日 06時04分58秒 | WSH

参考元 mohmongar様
10進数を2進数で・・・Excelの話。
https://mohmongar.net/?p=773
恐らく、こちらも10進数15桁+-が限界だとおもいます。double型が精度をたもてなくなるので。

 

多桁計算のアルゴリズムとかを使えば、15桁超も可能だろうけど、気が乗りません。

 15桁超えるときは、VBAでDECIMAL型使うか、

VB.NETとかC#.NETとかJScript.NETでDECIMAL型使って、

コンパイルして .exe作ったほうが、簡単だとおもいます。

 


※注意 範囲のエラーチェック無し

<d2b06.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:\Documents and Settings\USER\デスクトップ\b01.txt")
Set oFW = oFS.CreateTextFile("C:\Documents and Settings\USER\デスクトップ\out_b01vbs.txt")

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

oFR.Close
oFW.Close

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

MsgBox "処理終了"

Function dec2bin(number)
  Dim j
  Dim minus(7)
  Dim kuriage(7)
    aQuo32 = Int(ABS(number) / 2^32)
    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 = ABS(number) -  (aQuo32 * 2^32)
    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 number < 0 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


<data_seed.vbs>データの種
Option Explicit

Dim oFS
Dim oText
Dim i
Dim j

Set oFS   =  CreateObject("Scripting.FileSystemObject")
Set oText =  oFS.CreateTextFile("b01.txt")

For i = 1 To 49
    oText.WriteLine( (2^i)-1 )
    oText.WriteLine( (2^i)   )
    oText.WriteLine( (2^i)+1 )
Next

For i = 1 To 49
    oText.WriteLine(Right("-" & (2^i)-1,16) )
    oText.WriteLine(Right("-" & (2^i)  ,16) )
    oText.WriteLine(Right("-" & (2^i)+1,16) )
Next

Dim myData
For i = 7 To 49
    For j = 1 To 100
      myData = INT(RND() * (2^i))
      oText.WriteLine(      myData )
      oText.WriteLine("-" & myData )
    Next
Next

    oText.WriteLine( 987654321012345)
    oText.WriteLine(-987654321012345)

    oText.WriteLine( 999999999999999)
    oText.WriteLine(-999999999999999)

oText.Close

Set oText = Nothing
Set oFS   = Nothing

MsgBox "処理終了"

 

検証用r4(rexx)サンプル
regina(rexx),ooREXX(rexx)の場合、"!"を"STDERR"に変えてください。

<b2d64.rex>2進数から10進数へ
Numeric Digits 20

myTab = '09'x
do i = 1 while lines() > 0
    num01 = linein()    /* STDIN */
   
    a02 = b2x(num01)
    a03 = x2d(b2x(num01),16) 
    Call lineout ,a03||myTab||num01 /* STDOUT */
end

Call lineout !,Right("00000"||i,5)||" counts" /* STDERR */


<dec2bin64.rex>10進数から2進数へ

Numeric Digits 20

myTab = '09'x
do i = 1 while lines() > 0
    num01 = linein()    /* STDIN */
   
    a01 = Right("                    "||num01,20)
    a02 = d2x(num01,16)
    a03 = x2b(d2x(num01,16))  /* DEC2BINに相当するもの無し*/
    Call lineout ,a01||myTab||a02||myTab||a03 /* STDOUT */
end

Call lineout !,Right("00000"||i,5)||" counts" /* STDERR */


※注意
<d2b64.rex>
Numeric Digits 20

myTab = '09'x
    num01 = "-618399247191519"    /* STDIN */
   
    /*a01 = Right("                    "||num01,20)*/
    SAY d2x(num01,16)
    SAY x2b(d2x(num01,16))  /* DEC2BINに相当するもの無し*/

R:\>r4 d2b64.rex
FFFFFFFF80000000
1111111111111111111111111111111110000000000000000000000000000000

R:\>regina d2b64.rex
FFFDCD91B48AB221
1111111111111101110011011001000110110100100010101011001000100001

R:\>

C:\Documents and Settings\USER\デスクトップ>rexx -v
Open Object Rexx Version 4.1.0
Build date: Dec  5 2010
Addressing Mode: 32

Copyright (c) IBM Corporation 1995, 2004.
Copyright (c) RexxLA 2005-2010.
All Rights Reserved.
This program and the accompanying materials are made available under
the terms of the Common Public License v1.0 which accompanies this
distribution or at
http://www.oorexx.org/license.html

C:\Documents and Settings\USER\デスクトップ>rexx d2b64.rex
FFFDCD91B48AB221
1111111111111101110011011001000110110100100010101011001000100001

C:\Documents and Settings\USER\デスクトップ>


<a01.rex>
Numeric Digits 20

myTab = '09'x
a01 ="1111111111111100011100101000000101011011001110011000000000000001"
SAY b2x(a01)
SAY x2D(b2x(a01),16)

a01 ="1111111111111100011111011011101111001111000010010000000110000111"
SAY b2x(a01)
SAY x2D(b2x(a01),16)

 

R:\>r4 a01.rex
FFFC72815B398001
-999999999999999
FFFC7DBBCF090187
-987654321012345

R:\>regina a01.rex
FFFC72815B398001
-999999999999999
FFFC7DBBCF090187
-987654321012345

R:\>

下記ooREXX

C:\Documents and Settings\USER\デスクトップ>rexx a01.rex
FFFC72815B398001
-999999999999999
FFFC7DBBCF090187
-987654321012345

C:\Documents and Settings\USER\デスクトップ>

  


この記事についてブログを書く
« でっきるかな?PowerShell 002 | トップ | VBScriptで10進数15桁+-のdec... »