Option Explicit
Private Function Binario(Num As Byte) As String
Dim I As Integer
Dim num1 As Integer
Dim bin As String
num1 = Num
Do While num1 > 0
If num1 \ 2 = num1 / 2 Then bin = bin & "0"
If num1 \ 2 <> num1 / 2 Then bin = bin & "1"
num1 = num1 \ 2
Loop
For I = Len(bin) To 7
bin = bin & "0"
Next I
Binario = StrReverse(bin)
End Function
Private Sub chkCarattere_Click()
If txtXcorso.Text <> "" Then Apri (txtXcorso)
End Sub
Private Sub cmdApri_Click()
CDialog.Filter = "Tutti i file (*.*)|*.*"
CDialog.ShowOpen
txtXcorso.Text = CDialog.FileName
CDialog.FileName = ""
If txtXcorso.Text <> "" Then Apri (txtXcorso.Text)
End Sub
Private Sub cmdAbout_Click()
MsgBox "Il file viene convertito in binario, ma in realtà è esadecimale." & vbCrLf & "Infatti quendo il file in binario viene salvato è grande 10 o 16 volte il file d' origine", vbInformation, Me.Caption
End Sub
Private Sub cmdSalva_Click()
Dim I As Integer
CDialog.Filter = "File di testo (*.txt)|*.txt"
CDialog.ShowSave
CDialog.FileName = ""
If CDialog.CancelError = True Then Exit Sub
Open CDialog.FileName For Output As 1
For I = 0 To lstBinario.ListCount
Print #1, lstBinario.List(I)
Next I
Close 1
End Sub
Private Sub Apri(XCorso As String)
Dim Bait As Byte
Dim StringaBinaria As String
lstBinario.Clear
Open XCorso For Binary As 1
If LOF(1) > 32766 Then GoTo Errore
Do While EOF(1) = False
Get 1, , Bait
StringaBinaria = Binario(Bait)
If CBool(chkCarattere.Value) = True Then StringaBinaria = Binario(Bait) & " --> " & Chr(Bait)
lstBinario.AddItem StringaBinaria
Loop
Close 1
lstBinario.RemoveItem lstBinario.ListCount - 1
Exit Sub
Errore:
MsgBox "Errore, le dimensioni del file " & XCorso & " sono superiori a 32.766 Byte", vbExclamation, Me.Caption
Close 1
End Sub
