Ver Mensaje Individual
  #1 (permalink)  
Antiguo 19/09/2010, 22:14
Avatar de didix16
didix16
 
Fecha de Ingreso: agosto-2009
Mensajes: 19
Antigüedad: 14 años, 8 meses
Puntos: 0
Ayuda: Escribir en binario un string hexadecimal

Buenas. Desde hace unos días estoy haciendo un programilla que me genera un archivo GCT( en binario). Lo tengo casi del todo acabado, pero me queda hacer un último paso y es generar el archivo en binario correctamente. A traves de un texto estilo:
Código:
Titulo del codigo
AB000000 CD000000
AB000000 CD000000
AB000000 CD000000
AB000000 CD000000
genero un archivo en binario con solo el codigo hexadecimal. Todo bien, creo, he hecho alguna chapuza para que se ajustara lo mejro posible al resultado que quiero pero... no acaba de funcionar. Si el tamaño del codigo es de 64 caracteres(32bytes) o inferior no da errores, pero si pongo mas codigos, el "buffer" de lo que representaria el array de los bytes sobrepasa cirto limite y no funciona. El otro problema es que al final del archivo deberia acabar en
Código:
FF 00 00 00 00 00 00 00 
(Sin las separaciones, pero lo represento como en un editor hexadecimal)
pero despues de eso, se le añaden muchisimos bytes en 00 y asi no es como deberia acabar el archivo...
No se si me he explicado bien... espero que me puedan ayudar. Aqui les dejo la parte del código para generar esto:
Código:
Private Sub export_to_GCT_Click()

Dim sFile As String
CommonDialog1.ShowSave
If Len(CommonDialog1.Filename) = 0 Then
End If
sFile = CommonDialog1.Filename
Dim Caracteres As Integer
Dim GCTFooter As DATAQUERY
Dim GCTHeader As DATAQUERY
Dim prueba As String
Dim datar As DATAQUERY
Dim canalLibre As Integer
canalLibre = FreeFile
prueba = TestRegExp("([A-F]|[0-9]){8}(([A-F]|[0-9]){1,255})?", Text2.Text)
GCTHeader = StringToDataQuery("00D0C0DE00D0C0DE", 16)
GCTFooter = StringToDataQuery("FF00000000000000", 16)
Caracteres = Len(prueba) / 2
MsgBox (Caracteres)
datar = StringToDataQuery(prueba, Caracteres)
Open sFile For Binary As #canalLibre
Put #canalLibre, , GCTHeader
Put #canalLibre, 8 + 1, datar
Put #canalLibre, Hex(Len(GCTHeader) / 2 + Len(datar) / 2), GCTFooter
Close #canalLibre
End Sub
Y aqui dejo el módulo con las funciones:
Código:
Public Type DATAQUERY
Data(64) As Byte
End Type
Public Function StringToDataQuery(QueryStr As String, QueryLength As Integer) As DATAQUERY

'This converts the query string to a query byte array
Dim ByteIndex As Integer
ByteIndex = 0
For ByteIndex = 0 To QueryLength - 1
StringToDataQuery.Data(ByteIndex) = Val("&H" + Mid$(QueryStr, ((ByteIndex * 2) + 1), 2))
Next ByteIndex

End Function
Public Function TestRegExp(myPattern As String, myString As String)
   'Create objects.
   Dim objRegExp As RegExp
   Dim objMatch As Match
   Dim colMatches   As MatchCollection
   Dim RetStr As String
   
   ' Create a regular expression object.
   Set objRegExp = New RegExp

   'Set the pattern by using the Pattern property.
   objRegExp.Pattern = myPattern

   ' Set Case Insensitivity.
   objRegExp.IgnoreCase = True

   'Set global applicability.
   objRegExp.Global = True

   'Test whether the String can be compared.
   If (objRegExp.Test(myString) = True) Then

   'Get the matches.
    Set colMatches = objRegExp.Execute(myString)   ' Execute search.

    For Each objMatch In colMatches   ' Iterate Matches collection.
      'RetStr = RetStr & "Match found at position "
      'RetStr = RetStr & objMatch.FirstIndex & ". Match Value is '"
      'RetStr = RetStr & objMatch.Value & "'." & vbCrLf
      RetStr = RetStr & objMatch.Value
    Next
   Else
    RetStr = "String Matching Failed"
   End If
   TestRegExp = RetStr
End Function
Espero puedan ayudarme, muchas gracias

Última edición por didix16; 19/09/2010 a las 22:21