Foro de elhacker.net

Bueno, estaba trabajando con archivos en memoria, y no quería guardarlos en directorios temporales o cosas así, así que hice una función que simula a GetPrivateProfileString.

PD: solamente hice en modo lectura, ya que des-en-crip-to un archivo y ni me interesa modifcarlo desde ahí.

Public Function MiseryReadKey(Cadena As String, Section As String, Key As String) As String
'BreakLine = Enter o ;
 
Dim FirstPos As Long, LastPos As Long, FitPos As Long
Dim FinalStr As String
 
Section = UCase(Section)
Key = UCase(Key)
 
'[Section]
FirstPos = InStr(1, UCase(Cadena), "[" & Section & "]")
 
If FirstPos < 1 Then
    MiseryReadKey = ""
    Exit Function
End If
 
FirstPos = FirstPos + Len("[" & Section & "]")
 
LastPos = InStr(FirstPos, UCase(Cadena), "[") - 1
 
'Patch, si está al final no ván a haber más "["
If LastPos < 1 Then
    LastPos = Len(Cadena) + 1
End If
 
FinalStr = Mid(Cadena, FirstPos, LastPos - FirstPos)
 
'Key
FirstPos = InStr(1, UCase(FinalStr), Key)
 
If FirstPos < 1 Then
    MiseryReadKey = ""
    Exit Function
End If
 
LastPos = InStr(FirstPos, FinalStr, Chr(13)) - 1 'Patch 07/07/2014
 
'Patch, lo mismo acá, no ván a haber más enters si lée el último
If LastPos < 1 Then
    LastPos = Len(FinalStr) + 1
End If
 
'Hay un comentario
FitPos = InStr(FirstPos, FinalStr, ";")
If FitPos > 0 Then
    If FitPos < LastPos Then
        LastPos = FitPos - 1
    End If
End If
 
'=
FirstPos = InStr(FirstPos, FinalStr, "=")
 
If FirstPos < 1 Then
    MiseryReadKey = ""
    Exit Function
End If
 
MiseryReadKey = Trim(Mid(FinalStr, FirstPos + 1, LastPos - FirstPos))
End Function
 

MsgBox MiseryReadKey(txtFile.Text, "NUMERO1", "Val1")
 

El FitPos es para el enter o ;

Archivo:

[NUMERO1]
Val1=333 ;asd
Val2=666;asd
 

Saludos!

HOLA!!!

Soporta Unicode?

P.D: muy buen aporte!

GRACIAS POR LEER!!!

descifro*

:P el foro está forzado para que la gente use la palabra correcta XD

Gracias (Y)

No, solamente soporta texto en string, textbox y cosas así, los cuales usan ANSI, estoy en lo correcto o estoy hablando boludeces?


Ah, no sabía, pensé que era para que google u otras páginas no tomen a foro.elhacker como spam o con virus.

Edit:
Aunque busca hasta enters o ; y lo guarda a string, desconozco si realmente guarda bien los bytes ahí, pero debería probarlo.

HOLA!!!

Me imagino, supongo que no debe soportar, intenta meter un archivo binario en memoria y volver a volcarlo, si funciona soporta unicode sino no.

GRACIAS POR LEER!!!

Patch:

Public Function MiseryReadKey(Cadena As String, Section As String, key As String) As String
'BreakLine = Enter o ;
 
Dim FirstPos As Long, LastPos As Long, FitPos As Long
Dim FinalStr As String
 
Section = UCase(Section)
key = UCase(key & "=") 'Patch 08/07/2014
 
'[Section]
FirstPos = InStr(1, UCase(Cadena), "[" & Section & "]")
 
If FirstPos < 1 Then
    MiseryReadKey = ""
    Exit Function
End If
 
FirstPos = FirstPos + Len("[" & Section & "]")
 
LastPos = InStr(FirstPos, UCase(Cadena), "[") - 1
 
'Patch, si está al final no ván a haber más "["
If LastPos < 1 Then
    LastPos = Len(Cadena) + 1
End If
 
FinalStr = mid(Cadena, FirstPos, LastPos - FirstPos)
 
'Key
FirstPos = InStr(1, UCase(FinalStr), key)
 
If FirstPos < 1 Then
    MiseryReadKey = ""
    Exit Function
End If
 
LastPos = InStr(FirstPos, FinalStr, Chr(13)) - 1 'Patch 07/07/2014
 
'Patch, lo mismo acá, no ván a haber más enters si lée el último
If LastPos < 1 Then
    LastPos = Len(FinalStr) + 1
End If
 
'Hay un comentario
FitPos = InStr(FirstPos, FinalStr, ";")
If FitPos > 0 Then
    If FitPos < LastPos Then
        LastPos = FitPos - 1
    End If
End If
 
'=
FirstPos = InStr(FirstPos, FinalStr, "=")
 
If FirstPos < 1 Then
    MiseryReadKey = ""
    Exit Function
End If
 
MiseryReadKey = Trim(mid(FinalStr, FirstPos + 1, LastPos - FirstPos))
End Function