Xây dựng hàm riêng bin2hex dựa theo cách nghĩ mới

tuhocvba

Administrator
Thành viên BQT
Khi chúng tôi giải quyết bài toán truyền tin trong oto, cần tính toán CRC, đã gặp bài toán như sau:
Việc chuyển dãy nhị phân thành hệ 16 hexa đã gặp vấn đề tràn số.
Trong VBA excel đã có hàm WorksheetFunction.Bin2Hex , tuy nhiên nếu input là một dãy nhị phân có độ dài là 64 (gồm 64 ký tự 1 hoặc 0: 1001010101...101), thì
hàm này không xử lý được.
Nếu theo cách nghĩ thông thường:
Dãy nhị phân -> Chuyển đổi thành số thập phân (hệ cơ số 10) -> Chuyển đổi sang hệ 16.
Chúng ta sẽ gặp vấn đề tràn số ở bước dưới đây khi dãy nhị phân có độ dài quá lớn:
Dãy nhị phân -> Chuyển đổi thành số thập phân (hệ cơ số 10)
Nhằm khắc phục điều này, ta cần xây dựng thuật toán mới và hàm riêng để chuyển đổi dãy nhị phân sang hệ 16 với độ dài nhị phân không hạn chế.
Bạn cần đăng nhập để thấy đính kèm

Xét ví dụ dưới đây:

1111 1101(b) = 0xFD

Ta có \[ 2^4=16 \].

Một chữ số trong hệ 16 là: 0,1,2,…,D,E,F có giá trị từ 0 tới 15 trong hệ cơ số 10.

Như vậy bất cứ một chữ số trong hệ 16 nào cũng có thể được biểu diễn bởi một dãy nhị phân có độ dài là 4.

Ta ví dụ:

15 = 0xF = 1111(b)

14 = 0xE = 1110(b)



0 = 0x0 = 0000(b)

Nói như vậy, nếu ta có một dãy nhị phân có độ dài vô cùng, ta chỉ việc tách thành từng đoạn có độ dài là 4 rồi chuyển sang hệ 16. Ví dụ:

1111 1101(b)

Ta thực hiện tách dãy nhị phân thành từng đoạn có độ dài là 4:

1111(b) = 0xF

1101(b) = 0xD

Nên: 1111 1101(b) = 0xFD
Từ đó ta xây dựng được hàm như sau:
Mã:
'Input: 11111101
'Output: FD

'Input: 1120
'Output: CanNotCalculator
Function bin2hexsub(ByVal s4 As String) As String
    Dim i       As Integer
    Dim cnt     As Integer
    Dim temp    As String
    Dim c       As String
    Dim out     As String
 
    bin2hexsub = ""
    out = ""
    If Len(s4) = 0 Then
        bin2hexsub = "0"
        Exit Function
    Else
        cnt = 0
        temp = ""
        For i = 1 To Len(s4) Step 1
            c = Mid(s4, i, 1)
            If InStr(1, "01", c) = 0 Then
                bin2hexsub = "CanNotCalculator"
                Exit Function 'Phat hien khong phai la day nhi phan. c khong phai la 1 hoac 0
            End If
            cnt = cnt + 1
            temp = temp & c
            If cnt = 4 Then
                out = out & WorksheetFunction.Bin2Hex(temp)
                temp = ""
                cnt = 0
            End If
        Next i
    End If
    bin2hexsub = out
End Function
Mặc dù trong hàm trên ta sử dụng WorksheetFunction.Bin2Hex, nhưng đầu vào của hàm này là chuỗi nhị phân có độ dài là 4, cho nên sẽ không có tràn số xảy ra.
Tuy nhiên vì hàm này nhận dãy nhị phân có độ dài là bội của 4. Nếu dãy nhị phân có độ dài là 2: 10 hoặc 3: 111, hoặc 7: 1011011 thì sẽ không thực hiện được.
Vì vậy ta cần chèn các số 0 vào trước đó.
Ví dụ: 10 -> 0010, 111 -> 0111, 1011011 -> 01011011
Và bây giờ ta có hàm chuyển đổi dãy nhị phân sang hệ hexa không bị hạn chế bởi độ dài dãy nhị phân, cũng như không cần quan tâm độ dài nhị phân có là bội của 4 hay không:
Mã:
'Input: 11111
'Output: 1F

