' ---------------------------------------------------------- ' Script VBS de conversion en "Bibinaire" ' © Boby LAPOINTE ' ' Syntaxe: ' bibinaire d|h|b ' d : nombre décimal ' h : nombre hexadécimal ' b : nombre bibinaire ' ' Affiche le nombre dans les 3 formats ' Exemple : ' bibinaire d 1789 ' 1789 (décimal) = ' hexadécimal : 6FD ' bibinaire : BeDiDa ' ' bibinaire b KaDoDeBiBi ' KaDoDeBiBi (bibinaire) = ' décimal : 642679 ' hexadécimal : 9CE77 ' ' JC BELLAMY © 2002 ' ---------------------------------------------------------- Dim args Set args = Wscript.Arguments If args.count <>2 Then msg= "Script VBS de conversion en ""Bibinaire""" & VBCRLF msg=msg & "Principe : Boby LAPOINTE © "& VBCRLF msg=msg & "Script : JCB © 2002"& VBCRLF msg=msg & "--------------------------------------"& VBCRLF syntaxe msg End If typeinit=lcase(args(0)) Select Case typeinit Case "d" strtype="décimal" Case "h" strtype="hexadécimal" Case "b" strtype="bibinaire" Case else msg="*** Erreur de type ***" & VBCRLF syntaxe msg End Select n=args(1) valeur=GetVal(n,typeinit) If valeur=-1 Then msg="*** Nombre " & strtype & " invalide ***" & VBCRLF syntaxe msg End If Msg=n & " (" & strtype &") =" & VBCRLF If typeinit<>"d" Then Msg=Msg & "décimal : " & valeur & VBCRLF If typeinit<>"h" Then Msg=Msg & "hexadécimal : " & hex(valeur) & VBCRLF If typeinit<>"b" Then Msg=Msg & "bibinaire : " & bibin(valeur) & VBCRLF wscript.echo msg Wscript.quit ' ------------------------------------- Sub Syntaxe(msg) msg=msg & "Syntaxe :" & VBCRLF msg=msg & " bibinaire d|h|b " & VBCRLF msg=msg & " d : nombre décimal (chiffres 0 à 9)" & VBCRLF msg=msg & " h : nombre hexadécimal (chiffres 0 à 9 et lettres A à F)" & VBCRLF msg=msg & " b : nombre bibinaire (bigrammes ""Xy"" avec X= H,B,K,D et y= o,a,e,i)" & VBCRLF wscript.echo msg wscript.quit End Sub ' ------------------------------------- Function GetVal(nombre,typeval) longueur=len(nombre) If typeval="b" then If int(longueur/2)*2<>longueur Then GetVal=-1 exit function end if m=longueur-1 s=2 Else m=longueur s=1 End If Result=0 For i = 1 To m step s c=lcase(mid(nombre,i,s)) Select Case typeval Case "d" Select Case c Case "0","1","2","3","4","5","6","7","8","9" Result=Result*10+asc(c)-asc("0") Case else GetVal=-1 exit function End Select Case "h" Select Case c Case "0","1","2","3","4","5","6","7","8","9" Result=Result*16+asc(c)-asc("0") Case "a","b","c","d","e","f" Result=Result*16+asc(c)-asc("a")+10 Case else GetVal=-1 exit function End Select Case "b" c1=left(c,1) c2=right(c,1) Select Case c1 Case "h" Result=Result*16 Case "b" Result=Result*16+4 Case "k" Result=Result*16+8 Case "d" Result=Result*16+12 Case else GetVal=-1 exit function End Select Select Case c2 Case "o" Result=Result Case "a" Result=Result+1 Case "e" Result=Result+2 Case "i" Result=Result+3 Case else GetVal=-1 exit function End Select Case else GetVal=-1 exit function End Select Next GetVal=Result End Function ' ------------------------------------- Function hextobin(c) Select Case c Case "0","1","2","3","4","5","6","7","8","9" hextobin=asc(c)-asc("0") Case else hextobin=asc(c)-asc("a")+10 End Select End Function ' ------------------------------------- Function bibin(n) Dim codebibin codebibin=array( _ "Ho","Ha","He","Hi","Bo","Ba","Be","Bi","Ko","Ka","Ke","Ki","Do","Da","De","Di") hexa=hex(n) longueur=len(hexa) result="" For i = 1 To longueur c=hextobin(lcase(mid(hexa,i,1))) result=result & codebibin(c) Next bibin=Result End Function ' -------------------------------------