ໂປຣແກຣມ ແປງຈາກ Bin ເປັນ Hex ແລະ ຍັງສາມາດແປງ ຈາກ Hex ມາເປັນ Bin ຄືນໄດ້
Image does not exist: https://image.ibb.co/bFmk8a/bin2hex.png
ໂຄ້ດຂອງໂປຣແກຣມນີ້
Private Sub Command1_Click()
Dim InputString As String
Dim k As String
Dim n As Long
Dim OutputString As String
If Text1.Text = "" Then Exit Sub
Open Text1.Text For Binary As #1
InputString = String(LOF(1), 0)
Get #1, 1, InputString
Close #1
OutputString = ""
For n = 1 To Len(InputString)
k = Hex(Asc(Mid(InputString, n, 1)))
If Len(k) < 2 Then k = "0" & k
OutputString = OutputString & k
' Select Case n
' Case 50, 100, 150, 200, 250, 300, 350, 400, 450, 500, 550, 600, 650, 700, 750, 800, 850, 900, 950, 1000, 1050, 1100, 1150, 1200, 1250, 1300, 1350, 1400, 1450, 1500, 1550, 1600, 1650, 1700, 1750, 1800, 1850, 1900, 1950, 2000
' OutputString = OutputString + """ & _ " + vbNewLine + """"
' End Select
Next n
Open App.Path & "dump.txt" For Binary As #1
Put #1, 1, OutputString
Close #1
MsgBox "File: " + Text1.Text + " dump was succesfully.", vbInformation
End Sub
Private Function HexToBytes(ByVal HexString As String) As Byte()
'Quick and dirty hex String to Byte array. Accepts:
'
' "HH HH HH"
' "HHHHHH"
' "H HH H"
' "HH,HH, HH" and so on.
Dim Bytes() As Byte
Dim HexPos As Long
Dim HexDigit As Long
Dim BytePos As Long
Dim Digits As Long
ReDim Bytes(Len(HexString) 2) 'Initial estimate.
For HexPos = 1 To Len(HexString)
HexDigit = InStr("0123456789ABCDEF", _
UCase$(Mid$(HexString, HexPos, 1))) - 1
If HexDigit >= 0 Then
If BytePos > UBound(Bytes) Then
'Add some room, we'll add room for 4 more to decrease
'how often we end up doing this expensive step:
ReDim Preserve Bytes(UBound(Bytes) + 4)
End If
Bytes(BytePos) = Bytes(BytePos) * &H10 + HexDigit
Digits = Digits + 1
End If
If Digits = 2 Or HexDigit < 0 Then
If Digits > 0 Then BytePos = BytePos + 1
Digits = 0
End If
Next
If Digits = 0 Then BytePos = BytePos - 1
If BytePos < 0 Then
Bytes = "" 'Empty.
Else
ReDim Preserve Bytes(BytePos)
End If
HexToBytes = Bytes
End Function
Private Sub Command2_Click()
Dim b() As Byte
Dim OutputString As String
Open App.Path & "dump.txt" For Input As #1
Input #1, OutputString
Close #1
b = HexToBytes(OutputString)
Open App.Path & "Converted.exe" For Binary As #1
Put #1, 1, b
Close #1
MsgBox "Success.", vbInformation
End Sub
Private Sub Form_Load()
Text1.OLEDropMode = 1
End Sub
Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Text = Data.Files.Item(1)
End Sub
ຫລື ດາວໂຫລດໄຟລ
ລະຫັດເປີດ zip: Alexzblog
[download=https://dl.dropboxusercontent.com/s/nh0s85phxz2wyex/Bin2Hex.zip name=ດາວໂຫລດ]