'Input: 11201
'Output: CanNotCalculator
Function bin2hexmain(ByVal s As String) As String
    Dim i As Integer
    Dim n As Integer
    Dim s4  As String
 
    n = Len(s) Mod 4
 
    If n = 0 Then
        bin2hexmain = bin2hexsub(s)
    Else
        s4 = ""
        For i = 1 To 4 - n Step 1
            s4 = s4 & "0"
        Next i
        s4 = s4 & s
        bin2hexmain = bin2hexsub(s4)
    End If
End Function
 

Euler

Administrator
Thành viên BQT
Trong kỹ thuật xử lý tín hiệu, logic với bit là rất quan trọng. Nhân đây tôi cũng muốn kiểm tra lại các phép logic với Bit của VBA.
1. Phép toán AND:
1.1Cơ sở logic:

InputInputOutput
100
111
010
000

Kiểm chứng:
Bạn cần đăng nhập để thấy hình ảnh

1.2 Chạy code:
Mã:
Sub test()
    Dim i As Integer
    Dim j   As Integer
    Dim kq As Integer
    
    i = 129
    j = 15
    kq = i And j
    MsgBox kq
End Sub
Kết quả chạy code:
Bạn cần đăng nhập để thấy hình ảnh


2. Phép toán OR:
2.1 Cơ sở logic:

INPUTINPUTOUTPUT
111
101
011
000
Kiểm chứng (ảnh minh họa là AND-đính chính phép logic ở đây là OR):
Bạn cần đăng nhập để thấy hình ảnh

2.2 Chạy Code:
Mã:
Sub test()
    Dim i As Integer
    Dim j   As Integer
    Dim kq As Integer
    
    i = 129
    j = 15
    kq = i Or j
    MsgBox kq
End Sub
Kết quả:
Bạn cần đăng nhập để thấy hình ảnh


3. Phép toán logic Xor:
3.1 Cơ sở logic:

InputInputOutput
101
011
000
110

Kiểm chứng(ảnh minh họa là AND-đính chính phép logic ở đây là Xor)::
Bạn cần đăng nhập để thấy hình ảnh


3.2 Chạy code:
Mã:
Sub test()
    Dim i As Integer
    Dim j   As Integer
    Dim kq As Integer
    
    i = 129
    j = 15
    kq = i Xor j
    MsgBox kq
End Sub
Kết quả:
Bạn cần đăng nhập để thấy hình ảnh
 

tuhocvba

Administrator
Thành viên BQT
Khai thác chủ đề: Ứng dụng VBA vào giải quyết tự động tạo CAPL cho Canalyzer hoặc CANoe.
Chúng ta biết rằng đối với bài toán xử lý tín hiệu, ví dụ trong việc tạo CAPL cho Canalyzer hay cho CANoe, đối với CANdatabase là file .dbc thì việc code cho CAPL trở nên đơn giản, vì chúng ta chỉ việc gõ trực tiếp tên tín hiệu. Tuy nhiên nếu CANdatabase là file Autosar thì chúng ta phải xử lý trên byte, can thiệp vào từng bit trên byte đó.
Giả thiết chúng ta có một byte gồm 8 bit (bit7 tới bit0). Chúng ta muốn thay đổi giá trị tín hiệu A tương ứng với bit5 tới bit1 gán giá trị ZZZZZ thì thuật toán can thiệp vào byte bit sẽ là:
Bạn cần đăng nhập để thấy hình ảnh

Chúng ta cần hai bước toán trung gian là AND và OR. Trước hết chúng ta sẽ cho tín hiệu AND với một dãy bit như trên hình vẽ minh họa. Trong đó tại các vị trí cần thiết (tô vàng) chúng ta sẽ thiết định các bit này là 0. Tại các vị trí không cần thiết thì giá trị của bit sẽ là 1. Như vậy các bit không liên quan sẽ không bị thay đổi giá trị sau khi đi qua phép logic AND, ta được kết quả RESULT_1.
Bây giờ ta thiết định tại các Bit liên quan là ZZZZZ thì ta cho đi qua phép logic OR như trên hình vẽ minh họa. Xin chú ý hình vẽ minh họa trên có chút nhầm lẫn ở bit 0 của RESULT_2. Không phải là 0, đúng phải là X.
Ta sẽ xây dựng Macro để tạo ra dãy bit AND và dãy bit OR như hình minh họa dưới đây.
Bạn cần đăng nhập để thấy hình ảnh

