求助!vb编程--BCD码转换成文本

zhouhuan

怎样用vb6.0编数字转换系统?计算机接受的BCD码,要转换成文本文件.快帮帮我啊!拜托拉!

[ 本帖最后由 风花雪月 于 2006-11-20 08:52 编辑 ]

redsun

用BYTE接收双BCD码，然后通过运算（对十六取模）分离两个 BCD码

[此贴子已经被作者于2006-5-14 20:04:34编辑过]

寂寞的木偶

budong

风花雪月

'由BCD转ASCII码  
Function  BCDToAsc(BCD()  As  Byte)  As  Byte()  
       Dim  i  As  Integer  
       Dim  bTemp  As  Byte  
       Dim  bAsc()  As  Byte  
       Dim  intLen  As  Integer  
         
       intLen  =  UBound(BCD)  
       ReDim  bAsc(intLen  *  2  +  1)  As  Byte  '重新定义数组上标  
         
       For  i  =  0  To  intLen  
               bTemp  =  (BCD(i)  /  16)  And  &HF  
               If  bTemp  >  9  Then  
                       bAsc(i  *  2)  =  bTemp  +  Asc("A")  -  10  
               Else  
                       bAsc(i  *  2)  =  bTemp  +  Asc("0")  
               End  If  
                 
               bTemp  =  BCD(i)  And  &HF  
                 
               If  bTemp  >  9  Then  
                       bAsc(i  *  2  +  1)  =  bTemp  +  Asc("A")  -  10  
               Else  
                       bAsc(i  *  2  +  1)  =  bTemp  +  Asc("0")  
               End  If  
       Next  
         
       BCDToAsc  =  bAsc  
End  Function  

---------------------------------------------------------------

'由ASCII码转BCD码  
Function  AscToBCD(ASCII()  As  Byte)  As  Byte()  
       Dim  i  As  Integer  
       Dim  bTemp  As  Byte  
       Dim  bBCD()  As  Byte  
       Dim  bAsc()  As  Byte  
       Dim  bA  As  Byte  
       Dim  bB  As  Byte  
       Dim  intLen  As  Integer  
         
       intLen  =  UBound(ASCII)  
         
       If  intLen  Mod  2  =  0  Then  intLen  =  intLen  +  1  
       ReDim  bAsc(intLen)  As  Byte  
       ReDim  bBCD((intLen  +  1)  /  2  -  1)  As  Byte  
         
       For  i  =  0  To  UBound(ASCII)  
               bAsc(i)  =  ASCII(i)  
       Next  
         
       If  intLen  >  i  Then  bAsc(intLen)  =  &H0      '对数组不是偶数的补位  
         
       For  i  =  0  To  intLen  
               If  bAsc(i)  <  Asc("0")  Then  
                       bAsc(i)  =  Asc("0")  
               ElseIf  ((bAsc(i)  >  Asc("9"))  And  (bAsc(i)  <  Asc("A")))  Then  
                       bAsc(i)  =  Asc("0")  
               ElseIf  ((bAsc(i)  >  Asc("F"))  And  (bAsc(i)  <  Asc("a")))  Then  
                       bAsc(i)  =  Asc("0")  
               ElseIf  (bAsc(i)  >  Asc("f"))  Then  
                       bAsc(i)  =  Asc("0")  
               End  If  
                 
               If  (bAsc(i)  >=  Asc("0")  And  bAsc(i)  <=  Asc("9"))  Then  
                       bA  =  bAsc(i)  -  Asc("0")  
               ElseIf  (bAsc(i)  >=  Asc("a")  And  bAsc(i)  <=  Asc("z"))  Then  
                       bA  =  bAsc(i)  -  Asc("a")  +  &HA  
               Else  
                       bA  =  bAsc(i)  -  Asc("A")  +  &HA  
               End  If  
                 
               i  =  i  +  1  
                 
               If  bAsc(i)  <  Asc("0")  Then  
                       bAsc(i)  =  Asc("0")  
               ElseIf  ((bAsc(i)  >  Asc("9"))  And  (bAsc(i)  <  Asc("A")))  Then  
                       bAsc(i)  =  Asc("0")  
               ElseIf  ((bAsc(i)  >  Asc("F"))  And  (bAsc(i)  <  Asc("a")))  Then  
                       bAsc(i)  =  Asc("0")  
               ElseIf  (bAsc(i)  >  Asc("f"))  Then  
                       bAsc(i)  =  Asc("0")  
               End  If  
                 
               If  (bAsc(i)  >=  Asc("0")  And  bAsc(i)  <=  Asc("9"))  Then  
                       bB  =  bAsc(i)  -  Asc("0")  
               ElseIf  (bAsc(i)  >=  Asc("a")  And  bAsc(i)  <=  Asc("z"))  Then  
                       bB  =  bAsc(i)  -  Asc("a")  +  &HA  
               Else  
                       bB  =  bAsc(i)  -  Asc("A")  +  &HA  
               End  If  
                 
               bBCD((i  -  1)  /  2)  =  (bA  *  16)  Xor  bB  
       Next  
         
       AscToBCD  =  bBCD  
End  Function  
---------------------------------------------------------------  

调用BCDToAsc  
Private  Sub  Command1_Click()  
       Dim  bA(3)  As  Byte  
       Dim  bB()  As  Byte  
       Dim  i  As  Integer  
         
       bA(0)  =  Asc("1")  
       bA(1)  =  Asc("0")  
       bA(2)  =  Asc("a")  
       bA(3)  =  Asc("F")  
         
       bB  =  AscToBCD(bA)  
       For  i  =  0  To  UBound(bB)  
               MsgBox  Hex(bB(i))  
       Next  
End  Sub