Hola gente, disculpen que estuve desaparecido, el trabajo me tiene mal, jeje.. Hace unos dias me surgio un problema, tuve que enviar un archivo de mas de 1 Gb por la Red, lo cual en la zona que estoy se me hace muy dificil, apezar de tener banda ancha. La cuestion es que al final de todo no pude, desarmando el archivo en partes mas pequeñas!!!
Aunque parezca mentira, me puse a pensar, y claro, probe con archivos 20 Kb, ya mas grandes seria casi imposible..
les cuento lo que hice, tome el vb6, con la sentencia Open abri un archivo pequeño, lo cargue en un array, o en un cuadro de texto. Una vez cargado, hice que "Mapee" o busque todos los caracteres que este contine, y me de sus posiciones,
Por ejemplo, tengo un archivo con esto:
-------------------------------------------------------------------
Este foro esta de lujo!!!, su gente es genial, amable y amistoza.
--------------------------------------------------------------------
Lo que hace el programita, es buscar por todo el archivo cuantas letras 'a' hay, y me da sus posiciones, cuantes 'e' hay y asi..
Se genera un archivo pequeñito, intermedio, como resultado final (que seria una especie de archivo .zip)
Teniendo esto, y haciendo la inversa, es posible reconstruir el archivo original, en segundos, sin que nada se pierda.
Tengo varios problemas que me estan dejando mi cerebro com un huevo frito!!! jeje.
1°- Si trato de 'Mapear un archivo de 10 Mb o mas, al archivo lo pueden llegar a reconstruir mis tataranietos, en el siglo 25, con mucha suerte, ya que es tremendamente lento en archivos grandes.
2°- No siempre me lee el primer caracter, del archivo, no se por que razon..
3°- A veces me da la posicion de los espacios vacios, lo cual creo que es importante saber para la reconstruccion.
Lo que veo de bueno, no se ustedes, es que por ejemplo logre que un archivo por ejemplo de 400 Kb o mas Sin llegar al Mb, en el archivo intermedio ocupe tan solo Bytes o menos de 1 Kb.
Dejo el codigo y algun .zip en algun servidor por si alguien le sirve, o interesa, no se si ya existe algo asi, se que se puede mejorar, por eso acudo a ustedes e invoco a su sabiduria, jeje..el codigo es algo primitivo, con cariño, amor y pasiencia puede mejorar, jeje
Si alguien lo modifica le pido, de forma gentil, que lo informe o lo comparta..
--------------------------------------------------------------------------------------------------------
en un formulario, agregar:
13 labels
5 CommandButtons
2 Progressbar
1 Timer
1 TextBox
1 RichTextBox
'---------------------------------------------------------------------------------------------------------
'-- Codigo de Mapeador /Escaneador de archivos.
'-- Fecha: 25/Mar/2011 Hora:17:00 hs
'-- Autor: Sandoval, Fernando Alejandro.
'-- Direccion de contacto: fernandos85al@hotmail.com
'-- Cel: +5492974742683
'-- Cargado y cedido a: Foro de www.leandroascierto.com.ar, en forma de contribucion y agradecimiento por
'-- Ayuda brindada de forma desinteresada de la gente / Integrantes del Foro.
'--- Fin.
'-----------------------------------------------------------------------------------------------------------
Dim i As Integer
Dim Caracter() As String ' Array que contendra el caracter, y su posicion para luego ser divididos, mediante Split
'Funcion para extraer la extension de un archivo.
Private Function Extraer(Path As String, Caracter As String) As String
Dim ret As String
If Caracter = "." And InStr(Path, Caracter) = 0 Then Exit Function
ret = Right(Path, Len(Path) - InStrRev(Path, Caracter))
' -- Retorna el valor
Extraer = ret
End Function
Private Sub Command1_Click() ' Boton cargar
'Carga el archivo en el RichTextBox
rtf.LoadFile Text1.Text
End Sub
Private Sub Command2_Click() ' Boton Iniciar
Timer1.Enabled = True ' Habilita al timer1
Timer1.Interval = 1 ' Pone en 1 el intervalo del timer1
a1.Min = 0 'Inicia en cero(0), el valor de la barra de lectura
a1.Max = carac% 'Lee hasta el maximo (el tamaño del archivo cargado en el RichTextBox)
a2.Min = 30 'Comineza a buscar y comparar los caracteres del Archivo cargado en el richTextBox, con los caracteres Asc.
a2.Max = 255 'Termina en el caracter 255 del codigo Asdc.
rtf.SetFocus 'Le pasa el foco al RichTextBox, para comenzar a recorrer el texto, en busc de caracteres que coincidan con el criterio (asc)
End Sub
Private Sub Command3_Click() ' Boon que reconstruye el archivo.
On Error Resume Next
Open "c:\Intermedio.txt" For Input As #1 'Este es el archivo que contendra los caracteres con sus respectivas posiciones
Do While Not EOF(1)
Line Input #1, cadena$ 'Se carga caracter a caracter, junto con su posicion
Caracter = Split(cadena$, " ") ' Se separa el caracter, de su posicion.
Open "c:\reconstruido.txt" For Binary As #2 'Se genera el archivo, con los datos del archivo intermedio.txt
Put #2, Caracter(1), Caracter(0) ' Caracter(1): Indica la posicion del caracter; Caracter(0): Indica de que caracter se trata
Close #2
If EOF(1) Then ' Si se llega al fin del archivo
MsgBox "Se ha reconstruido el archivo con exito.", vbInformation + vbOKOnly
End If
Loop
Close #1
End Sub
Private Sub Command4_Click() ' Boton que obtiene el tamaño del archivo
carac% = Len(rtf.Text) 'Muestra el tamaño del archivo a 'Mapear'
Label5.Caption = carac% 'Muestra el tamaño del archivo a 'Mapear'
End Sub
Private Sub Command5_Click()
MsgBox "Para Comenzar indique la ruta del archivo a procesar, en el cuadro de texto." & vbCrLf & _
"Luego 'hacer click en el boton 'Cargar |load'" & vbCrLf & _
"Seguidamente, 'hacer 'click' en El boton tamanio'" & vbCrLf & _
"Despues 'haga 'click' en iniciar'" & vbCrLf & _
"" & vbCrLf & _
"Depende del tamaño del archivo seleccionado, sera el tiempo del proceso, entre algunos factores" & vbCrLf & _
"Para su reconstruccion, hacer click en el boton 'Reconstruir.'"
End Sub
Private Sub Form_Load()
MsgBox "Este codigo es totamente libre, integramente hecho en el Sur de la Patagonia Argentina." & vbCrLf & _
"Es libre, con la sola condicion de que se le de un uso, Responsable, y no lucrativo" & vbCrLf & _
"que se respeten los Creditos y los derechos del Autor." & vbCrLf & _
"En el caso de que alguna persona lo modifique, que por favor me lo informe a:" & vbCrLf & _
"fernandos85al@hotmail.com, con el asunto: Modificacion- MapeAr" & vbCrLf & _
"Desde ya gracias a todos, y espero que sirva de algo este codigo." & vbCrLf & _
vbCrLf & _
"Cargado y cedido a: Foro de www.leandroascierto.com.ar" & vbCrLf & _
" en forma de contribucion y agradecimiento por ayuda" & vbCrLf & _
"brindada de forma desinteresada de la gente / Integrantes" & vbCrLf & _
"del Foro. en proyectos anteriores.", vbInformation + vbOKOnly
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
a1.Value = a1.Value + 1 'Aumenta en uno(1)
rtf.SelStart = a1.Value ' Recorre el archivo seleccionando caracter por caracter
rtf.SelLength = 1 'Lee de a un caracter por vez, si se cambia a 2 o 10 , o tres el archivo intermedio, posiblemente informara erroneamente
If a1.Value = a1.Max Then ' Si se recorre todo el texto del richtextbox, y se llega al final,
a1.Value = 0 'Comienza nuevamente desde cero
a2.Value = a2.Value + 1 ' Incrementa en uno, para Buscar otro caracter Asc()
End If
If rtf.SelText = Label1.Caption Then ' Si el caracter Asc, coincide con la seleccion del RichTextBox
Label3.Caption = "No Encontrado" ' Informa si no ha encontrado el caracter
Label4.Caption = rtf.SelStart ' Da la posicion del caracter
Open "c:\Intermedio.txt" For Append As #1
'Print #1, Extraer("", ".") 'Funcion que extrae la extension del archivo original, y la guarda en el intermedio.txt, para facilitar su reconstruccion.
Print #1, Label1.Caption & " " & Label4.Caption ' Guarda en el archivo Intermedio.txt, El caracter y su posicion
Close #1
Else
Label3.Caption = "Encontrado" 'Informa que se ha encontrado un caracter
End If
Label1.Caption = Chr(a2.Value) 'Muestra el caracter
Label2.Caption = a2.Value 'Muestra el valor de la barra de progreso
If a2.Value = a2.Max Then ' Si el valor de la barra de progreso, es igual al maximo declarado en form1_load()
MsgBox "Ha finalizado el proeceso con exito" 'Indica el fin
Timer1.Interval = 0 'Pone a Cero (0) el timer
Timer1.Enabled = False 'Pone en false el timer, finalizando el proceso.
End If
End Sub
y en un modulo .bas
'---------------------------------------------------------------------------------------------------------
'-- Codigo de Mapeador /Escaneador de archivos.
'-- Fecha: 25/Mar/2011 Hora:17:00 hs
'-- Autor: Sandoval, Fernando Alejandro.
'-- Direccion de contacto: fernandos85al@hotmail.com
'-- Cel: +5492974742683
'-- Cargado y cedido a: Foro de www.leandroascierto.com.ar, en forma de contribucion y agradecimiento por
'-- Ayuda brindada de forma desinteresada de la gente / Integrantes del Foro. en proyectos anteriores.
'--- Fin.
'-----------------------------------------------------------------------------------------------------------
Global carac% ' Tamanio del Archivo cargado en el RichTextBox
el archivo en formato zip lo deje aqui:
http://www.ziddu.com/download/14339461/MapeAr.rar.htmlsi alguien lo puede modificar, y le encuentra algun uso, por favor, le pido que lo publique y me informe a:
fernandos85al@hotmail.com. dentro del codigo encontraran mas datos.
Saludos a todos desde ya muchas gracias por su atencion.
saludos cordiales, y espero que sirva para algo el codigo.
