Mostrar mensajes previos
Ordenar por
por Naker90 VIP
Bueno esta función comprime un numero de caracteres que estén seguidos en una cadena. La cadena reemplaza por ejemplo ("AAAA" por "A") el numero de caracteres seguidos a comprimir se especifica en el segundo parámetro.
#cs ----------------------------------------------------------------------------

 AutoIt Version: 3.3.8.1
 Author: Naker90
 Requiere String.au3

 Script Function:
	Comprime caracteres seguidos en una cadena

 Parametros:
		  $sString  =>  Cadena a comprimir
	$sLetterRepeat  =>  si elegimos 3 se comprimiran las letras que se repitan 3 veces

#ce ----------------------------------------------------------------------------

#include <String.au3>

Func String_Compressed($sString, $sLetterRepeat)

	If $sLetterRepeat = 0 Then
		MsgBox(16, 'ERROR', 'El minimo requerido en $sLetterRepeat es 1')
		Exit
	EndIf

	Local Const $sLetters[66] = ['A', 'a', 'B', 'b', 'C', 'c', 'D', 'd', 'E', 'e', 'F', 'f', 'G', 'g', 'H', 'h', 'I', 'i', 'J', 'j', 'K', 'k', 'L', 'l', 'M', 'm', 'N', 'n', 'Ñ', 'ñ', 'O', 'o', 'P', 'p', 'Q', 'q', 'R', 'r', 'S', 's', 'T', 't', 'U', 'u', 'V', 'v', 'W', 'w', 'X', 'x', 'Y', 'y', 'Z', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
	Local Const $sRemplaced[66] = ['A', 'a', 'B', 'b', 'C', 'c', 'D', 'd', 'E', 'e', 'F', 'f', 'G', 'g', 'H', 'h', 'I', 'i', 'J', 'j', 'K', 'k', 'L', 'l', 'M', 'm', 'N', 'n', 'Ñ', 'ñ', 'O', 'o', 'P', 'p', 'Q', 'q', 'R', 'r', 'S', 's', 'T', 't', 'U', 'u', 'V', 'v', 'W', 'w', 'X', 'x', 'Y', 'y', 'Z', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9']

	If StringInStr($sString, ' ') <> 0 Then
		Do
			Local $sSpaces = StringInStr($sString, ' ')
			Local $sRemplace = StringReplace($sString, $sSpaces, '|')
			$sString = $sRemplace
		Until Not StringInStr($sString, ' ')
	EndIf

	For $si = 0 To 65
		Local $sStringRepeat = _StringRepeat($sLetters[$si], $sLetterRepeat)
		Local $sRemplace = StringRegExpReplace($sString, $sStringRepeat, $sRemplaced[$si])
		$sString = $sRemplace
	Next

	Return $sString

EndFunc

Func String_Decompressed($sString2, $sLetterRepeat2)

	If $sLetterRepeat2 = 0 Then
		MsgBox(16, 'ERROR', 'El minimo requerido en $sLetterRepeat es 1')
		Exit
	EndIf

	Local Const $sLetters2[66] = ['A', 'a', 'B', 'b', 'C', 'c', 'D', 'd', 'E', 'e', 'F', 'f', 'G', 'g', 'H', 'h', 'I', 'i', 'J', 'j', 'K', 'k', 'L', 'l', 'M', 'm', 'N', 'n', 'Ñ', 'ñ', 'O', 'o', 'P', 'p', 'Q', 'q', 'R', 'r', 'S', 's', 'T', 't', 'U', 'u', 'V', 'v', 'W', 'w', 'X', 'x', 'Y', 'y', 'Z', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
	Local Const $sRemplaced2[66] = ['A', 'a', 'B', 'b', 'C', 'c', 'D', 'd', 'E', 'e', 'F', 'f', 'G', 'g', 'H', 'h', 'I', 'i', 'J', 'j', 'K', 'k', 'L', 'l', 'M', 'm', 'N', 'n', 'Ñ', 'ñ', 'O', 'o', 'P', 'p', 'Q', 'q', 'R', 'r', 'S', 's', 'T', 't', 'U', 'u', 'V', 'v', 'W', 'w', 'X', 'x', 'Y', 'y', 'Z', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9']

	For $si = 0 To 65
		Local $sStringRepeat = _StringRepeat($sLetters2[$si], $sLetterRepeat2)
		Local $sCaracter = StringInStr($sString2, $sRemplaced2[$si])
		If Not $sCaracter = 0 Then
			Local $sRemplace2 = StringRegExpReplace($sString2, $sRemplaced2[$si], $sStringRepeat)
			$sString2 = $sRemplace2
		EndIf
	Next

	If StringInStr($sString2, '|') <> 0 Then
		Do
			Local $sSpaces2 = StringInStr($sString2, '|')
			Local $sRemplace2 = StringReplace($sString2, $sSpaces2, ' ')
			$sString2 = $sRemplace2
		Until Not StringInStr($sString2, '|')
	EndIf

	Return $sString2

EndFunc
Ejemplo de uso: 
#cs-----------------------------------------------------------

   Longuitud de la cadena inicial = 53
Longuitud de la cadena comprimida = 14

$Compressed retorna = AAaaBBCC|ZzddD

#ce----------------------------------------------------------

Local $Cadena = 'AAAAAaaaaaBBBBBCCCCC ZZZZzzzzddDDDD'

Local $Compressed = String_Compressed($Cadena, 4)
Local $Decomprssed = String_Decompressed($Compressed, 4)
Saludos
Skype: naker.noventa
por Pink Usa camisa de fuerza
Me gusta la función (se podría hacer mas fácil/cortita)

tiene algunos errores al descomprimir. mira las salida que obtengo.



Código: Seleccionar todo

Cadena normal:           AAAAAaaaaaBBBBBCCCCC ZZZZzzzzddDDDD
Cadena Comprimida:     AAaaBBCC|ZzddD
Cadena Desconprimida: AAAAAAAAaaaaaaaaBBBBBBBBCCCCCCCC ZZZZzzzzddddddddDDDD

saludos
Imagen
por Naker90 VIP
Gracias por el reporte Pink, el problema es que también dobla las letras que no se comprimieron, reemplazando los caracteres por símbolos se arregla la cosa.
Que algún moderador edite el post principal con la corrección por favor.
#cs ----------------------------------------------------------------------------

 AutoIt Version: 3.3.8.1
 Author: Naker90
 Requiere String.au3

 Script Function:
	Comprime caracteres seguidos en una cadena

 Parametros:
		  $sString  =>  Cadena a comprimir
	$sLetterRepeat  =>  si elegimos 3 se comprimiran las letras que se repitan 3 veces

#ce ----------------------------------------------------------------------------

#include <String.au3>

Func String_Compressed($sString, $sLetterRepeat)

	If $sLetterRepeat = 0 Then
		MsgBox(16, 'ERROR', 'El minimo requerido en $sLetterRepeat es 1')
		Exit
	EndIf

	Local Const $sLetters[66] = ['A', 'a', 'B', 'b', 'C', 'c', 'D', 'd', 'E', 'e', 'F', 'f', 'G', 'g', 'H', 'h', 'I', 'i', 'J', 'j', 'K', 'k', 'L', 'l', 'M', 'm', 'N', 'n', 'Ñ', 'ñ', 'O', 'o', 'P', 'p', 'Q', 'q', 'R', 'r', 'S', 's', 'T', 't', 'U', 'u', 'V', 'v', 'W', 'w', 'X', 'x', 'Y', 'y', 'Z', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
	Local Const $sRemplaced[66] = ['!', '@', '·', '#', '%', '¬', '=', 'º', '¿', '¡', 'ª', '¨', 'Ç', 'ç', ':', '-', '_', ';', ',', '€', 'À', 'à', 'È', 'è', 'Ì', 'ì', 'Ò', 'ò', 'Ù', 'ù', 'Ä', 'ä', 'Ë', 'ë', 'Ï', 'ï', 'Ö', 'ö', 'Ü', 'ü', 'Â', 'â', 'Ê', 'ê', 'î', 'Î', 'Ô', 'ô', 'Û', 'û', 'Á', 'á', 'É', 'é', 'Í', 'í', 'ó', 'Ó', 'Ú', 'ú', '&', '`', '´', '<']

	If StringInStr($sString, ' ') <> 0 Then
		Do
			Local $sSpaces = StringInStr($sString, ' ')
			Local $sRemplace = StringReplace($sString, $sSpaces, '|')
			$sString = $sRemplace
		Until Not StringInStr($sString, ' ')
	EndIf

	For $si = 0 To 65
		Local $sStringRepeat = _StringRepeat($sLetters[$si], $sLetterRepeat)
		Local $sRemplace = StringRegExpReplace($sString, $sStringRepeat, $sRemplaced[$si])
		$sString = $sRemplace
	Next

	Return $sString

EndFunc

Func String_Decompressed($sString2, $sLetterRepeat2)

	If $sLetterRepeat2 = 0 Then
		MsgBox(16, 'ERROR', 'El minimo requerido en $sLetterRepeat es 1')
		Exit
	EndIf

	Local Const $sLetters2[66] = ['A', 'a', 'B', 'b', 'C', 'c', 'D', 'd', 'E', 'e', 'F', 'f', 'G', 'g', 'H', 'h', 'I', 'i', 'J', 'j', 'K', 'k', 'L', 'l', 'M', 'm', 'N', 'n', 'Ñ', 'ñ', 'O', 'o', 'P', 'p', 'Q', 'q', 'R', 'r', 'S', 's', 'T', 't', 'U', 'u', 'V', 'v', 'W', 'w', 'X', 'x', 'Y', 'y', 'Z', 'z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
	Local Const $sRemplaced2[66] = ['!', '@', '·', '#', '%', '¬', '=', 'º', '¿', '¡', 'ª', '¨', 'Ç', 'ç', ':', '-', '_', ';', ',', '€', 'À', 'à', 'È', 'è', 'Ì', 'ì', 'Ò', 'ò', 'Ù', 'ù', 'Ä', 'ä', 'Ë', 'ë', 'Ï', 'ï', 'Ö', 'ö', 'Ü', 'ü', 'Â', 'â', 'Ê', 'ê', 'î', 'Î', 'Ô', 'ô', 'Û', 'û', 'Á', 'á', 'É', 'é', 'Í', 'í', 'ó', 'Ó', 'Ú', 'ú', '&', '`', '´', '<']

	For $si = 0 To 65
		Local $sStringRepeat = _StringRepeat($sLetters2[$si], $sLetterRepeat2)
		Local $sCaracter = StringInStr($sString2, $sRemplaced2[$si])
		If Not $sCaracter = 0 Then
			Local $sRemplace2 = StringRegExpReplace($sString2, $sRemplaced2[$si], $sStringRepeat)
			$sString2 = $sRemplace2
		EndIf
	Next

	If StringInStr($sString2, '|') <> 0 Then
		Do
			Local $sSpaces2 = StringInStr($sString2, '|')
			Local $sRemplace2 = StringReplace($sString2, $sSpaces2, ' ')
			$sString2 = $sRemplace2
		Until Not StringInStr($sString2, '|')
	EndIf

	Return $sString2

EndFunc
Saludos
Skype: naker.noventa
por Scorpio Moderador
Sin duda todo un monstruo, no paras bro, sigue así, esta de lujo.

PD: Hace mucho tuve la idea de hacer esto al ver una funcion de Slek en VB6, te me adelanteste.

//Regards.
Ikarus: Backdoor.VBS.SafeLoader
Agnitum: Trojan.VBS.Safebot.A
http://indeseables.github.io/
Temas similares
Variantes de tema
Responder

Volver a “Fuentes”