Hace tiempo surgió en la lista una pregunta sobre cómo distribuir ficheros de imágenes con nuestra aplicación (jpg, bmp, etc) pero que no pudieran ser usados por otros programas. Como este tipo de archivos tiene una cabecera con información del formato envié una función (puedes verla en la seccion Resumen bajo el título "Distribucion de imagenes") que se limitaba a cambiar los 32 primeros bytes con los 32 últimos. De esta manera los otros programas "no los entienden". Para poder utilizarlos nosotros debíamos hacer una copia temporal del fichero y volver a llamar a la rutina que dejaría el fichero correctamente. Después de usarlo debíamos borrar este fichero temporal (o volver a ejecutar la rutina).
Este tratamiento no sólo es válido para ficheros de imágenes sino para cualquier otro que tenga una "cabecera" (documentos de word, de excel, bases de datos, etc).
El problema surge con los ficheros mp3, que no parecen tener cabecera. De echo si coges un trozo cualquiera de un fichero mp3 suena correctamente.
Para remediar este problema he modificado la función de manera que pueda intercambiar un número variable de bloques de un tamaño también variable. Hay que tener en cuenta que dado el tamaño de los ficheros mp3 (unas 15 Kb cada segundo a 128 bits y 44 KHz) no tiene mucho sentido intercambiar bloques de 32 bytes.
Podeis hacer pruebas cambiando el tamaño de los bloques y el número de ellos a intercambiar viendo la relación entre "distorsión" y tiempo empleado.

Function CambiaBloques(Fichero As String, Optional NumMaxCambios As Long = 1, Optional BytesBloque As Long = 32) As Boolean
'Esta rutina intercambia bloques entre el principio y el fin de un fichero
'Está pensada para evitar que se pueda acceder externamente a ficheros de nuestra aplicación, por
'ejemplo imágenes. Los entregaríamos con los bloques cambiados y antes de usarlos haremos una copia
'y volvemos a cambiar los bloques. Con esto modificamos la cabecera del fichero lo que lo hará
'irreconocible. Lógicamente debemos borrar el fichero temporal tras su uso.
'En algunos casos (por ejemplo ficheros mp3) no es suficiente con cambiar la cabecera, para ellos
'podemos indicar el número de bloques a intercambiar y el tamaño de los mismos. En estos casos
'vamos a intercambiar sólo uno de cada dos bloques para conseguir mejor el efecto deseado.
'Nota : 15 Kb es aproximadamente un segundo en un mp3 a 128 bits 44.000 Hz

Dim i As Integer, Cabecera() As Byte, Fin() As Byte, Longitud As Long
Dim PosInicio As Long, PosFin As Long, MaxBloques As Long, TamañoFichero As Long
Dim NumBloque As Long

On Error GoTo CambiaBloques_Err

'Compruebo que se pueda hacer con los parámetros solicitados
TamañoFichero = FileLen(Fichero)
MaxBloques = (TamañoFichero / BytesBloque) / 2
If MaxBloques > NumMaxCambios Then MaxBloques = NumMaxCambios
If MaxBloques = 0 Then Err.Raise 32000

'Ajusto el tamaño de las matrices
ReDim Cabecera(BytesBloque - 1): ReDim Fin(BytesBloque - 1)

'abro el fichero
i = FreeFile()
Open Fichero For Binary Access Read Write Lock Read Write As i
NumBloque = 1
While NumBloque <= MaxBloques
    'leo un bloque del principio
    PosInicio = ((NumBloque - 1) * BytesBloque) + 1
    Get #i, PosInicio, Cabecera()
    'leo uno del final del fichero
    PosFin = TamañoFichero - (NumBloque * BytesBloque) + 1
    Get #i, PosFin, Fin()
    'grabo el final del fichero sobre la cabecera
    Put #i, PosInicio, Fin()
    'grabo el principio sobre el final del fichero
    Put #i, PosFin, Cabecera()
    'me salto un bloque sin hacer nada
    NumBloque = NumBloque + 2
Wend
'cerramos el fichero
Close #i
CambiaBloques = True
CambiaBloques_End:
     Exit Function
CambiaBloques_Err:
     On Error Resume Next
     Close #i
     CambiaBloques = False
     Resume CambiaBloques_End
End Function