VB Cómo crear una carpeta (la ruta contiene variables); lee el contenido de la carpeta (la ruta contiene variables leídas);

Declaración privada Sub CopyMemory Lib "kernel32" Alias ​​​​"RtlMoveMemory" (destino como cualquiera, _

origen como cualquiera, longitud ByVal tan larga)

Tipo privado Int64

Bajo mientras sea largo

Hola mientras sea largo

Tipo final

Sub privado cmdSave_Click()

Dim strHex como cadena, strHex1 como cadena, userLen como largo, PassLen como cadena

userLen = Len(Trim(txtUserName.text))

PassLen = Len(Trim( txtPass. text))

strHex = NumToHexStr(userLen + PassLen, 2)

strHex = strHex & NumToHexStr(userLen, 2)

strHex = strHex & NumToHexStr( PassLen, 2)

strHex = strHex & Encode(Trim(txtUserName.text))

strHex = strHex & Encode(Trim(txtPass.

WriteSFText strHex

End Sub

Sub público WriteSFText(ByVal strHex como cadena)

Dim FileName como cadena, texto como cadena, ProductInfo como cadena, i como entero , Sep como cadena

Dim fso como nuevo FileSystemObject, txt

FileName = App.Path + "\User\UserInfo.dat"

Si fso.FileExists (Nombre de archivo) Luego

Establezca txt = fso.OpenTextFile(Nombre de archivo, 8, False)

De lo contrario

Establezca txt = fso.CreateTextFile(Nombre de archivo, Verdadero)

Finalizar si

txt.WriteLine strHex

txt.

Cerrar

Establecer txt = Nada

Establecer fso = Nada

End Sub

Codificación de función pública (strEncode como cadena) como cadena

Dim i As Long

Dim chrTmp$

Dim ByteLower$, ByteUpper$

Dim strReturn$ 'Codificación convertida de almacenamiento

Para i = 1 a Len(strEncode)

chrTmp$ = Mid(strEncode, i, 1)

ByteLower$ = Hex$(AscB(MidB$ (chrTmp $, 1, 1)))

Si Len(ByteLower$ ) = 1 Entonces ByteLower$ = "0" & ByteLower$

ByteUpper$ = Hex$(AscB (MidB) $(chrTmp$, 2, 1)))

Si Len(ByteUpper$) = 1 Entonces ByteUpper$ = "0" & ByteUpper$

Si Len(ByteUpper $) = 1 Entonces ByteUpper$ = "0" & ​​​​ByteUpper$

strReturn$ = strReturn$ & ByteUpper$ &ByteLower$

Siguiente

Codificar = strReturn$

Función final

Decodificación de función pública (strDecode como cadena) Como cadena

Dim i As Long

Dim strCode$ 'Conversión de almacenamiento El código después de

Dim chrTmp$

En caso de error, vaya a ErrProc

Si Len(strDecode) Mod 4 <> 0, entonces vaya a ErrProc

para i = 1 A Len(strDecode) Paso 4

strCode = Mid$(strDecode, i, 4)

chrTmp$ = ChrW("&H" & strCode)

Si chrTmp$ = "?" Entonces si strCode <> "003F" Entonces GoTo ErrProc

Decode = Decode & chrTmp$

Siguiente

Salir de la función

ErrProc:

Decode = strDecode

Función final

'*********** **** ***************************

'Convertir decimal a hexadecimal bytLen bytes Los bits altos y bajos no se convierten

'******

Función pública NumToHexStr(ByVal num como variante, ByVa

l bytLen como entero) como cadena

Dim str como cadena

Dim strReturn como cadena

Dim iLen como entero

Dim i como Entero

str = BigNumToHexStr(num)

iLen = bytLen * 2

strReturn = ""

Si Len(str) > ; = iLen Entonces

strReturn = Right(str, iLen)

Else

For i = Len(str) To iLen - 1

strReturn = strReturn & "0"

Siguiente

strReturn = strReturn & Str

Fin

NumToHexStr = strReturn

Función final

Función pública BigNumToHexStr(Valor ByVal como doble) como cadena

Dim c como moneda

Dim i64 como Int64

c = Valor / 10000

CopyMemory i64, c, 8

Si i64 Entonces

BigNumToHexStr = Hex(i64.Hi) & Derecha("0000000" & Hex(i64.Lo), 8)

De lo contrario

BigNumToHexStr = Hex(i64.Lo)

Si i64. p>

Finalizar si

Finalizar función

Función pública HexToDec(ByVal Hex As String) como doble

Dim i como doble

Dim b As Double

Hex = UCase(Hex)

Para i = 1 To Len(Hex)

Seleccione Case Mid(Hex, Len( Hexadecimal) - i + 1, 1)

Caso "0": b = b + 16 ^ (i - 1) * 0

Caso "1": b = b + 16 ^ (i - 1) * 1

Caso "2": b = b + 16 ^ (i - 1) * 2

Caso "3": b = b + 16 ^ (i - 1) * 3

Caso "4": b = b + 16 ^ (i - 1) * 4

Caso "5": b = b + 16 ^ (i - 1) * 5

Ejemplo "6": b = b + 16 ^ (i - 1) * 6

Ejemplo "7": b = b + 16 ^ (i - 1) * 7

Ejemplo "8": b = b + 16 ^ (i - 1) * 8

Ejemplo "9": b = b + 16 ^ (i - 1 ) * 9

Caso "A": b = b + 16 ^ (i - 1) * 10<

/p>

Caso "B": b = b + 16 ^ (i - 1) * 11

Caso "C": b = b + 16 ^ (i - 1) * 12

Caso "D": b = b + 16 ^ (i - 1) * 13

Caso "E": b = b + 16 ^ (i - 1) * 14

Caso "F": b = b + 16 ^ (i - 1) * 15

Selección final

Siguiente i

HexToDec = b

Función final

Sub privado Form_Load()

'Leer nombre de usuario contraseña'

Cargar nombre de usuario

End Sub

Función pública LoadUserName()

Dim strFileName como cadena, ruta + "\User\UserInfo.dat"

Abrir strFileName para entrada como #1

i = 1

Hacer mientras no sea EOF(1)

Entrada de línea #1, LineStr

userNameLen = HexToDec(Mid( LineStr, 5, 4))

PassLen = HexToDec(Mid(LineStr, 9, 4))

nombre de usuario = Decode(Mid(LineStr, 13, nombre de usuarioLen * 4))

Pass = Decode(Mid( LineStr, 13 + userNameLen * 4, PassLen * 4))

i = i + 1

DoEvents

Bucle

SubSalida:

Cerrar #1

Función final