1. Ta xây dựng hàm AND1:
Mã:
Function and1(ByVal bg As Byte, ByVal ed As Byte) As String
    Dim i As Integer
    Dim s As String
    s = ""
    For i = 7 To 0 Step -1
        If i > bg Then
            s = s & "1"
        ElseIf i < ed Then
            s = s & "1"
        Else
            s = s & "0"
        End If
    Next i
    and1 = s
End Function
Sub test3a()
    Dim s2 As String
    s2 = and1(5, 1)
    MsgBox s2
End Sub
Chạy thủ tục test3a để kiểm tra tính đúng đắn của hàm and1:
Bạn cần đăng nhập để thấy hình ảnh

Kết quả đúng như chúng ta mong muốn.
2. Ta xây dựng hàm OR1:
Mã:
Function or1(ByVal insert_sig As Byte, ByVal bg As Byte, ByVal ed As Byte) As String
    Dim i               As Integer
    Dim s               As String
    Dim insert_sig_b    As String 'WorksheetFunction.Dec2Bin
    Dim l               As Byte
    s = ""
    insert_sig_b = WorksheetFunction.Dec2Bin(insert_sig)
    l = Len(insert_sig_b)
    If (l < (bg - ed + 1)) Then
        For i = l + 1 To bg - ed + 1 Step 1
            insert_sig_b = "0" & insert_sig_b
        Next i
    End If
    For i = 7 To 0 Step -1
        If i > bg Then
            insert_sig_b = "0" & insert_sig_b
        ElseIf i < ed Then
            insert_sig_b = insert_sig_b & "0"
        End If
    Next i
    or1 = insert_sig_b
End Function
Sub test3b()
    Dim s2 As String
    s2 = or1(97, 7, 0) '97 = 0110 0001
    MsgBox s2
End Sub
Chạy thủ tục test3b để kiểm tra tính đúng đắn của hàm or1:
Bạn cần đăng nhập để thấy hình ảnh

Thay đổi một chút trong thủ tục test3b:
Mã:
s2 = or1(97, 7, 1) '97 = 0110 0001
Bạn cần đăng nhập để thấy hình ảnh

Thay đổi một chút trong thủ tục test3b:
Mã:
s2 = or1(40, 6, 1) '40 = 0010 1000
Bạn cần đăng nhập để thấy hình ảnh

Thay đổi một chút trong thủ tục test3b:
Mã:
s2 = or1(40, 5, 0) '40 = 0010 1000
Bạn cần đăng nhập để thấy hình ảnh


Tóm lại bạn hoàn toàn có thể tự mình xây dựng nên các kịch bản test khác nhau để kiểm tra tính đúng đắn:
Bạn cần đăng nhập để thấy hình ảnh

Bạn cần đăng nhập để thấy hình ảnh
 

Euler

Administrator
Thành viên BQT
Khi nghiên cứu Tool tạo CAPL với sự can thiệp trực tiếp vào byte, ta có đề bài như sau:
Bạn cần đăng nhập để thấy đính kèm


Với giả thiết tín hiệu bắt đầu từ byte2 ở bit 5, độ dài tín hiệu là 16, như vậy nó sẽ kết thúc ở byte4, bit 6.
Chúng ta mong muốn Tool liệt kê được kết quả như Result trong ảnh, mỗi byte chứa thông tin bit bắt đầu và bit kết thúc.
Như vậy ở byte2 tín hiệu bắt đầu ở bit5 và kết thúc ở bit0.
Ở byte3 bắt đầu từ bit7 và kết thúc ở bit 0...

