home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / RegEdit_2_2049892242007.psc / RegEdit / clsHexClass.cls < prev    next >
Text File  |  2006-08-31  |  9KB  |  282 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsHexClass"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. 'I rushed th Hex Editor a bit
  15. 'Ended up wrapping into this class
  16. 'seems to work OK
  17. Dim mHex() As String
  18. Dim mBin() As Byte
  19. Dim mAsc() As String
  20. Dim HexString As String
  21. Dim AscString As String
  22. Public Property Get HexData() As Variant
  23.     HexData = mHex
  24. End Property
  25. Public Property Let HexData(ByVal vNewValue As Variant)
  26.     Dim Z As Long
  27.     Erase mHex
  28.     Erase mAsc
  29.     mHex = vNewValue
  30.     ReDim mAsc(0 To UBound(mHex))
  31.     For Z = 0 To UBound(mHex)
  32.         mAsc(Z) = HexToAsc(mHex(Z))
  33.     Next
  34.     HexString = Join(mHex, Chr(32))
  35.     AscString = Join(mAsc, Chr(32))
  36. End Property
  37. Public Property Get BinData() As Variant
  38.     BinData = mBin
  39. End Property
  40. Public Property Let BinData(ByVal vNewValue As Variant)
  41.     mBin = vNewValue
  42. End Property
  43. Public Property Get AscData() As Variant
  44.     AscData = mAsc
  45. End Property
  46. Public Property Let AscData(ByVal vNewValue As Variant)
  47.     mAsc = vNewValue
  48. End Property
  49. Public Property Get HexStr() As String
  50.     HexStr = HexString
  51. End Property
  52. Public Property Let HexStr(ByVal vNewValue As String)
  53.     HexString = vNewValue
  54. End Property
  55. Public Property Get AscStr() As String
  56.     AscStr = AscString
  57. End Property
  58. Public Property Let AscStr(ByVal vNewValue As String)
  59.     AscString = vNewValue
  60. End Property
  61. Public Sub LoadRawHex(mSrc As String)
  62.     Dim mVar As Variant, Z As Long, z1 As Long
  63.     HexString = Replace(mSrc, vbLf, Chr(32))
  64.     HexString = Replace(HexString, vbCrLf, Chr(32))
  65.     HexString = Replace(HexString, vbCr, Chr(32))
  66.     mVar = Split(Trim(HexString), Chr(32))
  67.     For Z = 0 To UBound(mVar)
  68.         If Len(mVar(Z)) <> 0 Then z1 = z1 + 1
  69.     Next
  70.     ReDim mHex(0 To z1)
  71.     ReDim mAsc(0 To z1)
  72.     z1 = 0
  73.     For Z = 0 To UBound(mVar)
  74.         If Len(mVar(Z)) <> 0 Then
  75.             mHex(z1) = mVar(Z)
  76.             mAsc(z1) = HexToAsc(mVar(Z))
  77.             z1 = z1 + 1
  78.         End If
  79.     Next
  80. End Sub
  81. Public Sub LoadRawAsc(mSrc As String)
  82.     Dim Z As Long, mVar As Variant
  83.     AscString = Replace(mSrc, vbLf, Chr(32))
  84.     AscString = Replace(AscString, vbCrLf, Chr(32))
  85.     AscString = Replace(AscString, vbCr, Chr(32))
  86.     mVar = Split(AscString, Chr(32))
  87.     ReDim mHex(0 To UBound(mVar))
  88.     ReDim mAsc(0 To UBound(mVar))
  89.     For Z = 0 To UBound(mVar)
  90.         mHex(Z) = Hex$(Asc((mVar(Z))))
  91.         If Len(mHex(Z)) = 1 Then mHex(Z) = "0" + mHex(Z)
  92.         If Len(mHex(Z)) = 0 Then mHex(Z) = "00"
  93.         mAsc(Z) = mVar(Z)
  94.     Next
  95.     HexString = Join(mHex, Chr(32))
  96.     AscString = Join(mAsc, Chr(32))
  97. End Sub
  98. Public Sub LoadRawBin(arrByte As Variant)
  99.     Dim Z As Long, q As Long
  100.     ReDim mHex(0 To UBound(arrByte))
  101.     ReDim mAsc(0 To UBound(arrByte))
  102.     For Z = 0 To UBound(arrByte)
  103.         mHex(Z) = Format(Hex$(arrByte(Z)), "00")
  104.         If Len(mHex(Z)) = 1 Then mHex(Z) = "0" + mHex(Z)
  105.         If Len(mHex(Z)) = 0 Then mHex(Z) = "00"
  106.         mAsc(Z) = Str(arrByte(Z))
  107.         q = Val(mAsc(Z))
  108.         If q < 33 Or (q > 126 And q < 144) Or (q > 147 And q < 161) Then
  109.             mAsc(Z) = Chr(46)
  110.         Else
  111.             mAsc(Z) = Chr(q)
  112.         End If
  113.     Next
  114.     HexString = Join(mHex, Chr(32))
  115.     AscString = Join(mAsc, Chr(32))
  116. End Sub
  117. Public Function DataSplit(mWidth As Long, mSrc As Variant, Optional mSeparator As String = "") As String
  118.     Dim Z As Long, Temp As String
  119.     For Z = 0 To UBound(mSrc)
  120.         If ((Z + 1) Mod mWidth) = 0 Then
  121.             Temp = Temp + mSrc(Z) + vbLf
  122.         Else
  123.             Temp = Temp + mSrc(Z) + mSeparator
  124.         End If
  125.         DoEvents
  126.     Next
  127.     DataSplit = Temp
  128. End Function
  129. Private Function HexToAsc(ByVal HexStr As String) As String
  130.     Dim mult As Double
  131.     Dim DecNum As Long
  132.     Dim ch As String
  133.     Dim tempASC As String
  134.     mult = 1
  135.     DecNum = 0
  136.     Dim i As Integer
  137.     For i = Len(HexStr) To 1 Step -1
  138.         ch = Mid(HexStr, i, 1)
  139.         If (ch >= "0") And (ch <= "9") Then
  140.             DecNum = DecNum + (Val(ch) * mult)
  141.         Else
  142.             If (ch >= "A") And (ch <= "F") Then
  143.                 DecNum = DecNum + ((Asc(ch) - Asc("A") + 10) * mult)
  144.             Else
  145.                 If (ch >= "a") And (ch <= "f") Then
  146.                     DecNum = DecNum + ((Asc(ch) - Asc("a") + 10) * mult)
  147.                 Else
  148.                     HexToAsc = ""
  149.                     Exit Function
  150.                 End If
  151.             End If
  152.         End If
  153.         mult = mult * 16
  154.     Next i
  155.     tempASC = Chr(DecNum)
  156.     If DecNum < 33 Or (DecNum > 126 And DecNum < 144) Or (DecNum > 147 And DecNum < 161) Then
  157.         tempASC = Chr(46)
  158.     Else
  159.         tempASC = Chr(DecNum)
  160.     End If
  161.     HexToAsc = tempASC
  162. End Function
  163. Public Sub EditByteByAsc(mStartIndex As Long, mSrc As Variant)
  164.     Dim Z As Long
  165.     If mStartIndex > UBound(mAsc) Then
  166.         Z = mStartIndex
  167.         If (mStartIndex - 1 Mod 2) <> 0 Then Z = Z + 1
  168.         ReDim Preserve mAsc(0 To Z)
  169.         ReDim Preserve mHex(0 To Z)
  170.     End If
  171.     For Z = mStartIndex To mStartIndex + UBound(mSrc)
  172.         mAsc(Z) = mSrc(Z - mStartIndex)
  173.         mHex(Z) = Hex$(Asc((mSrc(Z - mStartIndex))))
  174.         If Len(mHex(Z)) = 1 Then mHex(Z) = "0" + mHex(Z)
  175.         If Len(mHex(Z)) = 0 Then mHex(Z) = "00"
  176.     Next
  177. End Sub
  178. Public Sub EditByteByHex(mStartIndex As Long, mSrc As Variant)
  179.     Dim Z As Long
  180.     If mStartIndex + UBound(mSrc) > UBound(mAsc) Then
  181.         Z = mStartIndex + UBound(mSrc)
  182.         ReDim Preserve mAsc(0 To Z)
  183.         ReDim Preserve mHex(0 To Z)
  184.     End If
  185.     For Z = mStartIndex To mStartIndex + UBound(mSrc)
  186.         mAsc(Z) = HexToAsc(mSrc(Z - mStartIndex))
  187.         mHex(Z) = mSrc(Z - mStartIndex)
  188.         If Len(mHex(Z)) = 1 Then mHex(Z) = "0" + mHex(Z)
  189.         If Len(mHex(Z)) = 0 Then mHex(Z) = "00"
  190.     Next
  191.     HexData = mHex
  192. End Sub
  193. Public Sub RemoveBytes(mStart As Long, mFin As Long)
  194.     Dim NewCnt As Long, tmpBytes() As String, Z As Long, nz As Long
  195.     NewCnt = UBound(mHex) - (mFin - mStart)
  196.     ReDim tmpBytes(0 To NewCnt)
  197.     For Z = 0 To mStart - 1
  198.         tmpBytes(Z) = mHex(Z)
  199.     Next
  200.     For nz = mFin + 1 To UBound(mHex)
  201.         tmpBytes(Z) = mHex(nz)
  202.         Z = Z + 1
  203.     Next
  204.     HexData = tmpBytes
  205. End Sub
  206. Public Sub AddBytesAsBytes(mStart As Long, mInsert As Variant)
  207.     Dim NewCnt As Long, tmpBytes() As String, Z As Long, nz As Long, nzz As Long
  208.     Dim Cnt As Long
  209.     NewCnt = UBound(mHex) + UBound(mInsert) + 1
  210.     ReDim tmpBytes(0 To NewCnt)
  211.     For Z = 0 To mStart - 1
  212.         tmpBytes(Z) = mHex(Z)
  213.     Next
  214.     For nz = mStart To mStart + UBound(mInsert)
  215.         tmpBytes(nz) = mInsert(Cnt)
  216.         Cnt = Cnt + 1
  217.     Next
  218.     For nzz = mStart To UBound(mHex)
  219.         tmpBytes(nz) = mHex(nzz)
  220.         nz = nz + 1
  221.     Next
  222.     HexData = tmpBytes
  223. End Sub
  224. Public Sub AddBytes(mStart As Long, mInsert As String)
  225.     Dim NewCnt As Long, tmpBytes() As String, Z As Long, nz As Long, nzz As Long
  226.     Dim tmpStr As String, Temp As String
  227.     tmpStr = Replace(mInsert, vbLf, "")
  228.     tmpStr = Replace(tmpStr, vbCrLf, "")
  229.     tmpStr = Replace(tmpStr, vbCr, "")
  230.     NewCnt = UBound(mHex) + Len(tmpStr)
  231.     ReDim tmpBytes(0 To NewCnt)
  232.     For Z = 0 To mStart
  233.         tmpBytes(Z) = mHex(Z)
  234.     Next
  235.     For nz = 1 To Len(tmpStr)
  236.         Temp = Mid(tmpStr, nz, 1)
  237.         If Trim(Temp) <> "" Then mHex(Z + nz - 1) = Hex$(Asc(Temp))
  238.         If Len(mHex(Z + nz - 1)) = 1 Then mHex(Z + nz - 1) = "0" + mHex(Z + nz - 1)
  239.         If Len(mHex(Z + nz - 1)) = 0 Then mHex(Z + nz - 1) = "00"
  240.     Next
  241.     For nzz = mStart + 1 To UBound(mHex)
  242.         tmpBytes(Z + nz - 1) = mHex(nzz)
  243.         Z = Z + 1
  244.     Next
  245.     HexData = tmpBytes
  246. End Sub
  247. Public Sub AddEmptyLine()
  248.     Dim tmpBytes() As String, Z As Long
  249.     Dim tmpStr As String, Temp As String
  250.     ReDim tmpBytes(0 To UBound(mHex) + 8)
  251.     For Z = 0 To UBound(mHex)
  252.         tmpBytes(Z) = mHex(Z)
  253.     Next
  254.     For Z = UBound(mHex) + 1 To UBound(mHex) + 8
  255.         tmpBytes(Z) = "00"
  256.     Next
  257.     HexData = tmpBytes
  258. End Sub
  259. Public Function GetBytes(mStart As Long, mEnd As Long) As Variant
  260.     Dim Z As Long, tmpStr() As String, Cnt As Long
  261.     ReDim tmpStr(0 To mEnd - mStart)
  262.     For Z = mStart To mEnd
  263.         If Z > UBound(mHex) Then Exit For
  264.         tmpStr(Cnt) = mHex(Z)
  265.         Cnt = Cnt + 1
  266.     Next
  267.     GetBytes = tmpStr
  268. End Function
  269. Public Function CreateByteList() As String
  270.     Dim bList() As String, Cnt As Long
  271.     ReDim bList(0 To Int(UBound(mHex) / 8) + 1)
  272.     For Z = 0 To UBound(mHex) Step 8
  273.         bList(Cnt) = Hex$(Z)
  274.         If Len(bList(Cnt)) = 1 Then bList(Cnt) = "000" + bList(Cnt)
  275.         If Len(bList(Cnt)) = 2 Then bList(Cnt) = "00" + bList(Cnt)
  276.         If Len(bList(Cnt)) = 3 Then bList(Cnt) = "0" + bList(Cnt)
  277.         If Len(bList(Cnt)) > 4 Then bList(Cnt) = Right(bList(Cnt), 4)
  278.         Cnt = Cnt + 1
  279.     Next Z
  280.     CreateByteList = Join(bList, vbLf)
  281. End Function
  282.