Function BlendStr(Text As String, Optional BlendPower As Integer, Optional DecodeBlendedStr As Boolean = False) As String
Const COLS = 4
Dim sText$, i&
Dim lLines&, lLin&
Dim iCol%, iCols%
Dim sChar$, lLen&
Dim hFile&, bLastCol As Boolean
If DecodeBlendedStr Then
'Vuelve la cadena encriptada a
'su forma original.
'
BlendStr = DecodeBlend(Text, BlendPower)
Exit Function
End If
If BlendPower > 0 Then iCols = BlendPower Else iCols = COLS
'Redondea la longitud del texto hasta el
'final de la última fila.
'
Do While (Len(Text) Mod iCols) <> 0
Text = Text & " "
Loop
lLen = Len(Text) 'Longitud del texto plano.
lLines = lLen \ COLS 'Filas totales en la tabla.
iCol = iCols \ 2 'Comienza con la columna del medio.
lLin = 0 'Fila 0.
'Crea un archivo temporal para escribir los
'datos codificados.
'
hFile = CreateTempFile
WrkTotalBytes = lLen * 2
For i = 1 To lLen * 2
'Obtiene el caracter de la fila y
'la columna actual.
'
sChar = Mid$(Text, iCol + (lLin * iCols), 1)
sText = sText & sChar 'Agrega el caracter al texto codificado.
lLin = lLin + 1 'Próxima fila.
If lLin = lLines Then
'Si se completaron las filas.
'
lLin = 0 'Fila 0.
If Not bLastCol Then
iCol = iCol + 1 'Próxima columna de la tabla.
Else
'Anterior columna de la tabla.
'
iCol = iCol - 1
If iCol = 0 Then Exit For
End If
If iCol > iCols Then
bLastCol = True 'Se llegó a la última columna.
iCol = (iCols / 2) - 1
End If
End If
If i Mod 20000 = 0 Then
'Escribe en el archivo temporal.
Call WriteFileStr(hFile, ByVal sText, Len(sText), 0&, ByVal 0)
sText = vbNullString
End If
If i Mod 75000 = 0 Then DoEvents
WrkCurBytes = i
WrkRemainingBytes = WrkTotalBytes - WrkCurBytes
Next
'Escribe los últimos datos en el archivo.
'
Call WriteFileStr(hFile, ByVal sText, Len(sText), 0&, ByVal 0)
BlendStr = ReadFileAllStr(hFile, True)
End Function
Private Function DecodeBlend(Text As String, Optional BlendPower As Integer) As String
On Error Resume Next
Const COLS = 4
Dim i&, sData$
Dim iRows&, iCols%
Dim lRow&, iCol%
Dim bLastCol As Boolean
Dim lLen&
If BlendPower > 0 Then iCols = BlendPower Else iCols = COLS
lLen = Len(Text) 'Longitud del texto.
sData = String$(lLen, 0) 'Llena el búfer de salida.
iRows = Len(sData) / iCols 'Total de filas en la tabla.
iCol = iCols \ 2 'Comienza con la columna del medio.
WrkTotalBytes = lLen
For i = 1 To lLen
Mid$(sData, (iCol + (lRow * iCols)), 1) = Mid$(Text, i, 1)
lRow = lRow + 1
If lRow = iRows Then
'Si se completaron las filas.
'
lRow = 0 'Fila 0.
If Not bLastCol Then
iCol = iCol + 1 'Próxima columna de la tabla.
Else
'Anterior columna de la tabla.
'
iCol = iCol - 1
End If
If iCol > iCols Then
bLastCol = True 'Se llegó a la última columna.
iCol = (iCols / 2) - 1
End If
End If
If i Mod 7000 = 0 Then
DoEvents
End If
WrkCurBytes = i
WrkRemainingBytes = WrkTotalBytes - WrkCurBytes
Next
DecodeBlend = sData
End Function