تبدیل متن و حروف به 0 و 1

[meys34]

منبع یا کمی تغییرات:
http://www.ozgrid.com/forum/showthread.php?t=55298

Private Sub Command1_Click()

Dim i As Integer



For i = 1 To Len(Text1.Text)

    Print HexToBin(Hex(AscW(Mid$(Text1.Text, i, 1))))

Next

End Sub





Private Function HexToBin(HexNum As String) As String

    Dim BinNum As String

    Dim lHexNum As Long

    Dim i As Integer

     



    lHexNum = Val("&h" & HexNum)

    Do

        If lHexNum And 2 ^ i Then

            BinNum = "1" & BinNum

        Else

            BinNum = "0" & BinNum

        End If

        i = i + 1

    Loop Until 2 ^ i > lHexNum

     '  Return BinNum as a String

    HexToBin = BinNum



End Function