Tuy nhiên nhìn như vậy có vẻ hơi ngược, cho nên chúng ta cần thiết kế lại sao cho thân thiện với macro hơn.
Bạn cần đăng nhập để thấy hình ảnh

Ta sẽ đánh số lại thứ tự bit từ 1 tới 8 như ở dòng 5.
Tuy nhiên vì chúng ta sẽ sử dụng mảng và sử dụng khai báo bảo tồn giá trị Preserve mà với khai báo này thì chỉ có thể tăng thêm cột mà không thể tăng thêm dòng, vì vậy chúng ta phải đảo chiều mảng, từ dòng thành cột và ngược lại. Chỗ nào có tín hiệu thì chúng ta lấp đầy bằng 1 như ở dòng 18 cho tới dòng 25 được minh họa trong ảnh trên.
Mã:
'CAPL for Canalyzer, CANoe.
'Author: tuhocvba.net country: Vietnam
Public arrp()
'Way of thinking
'byte           bit_star    bit_end
'       colum   1           2
'
'
'byte2          5           0
'byte3          7           0
'byte4          7           6
'MAIN:
'Use preserve, so Reverse with the above
'           byte2   byte3   byte4
'bit_start  5       7       7
'bit_end    0       0       6

Sub findpos(ByVal posbyte As Byte, ByVal start_bit As Byte, ByVal l As Byte)
'position byte of signal : posbyte. Ex: byte 2
'l = lenght of signal. Ex: 16 bit
'sart_bit. Ex: = 5
    Dim i               As Integer
    Dim j               As Integer
    Dim start_bit_temp  As Byte 'Ex:3
    Dim end_bit_temp    As Byte 'Ex:18
    Dim soluongbyte     As Byte 'So luong row co trong mang arr
    Dim bg              As Byte 'bit start in column below
    Dim ed              As Byte 'bit end in column below
    Dim arr()
    '       byte2   byte3   byte4   byte5 (r)
    '(c)
    '1
    '2
    '3
    '4
    '5
    '6
    '7
    '8
    start_bit_temp = 8 - start_bit
    end_bit_temp = start_bit_temp + l - 1   'Ex: 18
    If end_bit_temp Mod 8 = 0 Then
        soluongbyte = end_bit_temp / 8
    Else
        soluongbyte = Int(end_bit_temp / 8) + 1
    End If
    ReDim arr(1 To 8, posbyte To posbyte + soluongbyte - 1)
   
    For i = start_bit_temp To end_bit_temp Step 1
        c = i Mod 8
        If c = 0 Then
            r = Int(i / 8) + posbyte - 1
            c = 8
        Else
            r = Int(i / 8) + posbyte
        End If
        arr(c, r) = "1"
    Next i
    'Global:
    ReDim arrp(1 To 2, posbyte To posbyte + soluongbyte - 1)
    For i = LBound(arr, 2) To UBound(arr, 2) Step 1
        bg = 7
        ed = 0
        For j = LBound(arr, 1) To UBound(arr, 1) Step 1
            If j = 1 Then
                If CStr(arr(1, i)) = "1" Then
                    bg = 7
                End If
            Else
                If CStr(arr(j, i)) = "1" And CStr(arr(j - 1, i)) <> "1" Then
                    bg = 8 - j
                End If
            End If
            If j = 8 Then
                If CStr(arr(8, i)) = "1" Then
                    ed = 0
                End If
            Else
                If CStr(arr(j, i)) = "1" And CStr(arr(j + 1, i)) <> "1" Then
                    ed = 8 - j
                End If
            End If
        Next j
        arrp(1, i) = bg
        arrp(2, i) = ed
    Next i
    ThisWorkbook.Sheets(3).Range(Cells(18, 4), Cells(25, 6)).Value = arr
End Sub
Sub test1()
    Call findpos(2, 5, 16)
End Sub
Chúng ta chạy thử thủ tục test1 với tham số: tín hiệu bắt đầu từ byte2 bit 5 và có độ dài là 16.
Bạn cần đăng nhập để thấy hình ảnh


Bit bắt đầu được thể hiển ở arrp(1,x) và bit kết thúc được thể hiện ở arrp(2,x) hoàn toàn đúng với thiết kế ở trên.
 
Top