'/**
' * Servidor del gestor de conexiones
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: Servidor.cml
' * ---------------------------------------
'*/

Importar "Cramel.cml"
Importar "MSVBVM60\MSVBVM60.cml"
Importar "Propio\Cramel2\Sockets\Socket.cml"
Importar "Propio\Cramel2\Interfaz\Interfaz.cml"

Var Server:SocketServer

Var clientesSocket[]:Entero
Var clientesName[]:Cadena
ReDim clientesSocket, 1
ReDim clientesName, 1

Var ServerIniciado:Booleano
ServerIniciado = Falso

Var frame:CMLframe
Var listViewConectados:CMLListview
Var botonAbrirCD, botonCerrarCD:CMLBotón

Proc iniciarServer
    Repetir
        Var connections, newConnect:Entero
        Var infoThread:Cadena
        newConnect = Server.aceptar
        infoThread = EntCad(newConnect) + "|" + EntCad(connections)
        clientesSocket[connections] = newConnect
        CreateThread(Nulo, 0, ServerManager@, StrPtr(infoThread), 0, 0)
        connections = connections + 1
        ReDim Preservar clientesSocket, (connections+1)
    PorSiempre
FinProc

Proc frameEventoGanarFoco(hWnd:Entero)
    Si ( ServerIniciado = Falso ) Entonces
        ServerIniciado = Verdad
        CreateThread(Nulo, 0, iniciarServer@, Nulo, 0, 0)
    FinSi
FinProc

Proc frameEventoTerminar(hWnd:Entero, Referencia Cancelar:Booleano)
    Server.detener
FinProc

Crear Server
Crear frame
Crear listViewConectados
Crear botonAbrirCD
Crear botonCerrarCD

    Server.iniciar
    Si (Server.escuchar(666) = SOCKET_ERROR) Entonces
        Mensaje("Error al iniciar el socket")
        ExitProcess(0)
    SiNo
        frame.Texto = "Gestor de conexiones - En escucha"
        frame.Ancho = 700
        frame.Alto = 400
        frame.Padre = 0
        frame.Centrar = 1
        frame.eventos.GanarFoco@ = frameEventoGanarFoco@
        frame.eventos.Terminar@  = frameEventoTerminar@
        frame.construir(WS_OVERLAPPED+WS_CAPTION+WS_SYSMENU)

        listViewConectados.PosX  = 10
        listViewConectados.PosY  = 10
        listViewConectados.Ancho = frame.Ancho - 30
        listViewConectados.Alto  = frame.Alto - 100
        listViewConectados.Padre = frame.hWnd
        listViewConectados.fuente.Nombre = "Arial"
        listViewConectados.fuente.Tamaño = 11
        listViewConectados.construir()

        Var listColumnas[]:INFO_COLUMNA
        ReDim listColumnas, 5

        listColumnas[0].Indice   = 0
        listColumnas[0].Ancho    = (listViewConectados.Ancho/5)
        listColumnas[0].Posición = LVCFMT_LEFT
        listColumnas[0].Texto    = "Nombre"

        listColumnas[1].Indice   = 1
        listColumnas[1].Ancho    = (listViewConectados.Ancho/5)
        listColumnas[1].Posición = LVCFMT_CENTER
        listColumnas[1].Texto    = "Dirección IP"

        listColumnas[2].Indice   = 2
        listColumnas[2].Ancho    = (listViewConectados.Ancho/5)
        listColumnas[2].Posición = LVCFMT_CENTER
        listColumnas[2].Texto    = "Usuario@Host"

        listColumnas[3].Indice   = 3
        listColumnas[3].Ancho    = (listViewConectados.Ancho/5)
        listColumnas[3].Posición = LVCFMT_CENTER
        listColumnas[3].Texto    = "SO"

        listColumnas[4].Indice   = 4
        listColumnas[4].Ancho    = (listViewConectados.Ancho/5)
        listColumnas[4].Posición = LVCFMT_CENTER
        listColumnas[4].Texto    = "País@Idioma"

        listViewConectados.insertarColumnas(listColumnas)

        botonAbrirCD.Texto = "Abrir CD"
        botonAbrirCD.PosX  = 10
        botonAbrirCD.PosY  = frame.Alto - 80
        botonAbrirCD.Ancho = (frame.Ancho/2) - 30
        botonAbrirCD.Alto  = 40
        botonAbrirCD.Padre = frame.hWnd
        botonAbrirCD.eventos.Mouse.Clic@ = botonAbrirCDEventClic@
        botonAbrirCD.construir()

        botonCerrarCD.Texto = "Cerrar CD"
        botonCerrarCD.PosX  = (frame.Ancho - botonAbrirCD.Ancho) - 20
        botonCerrarCD.PosY  = botonAbrirCD.PosY
        botonCerrarCD.Ancho = (frame.Ancho/2) - 30
        botonCerrarCD.Alto  = 40
        botonCerrarCD.Padre = frame.hWnd
        botonCerrarCD.eventos.Mouse.Clic@ = botonCerrarCDEventClic@
        botonCerrarCD.construir()

        frame.mostrar()
        frame.correr()
    FinSi

Proc botonAbrirCDEventClic(hWnd:Entero,Botón:Byte,Presionado:Booleano,X,Y:Entero)
    Seleccionar Botón
        Caso BOTON_IZQUIERDO
            Seleccionar Presionado
                Caso Falso
                    Var seleccionado, iCount, clienteSocket:Entero
                    Var seleccionadoTxt:Cadena
                    seleccionado = listViewConectados.getItemSelected

                    Si ( seleccionado <> -1 ) Entonces
                        seleccionadoTxt = listViewConectados.getItemText(seleccionado, 0)
                        Contar iCount a &clientesName
                            Si ( seleccionadoTxt = clientesName[iCount] ) Entonces
                                clienteSocket = clientesSocket[iCount]
                                Salir Contar
                            FinSi
                        Seguir

                        Si ( clienteSocket <> 0 ) Entonces
                            Server.enviar(clienteSocket, "openCD|0")
                        FinSi
                    FinSi
            FinSeleccionar
    FinSeleccionar
FinProc

Proc botonCerrarCDEventClic(hWnd:Entero,Botón:Byte,Presionado:Booleano,X,Y:Entero)
    Seleccionar Botón
        Caso BOTON_IZQUIERDO
            Seleccionar Presionado
                Caso Falso
                    Var seleccionado, iCount, clienteSocket:Entero
                    Var seleccionadoTxt:Cadena
                    seleccionado = listViewConectados.getItemSelected

                    Si ( seleccionado <> -1 ) Entonces
                        seleccionadoTxt = listViewConectados.getItemText(seleccionado, 0)
                        Contar iCount a &clientesName
                            Si ( seleccionadoTxt = clientesName[iCount] ) Entonces
                                clienteSocket = clientesSocket[iCount]
                                Salir Contar
                            FinSi
                        Seguir

                        Si ( clienteSocket <> 0 ) Entonces
                            Server.enviar(clienteSocket, "closeCD|0")
                        FinSi
                    FinSi
            FinSeleccionar
    FinSeleccionar
FinProc

Proc ServerManager(info:Entero)
    Var IDclient, idConnect:Entero
    Var infoCad:Cadena
    Var msg, arrayInfo[]:Cadena
    infoCad = CadDePtr(info)
    arrayInfo = Separar(infoCad, "|")
    IDclient = CadEnt(arrayInfo[0])
    idConnect = CadEnt(arrayInfo[1])
    Repetir
        msg = Server.recibir(IDclient)
        Si ( (CadLong(msg) = 0) Or (msg = "") ) Entonces Salir Repetir
        arrayInfo = Separar(msg, "|")
        Seleccionar arrayInfo[0]
            Caso "registro"
                registroCliente(idConnect, arrayInfo[1])
            Caso "salir"
                Server.desconectar(IDclient)
                'Server.enviar(IDclient, "salir")
                Salir Repetir
        FinSeleccionar
        Pausar(500)
    PorSiempre
    clientesSocket[idConnect] = 0
    Var i:Entero
    i = 0
    Contar i a listViewConectados.ItemsCount
        Var itemComp:Cadena
        itemComp = "ServerTest" + EntCad(idConnect)
        Si ( listViewConectados.getItemText(i, 0) = itemComp ) Entonces
            listViewConectados.eliminarItem(i)
            Salir Contar
        FinSi
    Seguir
    'ExitThread(0)
FinProc

Proc registroCliente(id:Entero, txt:Cadena)
    Var listItems:INFO_ITEM
    Var info[]:Cadena
    ReDim listItems.Texto, 5
    info = Separar(txt, "=.=")
    listItems.Texto[0] = info[0] + EntCad(id)
    listItems.Texto[1] = info[1]
    listItems.Texto[2] = info[2]
    listItems.Texto[3] = info[3]
    listItems.Texto[4] = info[4]
    listItems.Indice   = id
    clientesName[id] = listItems.Texto[0]
    listViewConectados.insertarItem(listItems)
    ReDim Preservar clientesName, (id+2)
FinProc

Destruir botonCerrarCD
Destruir botonAbrirCD
Destruir listViewConectados
Destruir frame
Destruir Server

'/**
' * Cliente del gestor de conexiones
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: Cliente.cml
' * ---------------------------------------
'*/

Importar "Cramel.cml"
Importar "MSVBVM60\MSVBVM60.cml"
Importar "Constantes.cml"
Importar "APIS.cml"
Importar "Socket.cml"
Importar "Interfaz\Interfaz.cml"
Importar "HTTPRequest.cml"
Importar "Regedit.cml"
Importar "Funciones.cml"

Var Cliente:SocketClient
Var frame:CMLframe
Var hilo, hiloID:Entero

Proc frameEventoCargar(hWnd:Entero)
    Var info[]:Cadena
    info = obtenerIPPais
    Cliente.enviar("registro|ServerTest=.=" + info[0] + "=.=" + Usuario + "@" + UsuarioDominioSO + "=.=" + SO + "=.=" + info[1] + "@" + LenguajeSO)
FinProc

Proc frameEventoTerminar(hWnd:Entero, Referencia Cancelar:Booleano)
    Cliente.enviar("salir|0")
    Cliente.detener
    ExitProcess(0)
FinProc

Crear Cliente
Crear frame
    Cliente.iniciar
    Si (Cliente.conectar("127.0.0.1", 666) = SOCKET_ERROR) Entonces
        Mensaje("Error al iniciar conectarse al servidor")
        ExitProcess(0)
    SiNo
        hilo = CreateThread(Nulo, 0, ClienteManager@, Nulo, 0, hiloID@)

        frame.Texto = "Cliente en espera"
        frame.PosX  = 10
        frame.PosY  = 10
        frame.Ancho = 100
        frame.Alto  = 100
        frame.Padre = 0
        frame.eventos.Cargar@  = frameEventoCargar@
        frame.eventos.Terminar@  = frameEventoTerminar@
        frame.construir(WS_OVERLAPPED+WS_CAPTION+WS_SYSMENU)

        frame.mostrar()
        frame.correr()
    FinSi

Proc ClienteManager
    Var msg[],tempMsg:Cadena
    Var command,empty:Cadena
    Repetir
        tempMsg = Cliente.recibir
        Si ( (CadLong(tempMsg) = 0) Or (tempMsg = "") ) Entonces Salir Repetir
        msg = Separar(tempMsg, "|")
        Seleccionar msg[0]
            Caso "Hola"
                Cliente.enviar("c")
            Caso "openCD"
                command = "set CDAudio door open"
                mciSendString(StrPtr(command), StrPtr(empty), 127, 0)
            Caso "closeCD"
                command = "set CDAudio door closed"
                mciSendString(StrPtr(command), StrPtr(empty), 127, 0)
        FinSeleccionar
        Pausar(500)
    PorSiempre
FinProc

Destruir frame
Destruir Cliente

'/**
' * Funciones
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: Constantes.cml
' * ---------------------------------------
'*/

Proc SO():Cadena 
    Var registro:Regedit
    Crear registro
    registro.hClave = HKEY_LOCAL_MACHINE
    registro.sClave = "SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion"
    registro.Clave  = "ProductName"
    Resultado = registro.leerClaveCadena
    Destruir registro    
FinProc

Proc Usuario():Cadena 
    Var len:Entero
    len = MAX_PATH
    Resultado = Espacio(len)
    GetUserName(StrPtr(Resultado), len@)
    Resultado = TruncarCadena(Resultado)
FinProc

Proc LenguajeSO():Cadena 
    Var registro:Regedit
    Crear registro
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "Control Panel\\International"
    registro.Clave  = "LocaleName"
    Resultado = registro.leerClaveCadena
    Destruir registro    
FinProc

Proc UsuarioDominioSO():Cadena 
    Var registro:Regedit
    Crear registro
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "Volatile Environment"
    registro.Clave  = "USERDOMAIN"
    Resultado = registro.leerClaveCadena
    Destruir registro    
FinProc

Proc UsuarioPathSO():Cadena 
    Var registro:Regedit
    Crear registro
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "Volatile Environment"
    registro.Clave  = "USERPROFILE"
    Resultado = registro.leerClaveCadena
    Destruir registro    
FinProc

Proc obtenerIPPais:Cadena[]
    Var request:HTTP
    Crear request
        request.Metodo = "GET"
        request.Puerto = INTERNET_DEFAULT_HTTP_PORT
        request.Servidor = "aruljohn.com"
        request.Dirección = "/details.php"
        Var codigoFuente,partes[]:Cadena
        ReDim Resultado, 2

        Si ( request.Conectar ) Entonces
            Si ( request.Enviar ) Entonces
                Si ( request.StatusCode = HTTP_STATUS_OK ) Entonces
                    codigoFuente = request.LeerRespuesta

                    'IP'
                    partes = Separar(codigoFuente, "IP address</td><td>")
                    partes[0] = partes[1]
                    partes = Separar(partes[0], "</td></tr>")
                    Resultado[0] = TruncarCadena(partes[0])
                    'País'
                    partes = Separar(codigoFuente, "Country</td><td valign=\"top\">")
                    partes[0] = partes[1]
                    partes = Separar(partes[0], "<img src=")
                    Resultado[1] = TruncarCadena(partes[0])
                FinSi
            FinSi
        FinSi
    Destruir request
FinProc

'/**
' * Socket
' *
' * @author  Yuki
' *
' * ==============Information==============
' *      Filename: Socket.cml
' * ---------------------------------------
'*/

Var TCP_Private_Init_Count:Byte

Clase SocketInfo,_
    sIP:Cadena,_
    sPuerto:Word,_
    sConexiones:Entero,_
    sVersión:Cadena,_
    sSocket:Entero,_
    @host:hostent,_
    @ptr:Entero,_
    i:Entero

    Sección Privada
        Proc setSIP(nuevo:Cadena)
            sIP = nuevo
        FinProc
        Proc getSIP:Cadena
            Resultado = sIP
        FinProc

        Proc setSPuerto(nuevo:Word)
            sPuerto = nuevo
        FinProc
        Proc getSPuerto:Word
            Resultado = sPuerto
        FinProc

        Proc setSConexiones(nuevo:Entero)
            sConexiones = nuevo
        FinProc
        Proc getSConexiones:Entero
            Resultado = sConexiones
        FinProc

        Proc setSVersión(nuevo:Cadena)
            sVersión = nuevo
        FinProc
        Proc getSVersión:Cadena
            Resultado = sVersión
        FinProc

        Proc setSSocket(nuevo:Entero)
            sSocket = nuevo
        FinProc
        Proc getSSocket:Entero
            Resultado = sSocket
        FinProc

    Sección Pública
        Prop IP:Cadena
            Lectura:getSIP
            Escritura:setSIP
        FinProp

        Prop Puerto:Word
            Lectura:getSPuerto
            Escritura:setSPuerto
        FinProp

        Prop NumConexiones:Entero
            Lectura:getSConexiones
            Escritura:setSConexiones
        FinProp

        Prop Versión:Cadena
            Lectura:getSVersión
            Escritura:setSVersión
        FinProp

        Prop SocketPtr:Entero
            Lectura:getSSocket
            Escritura:setSSocket
        FinProp

        Proc ObtenerIP(Referencia Dirección:Cadena):Entero[]
            i = inet_addr(Dirección)
            Si i <> SOCKET_ERROR Entonces
                ReDim Resultado,1
                Resultado[0] = i
                Salir
            SiNo
                host@ = GetHostByName(dirección)
                ReDim Resultado,host.h_length
                i = 0
                Contar i a host.h_length - 1
                    ptr@ = host.h_addr_list + (i * 4)
                    Resultado[i] = ptr
                Seguir
            FinSi
        FinProc

        Proc ConvertirIP(direccion:Entero):Cadena
            i = 0
            Mientras i < 4
                Resultado = Resultado + EntCad(direccion And 255)
                Si (i < 3) Entonces Resultado = Resultado + "."
                direccion = direccion Shr 8
                i = i + 1
            FinMientras
        FinProc

FinClase

Clase SocketServer(SocketInfo),_
    wData:WSADATA,_
    Ver:Word,_
    Info:SOCKADDR_IN,_
    Addr:SOCKADDR_IN,_
    Size:Entero
    
    Sección Pública
        Proc iniciar(Opcional Referencia Versión:Cadena = "2.2"):Booleano
            Si TCP_Private_Init_Count >= 1 Entonces Salir
            Seleccionar Versión
                Caso "2.2"
                    Ver = MakeWord(2,2)
            FinSeleccionar
            Resultado = (WSAStartup(Ver, wData) = OK)
            Si Resultado Entonces
                TCP_Private_Init_Count = TCP_Private_Init_Count + 1
                setSVersión(Versión)
            FinSi
        FinProc

        Proc escuchar(Puerto:Word, Opcional nConecciones:Entero = 255):Entero
            Resultado = socket(AF_INET,SOCK_STREAM,0)
            Si Resultado = INVALID_SOCKET Entonces Devolver 0
            Info.sin_family = AF_INET
            Info.sin_addr.s_addr = INADDR_ANY
            Info.sin_port = htons(Puerto)
            Si bind(Resultado, Info, &SOCKADDR_IN) = SOCKET_ERROR Entonces
                closesocket(Resultado)
                Devolver -1
            FinSi
            Si listen(Resultado, nConecciones) = SOCKET_ERROR Entonces
                closesocket(Resultado)
                Devolver -1
            FinSi
            setSPuerto(Puerto)
            setSConexiones(nConecciones)
            setSSocket(Resultado)
        FinProc

        Proc aceptar(Opcional pProcThread:Entero):Entero
            Si getSSocket = INVALID_SOCKET Entonces Salir
            Resultado = accept(getSSocket, Addr, &SOCKADDR_IN)
            Si Resultado = INVALID_SOCKET Entonces Devolver 0
            Si pProcThread Entonces Resultado = CreateThread(0,0,pProcThread,Resultado,0,0)
        FinProc

        Proc enviar(sockt:Entero, Referencia Datos:Cadena):Entero
            Si sockt = INVALID_SOCKET Entonces Salir
            Resultado = send(sockt, Datos@@, CadLong(Datos), 0)
        FinProc

        Proc recibir(sockt:Entero, Opcional Tamaño:Entero = 1024):Cadena
            Si sockt = INVALID_SOCKET Entonces Devolver ""
            Resultado = Espacio(Tamaño)
            Size = recv(sockt, Resultado@@, Tamaño,0)
            Si Size <> 0 Entonces 
                Resultado = Parte(Resultado,1,Size)
            SiNo
                Resultado = ""
            FinSi
        FinProc

        Proc detener
            Si TCP_Private_Init_Count >= 1 Entonces TCP_Private_Init_Count = TCP_Private_Init_Count - 1
            WSACleanup
        FinProc

        Proc desconectar(sockt:Entero)
            closesocket(sockt)
        FinProc

FinClase

Clase SocketClient(SocketInfo),_
    wData:WSADATA,_
    Ver:Word,_
    Cliente:SOCKADDR_IN,_
    IPs[]:Entero,_
    i:Entero,_
    Size:Entero
    
    Sección Pública
        Proc iniciar(Opcional Referencia Versión:Cadena = "2.2"):Booleano
            Si TCP_Private_Init_Count >= 1 Entonces Salir
            Seleccionar Versión
                Caso "2.2"
                    Ver = MakeWord(2,2)
            FinSeleccionar
            Resultado = (WSAStartup(Ver,wData) = OK)
            Si Resultado Entonces
                TCP_Private_Init_Count = TCP_Private_Init_Count + 1
                setSVersión(Versión)
            FinSi
        FinProc

        Proc conectar(Referencia IP:Cadena, Puerto:Word):Entero
            Resultado = socket(AF_INET,SOCK_STREAM,0)
            Si Resultado = INVALID_SOCKET Entonces Devolver 0
            Cliente.sin_family = AF_INET
            Cliente.sin_port = htons(Puerto)
            IPs = ObtenerIP(IP)
            Contar i a (&IPs - 1)
                Cliente.sin_addr.s_addr = IPs[i]
                Si connect(Resultado, Cliente, &SOCKADDR_IN) = OK Entonces
                    setSPuerto(Puerto)
                    setSIP(IP)
                    setSSocket(Resultado)
                    Salir
                FinSi
            Seguir
            closesocket(Resultado)
            Resultado = -1
        FinProc

        Proc enviar(Referencia Datos:Cadena):Entero
            Si getSSocket = INVALID_SOCKET Entonces Salir
            Resultado = send(getSSocket, Datos@@, CadLong(Datos), 0)
        FinProc

        Proc recibir(Opcional Tamaño:Entero = 1024):Cadena
            Si getSSocket = INVALID_SOCKET Entonces Devolver ""
            Resultado = Espacio(Tamaño)
            Size = recv(getSSocket,Resultado@@,Tamaño,0)
            Si Size <> 0 Entonces 
                Resultado = Parte(Resultado,1,Size)
            SiNo
                Resultado = ""
            FinSi
        FinProc

        Proc detener
            Si TCP_Private_Init_Count >= 1 Entonces TCP_Private_Init_Count = TCP_Private_Init_Count - 1
            WSACleanup
        FinProc

        Proc desconectar
            closesocket(getSSocket)
        FinProc

FinClase

'/**
' * Regedit
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: Regedit.cml
' * ---------------------------------------
'*/

Clase Regedit,_
    rhKey:Entero,_
    rsKey,_
    rKey,_
    rValueC:Cadena,_
    rType,_
    rSize,_
    rNorU,_
    rPtr:Entero,_
    rValueW:Word,_
    rStrucSA:SECURITY_ATTRIBUTES

    Sección Privada
        Proc setrhKey(nuevo:Entero)
            rhKey = nuevo
        FinProc
        Proc getrhKey:Entero
            Resultado = rhKey
        FinProc

        Proc setrsKey(nuevo:Cadena)
            rsKey = nuevo
        FinProc
        Proc getrsKey:Cadena
            Resultado = rsKey
        FinProc

        Proc setrKey(nuevo:Cadena)
            rKey = nuevo
        FinProc
        Proc getrKey:Cadena
            Resultado = rKey
        FinProc

        Proc setrSize(nuevo:Entero)
            rSize = nuevo
        FinProc
        Proc getrSize:Entero
            Resultado = rSize
        FinProc

        Proc setrPtr(nuevo:Entero)
            rPtr = nuevo
        FinProc
        Proc getrPtr:Entero
            Resultado = rPtr
        FinProc

        Proc setrValueC(nuevo:Cadena)
            rValueC = nuevo
        FinProc
        Proc getrValueC:Cadena
            Resultado = rValueC
        FinProc

        Proc setrValueW(nuevo:Word)
            rValueW = nuevo
        FinProc
        Proc getrValueW:Word
            Resultado = rValueW
        FinProc

    Sección Pública
        Prop hClave:Entero
            Lectura:getrhKey
            Escritura:setrhKey
        FinProp
        
        Prop sClave:Cadena
            Lectura:getrsKey
            Escritura:setrsKey
        FinProp
        
        Prop Clave:Cadena
            Lectura:getrKey
            Escritura:setrKey
        FinProp
        
        Prop Tamaño:Entero
            Lectura:getrSize
            Escritura:setrSize
        FinProp
        
        Prop Puntero:Entero
            Lectura:getrPtr
            Escritura:setrPtr
        FinProp
        
        Prop ValorCadena:Cadena
            Lectura:getrValueC
            Escritura:setrValueC
        FinProp
        
        Prop ValorWord:Word
            Lectura:getrValueW
            Escritura:setrValueW
        FinProp

        Proc crearClaveCadena:Booleano
            Resultado = Falso

            rStrucSA.lpSecurityDescriptor = 0
            rStrucSA.bInheritHandle = 1
            rStrucSA.nLength = &rStrucSA
            
            Si (RegCreateKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, "", 0, KEY_WRITE, rStrucSA@, rPtr@, rNorU@) = ERROR_SUCCESS) Entonces
                rSize = CadLong(rValueC)
                Si ( RegSetValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, REG_SZ, StrPtr(rValueC), rSize) = ERROR_SUCCESS ) Entonces
                    Resultado = Verdad
                FinSi
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

        Proc crearClaveWord:Booleano
            Resultado = Falso

            rStrucSA.lpSecurityDescriptor = 0
            rStrucSA.bInheritHandle = 1
            rStrucSA.nLength = &rStrucSA
            
            Si (RegCreateKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, "", 0, KEY_WRITE, rStrucSA@, rPtr@, rNorU@) = ERROR_SUCCESS) Entonces
                rSize = &rValueW
                rSize = rSize * 2
                Si ( RegSetValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, REG_DWORD, rValueW@, rSize) = ERROR_SUCCESS ) Entonces
                    Resultado = Verdad
                FinSi
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

        Proc establecerClaveCadena:Booleano
            Resultado = Falso            
            Si (RegOpenKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, KEY_WRITE, rPtr@) = ERROR_SUCCESS) Entonces
                rSize = CadLong(rValueC)
                Si ( RegSetValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, REG_SZ, StrPtr(rValueC), rSize) = ERROR_SUCCESS ) Entonces
                    Resultado = Verdad
                FinSi
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

        Proc establecerClaveWord:Booleano
            Resultado = Falso            
            Si (RegOpenKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, KEY_WRITE, rPtr@) = ERROR_SUCCESS) Entonces
                rSize = &rValueW
                rSize = rSize * 2
                Si ( RegSetValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, REG_DWORD, rValueW@, rSize) = ERROR_SUCCESS ) Entonces
                    Resultado = Verdad
                FinSi
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

        Proc leerClaveCadena:Cadena
            Resultado = "Desconocido"
            Si (RegOpenKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, KEY_QUERY_VALUE, rPtr@) = ERROR_SUCCESS) Entonces
                rType = REG_SZ
                RegQueryValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, rType@, Nulo, rSize@)
                Resultado = Espacio(EsteObjeto.Tamaño)
                RegQueryValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, rType@, StrPtr(Resultado), rSize@)
                Resultado = TruncarCadena(Resultado)
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

        Proc leerClaveWord:Word
            Resultado = -1
            Si (RegOpenKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, KEY_QUERY_VALUE, rPtr@) = ERROR_SUCCESS) Entonces
                rType = REG_DWORD
                RegQueryValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, rType@, Nulo, rSize@)
                RegQueryValue(EsteObjeto.Puntero, EsteObjeto.Clave, 0, rType@, Resultado@, rSize@)
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

        Proc borrarValor:Booleano
            Resultado = Falso
            Si (RegOpenKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, KEY_SET_VALUE, rPtr@) = ERROR_SUCCESS) Entonces
                Si ( RegDeleteValue(EsteObjeto.Puntero, EsteObjeto.Clave) = ERROR_SUCCESS ) Entonces
                    Resultado = Verdad
                FinSi
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

        Proc borrarClave:Booleano
            Resultado = Falso
            Si (RegOpenKey(EsteObjeto.hClave, EsteObjeto.sClave, 0, KEY_SET_VALUE, rPtr@) = ERROR_SUCCESS) Entonces
                Si (RegDeleteKey(EsteObjeto.Puntero, "") = ERROR_SUCCESS) Entonces
                    Resultado = Verdad
                FinSi
            FinSi
            RegCloseKey(EsteObjeto.Puntero)
        FinProc

FinClase

Proc WordCad(Valor:Word, Opcional Base:Entero = 16):Cadena
    Resultado = TruncarCadena(itoa(Valor,Espacio(10),Base))
FinProc

'/**
' * Constantes para el Regedit
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: Constantes.cml
' * ---------------------------------------
'*/

'Constantes Regedit'
    'Registro'
        Const HKEY_CLASSES_ROOT        = &80000000
        Const HKEY_CURRENT_USER        = &80000001
        Const HKEY_LOCAL_MACHINE       = &80000002
        Const HKEY_USERS               = &80000003
        Const HKEY_PERFORMANCE_DATA    = &80000004
        Const HKEY_PERFORMANCE_TEXT    = &80000050
        Const HKEY_PERFORMANCE_NLSTEXT = &80000060
        Const HKEY_CURRENT_CONFIG      = &80000005
        Const HKEY_DYN_DATA            = &80000006
    'Registro'

    'Desired Access'
        Const KEY_ALL_ACCESS         = &F003F
        Const KEY_CREATE_LINK        = &0020
        Const KEY_CREATE_SUB_KEY     = &0004
        Const KEY_ENUMERATE_SUB_KEYS = &0008
        Const KEY_EXECUTE            = &20019
        Const KEY_NOTIFY             = &0010
        Const KEY_QUERY_VALUE        = &0001
        Const KEY_READ               = &20019
        Const KEY_SET_VALUE          = &0002
        Const KEY_WOW64_32KEY        = &0200
        Const KEY_WOW64_64KEY        = &0100
        Const KEY_WRITE              = &20006
    'Desired Access'

    'Registry Value Type'
        Const REG_NONE                       = 0
        Const REG_SZ                         = 1
        Const REG_EXPAND_SZ                  = 2 
        Const REG_BINARY                     = 3 
        Const REG_DWORD                      = 4
        Const REG_DWORD_LITTLE_ENDIAN        = 4
        Const REG_DWORD_BIG_ENDIAN           = 5 
        Const REG_LINK                       = 6
        Const REG_MULTI_SZ                   = 7
        Const REG_RESOURCE_LIST              = 8
        Const REG_FULL_RESOURCE_DESCRIPTOR   = 9
        Const REG_RESOURCE_REQUIREMENTS_LIST = 10
        Const REG_QWORD                      = 11
        Const REG_QWORD_LITTLE_ENDIAN        = 11
    'Registry Value Type'

    'Error message'
        Const ERROR_SUCCESS = &0
    'Error message'
'Constantes Regedit'

'/**
' * APIS para el Editor de Registro
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: APIS.cml
' * ---------------------------------------
'*/

'APIS Regedit'
    API RegOpenKey(hKey:Entero, lpSubKey:Cadena, ulOptions, samDesired, phkResult:Entero):Entero, "Advapi32.dll" "RegOpenKeyExA"
    API RegQueryValue(hKey:Entero, lpValueName:Cadena, lpReserved, lpType, lpData, lpcbData:Entero):Entero, "Advapi32.dll" "RegQueryValueExA"
    API RegCloseKey(hKey:Entero):Entero, "Advapi32.dll"
    API RegCreateKey(hKey:Entero, lpSubKey:Cadena, lpReserved:Entero, lpClass:Cadena, dwOptions:Entero, samDesired:Entero, lpSecurityAttributes:Entero, phkResult, lpdwDisposition:Entero):Entero, "Advapi32.dll" "RegCreateKeyExA"
    API RegDeleteKey(hKey:Entero, lpSubKey:Cadena):Entero, "Advapi32.dll" "RegDeleteKeyA"
    API RegSetValue(hKey:Entero, lpValueName:Cadena, lpReserved, lpType, lpData, cbData:Entero):Entero, "Advapi32.dll" "RegSetValueExA"
    API RegDeleteValue(hKey:Entero, lpValueName:Cadena):Entero, "Advapi32.dll" "RegDeleteValueA"
'APIS Regedit'

Importar "Cramel.cml"
Importar "MSVBVM60\MSVBVM60.cml"
Importar "Constantes.cml"
Importar "APIS.cml"
Importar "Regedit.cml"

Var registro:Regedit

Crear registro

    'Creamos la subclave HelloCramel con una clave Test con valor "Prueba"'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run\\HelloCramel"
    registro.Clave  = "Test"
    registro.ValorCadena = "Prueba"

    Si ( registro.crearClaveCadena ) Entonces
        Mensaje("Correcto")
    SiNo
        Mensaje("Error")
    FinSi

    'Establecemos la clave HelloCramel'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run"
    registro.Clave  = "HelloCramel"
    registro.ValorCadena = "Estamos aquí"

    Si ( registro.crearClaveCadena ) Entonces
        Mensaje("Correcto")
    SiNo
        Mensaje("Error")
    FinSi
    
    'SO'
    registro.hClave = HKEY_LOCAL_MACHINE
    registro.sClave = "SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion"
    registro.Clave  = "ProductName"
    Mensaje(registro.leerClaveCadena)
    
    'Lang'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "Control Panel\\International"
    registro.Clave  = "LocaleName"
    Mensaje(registro.leerClaveCadena)
    
    'User path'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "Volatile Environment"
    registro.Clave  = "USERPROFILE"
    Mensaje(registro.leerClaveCadena)
    
    'Random Key value DWord'
    registro.hClave = HKEY_LOCAL_MACHINE
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\ScriptedDiagnosticsProvider"
    registro.Clave  = "RemoteServerResponseId"
    Mensaje(WordCad(registro.leerClaveWord, 16))

    'Borramos el valor HelloCramel'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run"
    registro.Clave  = "HelloCramel"

    Si ( registro.borrarValor ) Entonces
        Mensaje("Correcto")
    SiNo
        Mensaje("Error")
    FinSi

    'Borramos la subclave HelloCramel'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run\\HelloCramel"

    Si ( registro.borrarClave ) Entonces
        Mensaje("Correcto")
    SiNo
        Mensaje("Error")
    FinSi

    'Establecemos una clave String'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run"
    registro.Clave  = "HelloCramelC"
    registro.ValorCadena = "\"C:\test.exe\""

    Si ( registro.crearClaveCadena ) Entonces
        Mensaje("Correcto")
    SiNo
        Mensaje("Error")
    FinSi

    'Establecemos una clave DWord'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run"
    registro.Clave  = "HelloCramelW"
    registro.ValorWord = &c0a

    Si ( registro.crearClaveWord ) Entonces
        Mensaje("Correcto")
    SiNo
        Mensaje("Error")
    FinSi

    'Cambiamos el valor de HelloCramelW'
    registro.hClave = HKEY_CURRENT_USER
    registro.sClave = "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Run"
    registro.Clave  = "HelloCramelW"
    registro.ValorWord = &fffc

    Si ( registro.establecerClaveWord ) Entonces
        Mensaje("Correcto")
    SiNo
        Mensaje("Error")
    FinSi

Destruir registro

Var cmd:Consola

    Crear cmd
    Var a, b, c, d:Entero
    Const fijo = 4
    Var i, j:Entero

    i = 1
    j = 1

    Repetir
        a = i
        cmd.escribirLinea("a tomo el valor de: " + EntCad(a))
        d = a * fijo
        cmd.escribirLinea("d tomo el valor de: " + EntCad(d))
        Repetir
            c = j
            cmd.escribirLinea("c tomo el valor de: " + EntCad(c))
            Si ( (a+c) = d ) Entonces
                Salir Repetir
            FinSi
            j = j + 1
        MientrasQue j <= d
        b = (c/2)
        cmd.escribirLinea("b tomo el valor de: " + EntCad(b))

        Si ( ((a*b) = c) And ((c-b) = b) ) Entonces
            Salir Repetir
        FinSi

        cmd.escribirLinea("De nuevo" + CRLF)
        i = i + 1
    MientrasQue i <= 9
    
    cmd.establecerTitulo("Resultado final")
    cmd.escribirLinea("")
    cmd.escribirLinea("a: " + EntCad(a) + CRLF + "b: " + EntCad(b) + CRLF + "c: " + EntCad(c) + CRLF + "d: " + EntCad(d))
    cmd.pausarConsola()
Destruir cmd

'/**
' * Brute Force Dictionary
' *
' * @by         @79137913
' * @Ported by  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: Dictionary.cml
' * ---------------------------------------
'*/
Importar "Cramel.cml"
Importar "MSVBVM60\MSVBVM60.cml"
Importar "Constantes.cml"
Importar "Interfaz\Interfaz.cml"
Importar "Archivo.cml"

Var frame:CMLframe
Var checkNum, checkMin, checkEspMin, checkSim, checkMay, checkEspMay, checkAdd:CMLCheckbox
Var cajaAdd, cajaDe, cajaHas:CMLCajatexto
Var etiquetaGen, etiquetaHas, etiquetaCar:CMLEtiqueta
Var botonGenerar:CMLBotón
Var grupoLetras:CMLGroupbox
Var diccionarioArchivo:ArchivoC

Const Sym = "/\!·$%&/()='""¡¿?<>., :;-_*+" 'Simbolos
Const Num = "0123456789"                   'Numeros
Const Min = "abcdefghijklmnopqrstuvwxyz"   'Letras Minusculas
Const May = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"   'Letras Mayusculas
Const SpL = "áéíóúàèìòùâêîôûäëïöüçñ"       'Letras Especiales Minusculas
Const SpU = "ÁÉÍÓÚÀÈÌÒÙÂÊÎÔÛÄËÏÖÜÇÑ"       'Letras Especiales Mayusculas

Crear frame
Crear checkNum
Crear checkMin
Crear checkEspMin
Crear checkSim
Crear checkMay
Crear checkEspMay
Crear checkAdd
Crear cajaAdd
Crear cajaDe
Crear cajaHas
Crear etiquetaGen
Crear etiquetaHas
Crear etiquetaCar
Crear botonGenerar
Crear grupoLetras
Crear diccionarioArchivo

    frame.Texto = "Brute Force Dictionary Creator .Net by 79137913"
    frame.Ancho = 410
    frame.Alto = 250
    frame.Padre = 0
    frame.Centrar = 1
    frame.construir(WS_OVERLAPPED+WS_CAPTION+WS_SYSMENU)

    grupoLetras.Texto = "Elige las letras que contendra el diccionario"
    grupoLetras.PosX  = 10
    grupoLetras.PosY  = 10
    grupoLetras.Ancho = frame.Ancho - 30
    grupoLetras.Alto  = (frame.Alto/2) + 10
    grupoLetras.Padre = frame.hWnd
    grupoLetras.fuente.Nombre = "Arial"
    grupoLetras.fuente.Tamaño = 11
    grupoLetras.construir()

        checkNum.Texto = "Numeros"
        checkNum.PosX  = 20
        checkNum.PosY  = 35
        checkNum.Ancho = 80
        checkNum.Alto  = 20
        checkNum.Padre = frame.hWnd
        checkNum.fuente.Nombre = "Arial"
        checkNum.fuente.Tamaño = 11
        checkNum.construir()

        checkMin.Texto = "Minusculas"
        checkMin.PosX  = 10 + (checkNum.Ancho + checkNum.PosX)
        checkMin.PosY  = checkNum.PosY
        checkMin.Ancho = 90
        checkMin.Alto  = 20
        checkMin.Padre = frame.hWnd
        checkMin.fuente.Nombre = "Arial"
        checkMin.fuente.Tamaño = 11
        checkMin.construir()

        checkEspMin.Texto = "Especiales Minusculas"
        checkEspMin.PosX  = 10 + (checkMin.Ancho + checkMin.PosX)
        checkEspMin.PosY  = checkMin.PosY
        checkEspMin.Ancho = 170
        checkEspMin.Alto  = 20
        checkEspMin.Padre = frame.hWnd
        checkEspMin.fuente.Nombre = "Arial"
        checkEspMin.fuente.Tamaño = 11
        checkEspMin.construir()

        checkSim.Texto = "Simbolos"
        checkSim.PosX  = 20
        checkSim.PosY  = 5 + (checkNum.Alto + checkNum.PosY)
        checkSim.Ancho = 80
        checkSim.Alto  = 20
        checkSim.Padre = frame.hWnd
        checkSim.fuente.Nombre = "Arial"
        checkSim.fuente.Tamaño = 11
        checkSim.construir()

        checkMay.Texto = "Mayusculas"
        checkMay.PosX  = 10 + (checkSim.Ancho + checkSim.PosX)
        checkMay.PosY  = checkSim.PosY
        checkMay.Ancho = 95
        checkMay.Alto  = 20
        checkMay.Padre = frame.hWnd
        checkMay.fuente.Nombre = "Arial"
        checkMay.fuente.Tamaño = 11
        checkMay.construir()

        checkEspMay.Texto = "Especiales Mayusculas"
        checkEspMay.PosX  = 5 + (checkMay.Ancho + checkMay.PosX)
        checkEspMay.PosY  = checkMay.PosY
        checkEspMay.Ancho = 170
        checkEspMay.Alto  = 20
        checkEspMay.Padre = frame.hWnd
        checkEspMay.fuente.Nombre = "Arial"
        checkEspMay.fuente.Tamaño = 11
        checkEspMay.construir()

        checkAdd.Texto = "Agregar los siguientes caracteres"
        checkAdd.PosX  = 20
        checkAdd.PosY  = 5 + (checkSim.Alto + checkSim.PosY)
        checkAdd.Ancho = frame.Ancho - 60
        checkAdd.Alto  = 20
        checkAdd.Padre = frame.hWnd
        checkAdd.fuente.Nombre = "Arial"
        checkAdd.fuente.Tamaño = 11
        checkAdd.eventos.Mouse.Clic@ = checkAddEventClick@
        checkAdd.construir()

        cajaAdd.PosX  = 20
        cajaAdd.PosY  = 5 + (checkAdd.Alto + checkAdd.PosY)
        cajaAdd.Ancho = frame.Ancho - 50
        cajaAdd.Alto  = 25
        cajaAdd.Padre = frame.hWnd
        cajaAdd.fuente.Nombre = "Arial"
        cajaAdd.fuente.Tamaño = 11
        cajaAdd.Deshabilitado = Verdad
        cajaAdd.construir()

    grupoLetras.cerrar()

    etiquetaGen.Texto = "Generar palabras desde"
    etiquetaGen.PosX  = 10
    etiquetaGen.PosY  = (grupoLetras.Alto + grupoLetras.PosY) + 10
    etiquetaGen.Ancho = 160
    etiquetaGen.Alto  = 30
    etiquetaGen.Padre = frame.hWnd
    etiquetaGen.fuente.Nombre = "Arial"
    etiquetaGen.fuente.Tamaño = 11
    etiquetaGen.construir()

    cajaDe.Texto = "2"
    cajaDe.PosX  = (etiquetaGen.PosX + etiquetaGen.Ancho)+2
    cajaDe.PosY  = etiquetaGen.PosY-5
    cajaDe.Ancho = 30
    cajaDe.Alto  = 25
    cajaDe.Padre = frame.hWnd
    cajaDe.fuente.Nombre = "Arial"
    cajaDe.fuente.Tamaño = 11
    cajaDe.construir(ES_NUMBER)
    cajaDe.Limite = 2

    etiquetaHas.Texto = "hasta"
    etiquetaHas.PosX  = (cajaDe.PosX + cajaDe.Ancho) + 5
    etiquetaHas.PosY  = etiquetaGen.PosY
    etiquetaHas.Ancho = 40
    etiquetaHas.Alto  = 30
    etiquetaHas.Padre = frame.hWnd
    etiquetaHas.fuente.Nombre = "Arial"
    etiquetaHas.fuente.Tamaño = 11
    etiquetaHas.construir()

    cajaHas.Texto = "4"
    cajaHas.PosX  = (etiquetaHas.PosX + etiquetaHas.Ancho)+2
    cajaHas.PosY  = etiquetaGen.PosY-5
    cajaHas.Ancho = 30
    cajaHas.Alto  = 25
    cajaHas.Padre = frame.hWnd
    cajaHas.fuente.Nombre = "Arial"
    cajaHas.fuente.Tamaño = 11
    cajaHas.construir(ES_NUMBER)
    cajaHas.Limite = 2

    etiquetaCar.Texto = "caracteres"
    etiquetaCar.PosX  = (cajaHas.PosX + cajaHas.Ancho) + 5
    etiquetaCar.PosY  = etiquetaHas.PosY
    etiquetaCar.Ancho = 150
    etiquetaCar.Alto  = 30
    etiquetaCar.Padre = frame.hWnd
    etiquetaCar.fuente.Nombre = "Arial"
    etiquetaCar.fuente.Tamaño = 11
    etiquetaCar.construir()

    botonGenerar.Texto = "Generar"
    botonGenerar.PosX  = frame.Ancho - 90
    botonGenerar.PosY  = frame.Alto - 70
    botonGenerar.Ancho = 70
    botonGenerar.Alto  = 30
    botonGenerar.Padre = frame.hWnd
    botonGenerar.fuente.Nombre = "Arial"
    botonGenerar.fuente.Tamaño = 11
    botonGenerar.eventos.Mouse.Clic@ = botonGenerarEventClick@
    botonGenerar.construir()

    frame.mostrar
    frame.correr

Proc checkAddEventClick(hWnd:Entero,Botón:Byte,Presionado:Booleano,X,Y:Entero)
    Seleccionar Botón
        Caso BOTON_IZQUIERDO
            Seleccionar Presionado
                Caso Falso
                    Si ( checkAdd.estaSeleccionado ) Entonces
                        cajaAdd.Deshabilitado = Falso
                    SiNo
                        cajaAdd.Deshabilitado = Verdad
                    FinSi
            FinSeleccionar
    FinSeleccionar
FinProc

Proc botonGenerarEventClick(hWnd:Entero,Botón:Byte,Presionado:Booleano,X,Y:Entero)
    Seleccionar Botón
        Caso BOTON_IZQUIERDO
            Seleccionar Presionado
                Caso Falso
                    Var hilo, hiloID:Entero
                    hilo = CreateThread(Nulo, 0, generarDic@, Nulo, 0, hiloID@)
            FinSeleccionar
    FinSeleccionar
FinProc

Proc generarDic
    Var CantLet, BufferPalabras, CT, CantPos, Desde, Hasta, Posiciones[]:Entero
    Var Palabras[]:Cadena

    Var Letras:Cadena 'string que contendra todos los caracteres a combinar para hacer el diccionario

    Letras = ""

    'by 79137913 for Underc0de.org
    'creamos secuencia de caracteres a utilizar
    Si (checkNum.estaSeleccionado) Entonces
        Letras = Letras + Num 'si Numeros esta tildado agregamos eso a la cadena
    FinSi
    Si (checkSim.estaSeleccionado) Entonces
        Letras = Letras + Sym 'si Simbolos esta tildado agregamos eso a la cadena
    FinSi
    Si (checkMin.estaSeleccionado) Entonces
        Letras = Letras + Min 'si Letras Minusculas esta tildado agregamos eso a la cadena
    FinSi
    Si (checkMay.estaSeleccionado) Entonces
        Letras = Letras + May 'si Letras Mayusculas esta tildado agregamos eso a la cadena
    FinSi
    Si (checkEspMin.estaSeleccionado) Entonces
        Letras = Letras + SpL 'si Letras Especiales Minusculas esta tildado agregamos eso a la cadena
    FinSi
    Si (checkEspMay.estaSeleccionado) Entonces
        Letras = Letras + SpU 'si Letras Especiales Mayusculas esta tildado agregamos eso a la cadena
    FinSi
    Si (checkAdd.estaSeleccionado) Entonces
        Letras = Letras + cajaAdd.cTexto 'si Agregar Siguientes Caracters esta tildado agregamos eso a la cadena
    FinSi

    CantLet = CadLong(Letras) - 1 'cantidad de letras
    BufferPalabras = 10000
    ReDim Palabras, BufferPalabras 'aqui se guardaran las combinaciones mientras las vamos generando en este ejemplo iremos guardando de a 10000 combinaciones
    CT = 0 'este contador nos dira cuantas palabras estan pendientes de guardar en el archivo
    CantPos = 0 'Cantidad de letras palabra actual
    Desde = CadEnt(cajaDe.cTexto) 'desde que cantidad de caracteres
    Hasta = CadEnt(cajaHas.cTexto) 'hasta que cantidad de caracteres

    Mensaje("Se iniciara el proceso, puede tardar mucho, para detener cierre la aplicacion con el Administrador de Tareas.", "ATENCION")

    diccionarioArchivo.abrir("diccionario.txt", GENERIC_WRITE, CREATE_ALWAYS)

    Var x, y, palfile:Entero

    y = 0
    Contar y a (Hasta - Desde)
        CantPos = (Desde + y) - 1 'establecemos el tamañode la combinacion actual
        ReDim Posiciones, CantPos
        Repetir
            x = 0
            Contar x a CantPos 'una vez por cada posicion que tenga que tener la palabra
                Palabras[CT] = Palabras[CT] + Parte(Letras, Posiciones[x]+1, Posiciones[x]+1) 'armamos una combinacion uniendo los caracteres de la cadena letras
            Seguir

            CT = CT + 1 'incrementamos CT en 1
            Posiciones[0] = Posiciones[0] + 1 'incrementamos la primera letra de posiciones (para que pase de "a" a "b" por ejemplo)
            x = 0
            Contar x a (CantPos - 1) 'nos fijamos si alguna posicion es mayor a la cantidad de letras si es asi volvemos a 0 esa posicion e incrementamos la siguiente
                Si (Posiciones[x] > CantLet ) Entonces
                    Posiciones[x] = 0
                    Posiciones[x+1] = Posiciones[x+1] + 1
                FinSi
            Seguir

            Si (CT = (BufferPalabras + 1) ) Entonces
                palfile = 0
                Mientras palfile <= &Palabras
                    diccionarioArchivo.escribir(Palabras[palfile] + CRLF) 'escribimos nuestro buffer de palabras en el archivo linea por linea
                    palfile = palfile + 1
                FinMientras
                CT = 0 'volvemos el contador a 0
                ReDim Palabras, BufferPalabras 'borramos el buffer de palabras
            FinSi

        HastaQue Posiciones[CantPos] = CantLet +1
    Seguir

    Si (CT > 0) Entonces 'si hay palabras pendientes de escribir
        ReDim Preservar Palabras, (CT - 1)        
        palfile = 0
        Mientras palfile < &Palabras
            diccionarioArchivo.escribir(Palabras[palfile] + CRLF) 'escribimos nuestro buffer de palabras en el archivo linea por linea
            palfile = palfile + 1
        FinMientras
        CT = 0
    FinSi

    Mensaje("Terminado archivo guardado como diccionario.txt", "ATENCION")
    diccionarioArchivo.cerrar()

FinProc

Destruir diccionarioArchivo
Destruir grupoLetras
Destruir botonGenerar
Destruir etiquetaCar
Destruir etiquetaHas
Destruir etiquetaGen
Destruir cajaHas
Destruir cajaDe
Destruir cajaAdd
Destruir checkAdd
Destruir checkEspMay
Destruir checkMay
Destruir checkSim
Destruir checkEspMin
Destruir checkMin
Destruir checkNum
Destruir frame

'/**
' * HTTP Request
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: HTTPRequest.cml
' * ---------------------------------------
'*/

Clase HTTP,_
    pServidor:Cadena,_
    pDirección:Cadena,_
    pAgente:Cadena,_
    pMetodo:Cadena,_
    pError:Cadena,_
    pVersion:Cadena,_
    pPuerto:Word,_
    ppOpen:Entero,_
    pConnect:Entero,_
    pRequest:Entero,_
    pStatusCode:Entero,_
    pStatusText:Cadena,_
    pTamañoPagina:Entero

    Var Content:Cadena
    Var Parametros:Cadena
    Var Buffer:Cadena
    Var BufferSta:Entero
    Var Lent:Entero
    Var QueryInfo:Cadena
    Var TamQueryInfo:Entero

    Constructor:Inicializar
    Destructor:Finalizar

    Sección Privada
        Proc Inicializar
            pAgente = "CramelRequest"
            pPuerto = INTERNET_DEFAULT_HTTP_PORT
            pVersion = "HTTP/1.1"
            pMetodo = "GET"
        FinProc

        Proc Finalizar
            Si ( pConnect ) Entonces
                InternetCloseHandle(pConnect)
            FinSi
            Si ( ppOpen ) Entonces
                InternetCloseHandle(ppOpen)
            FinSi
        FinProc

        Proc SetStatusText
            Seleccionar pStatusCode
                Caso HTTP_STATUS_CONTINUE
                    pStatusText = "La solicitud puede continuar."
                Caso HTTP_STATUS_OK
                    pStatusText = "La solicitud se completó correctamente."
                Caso HTTP_STATUS_MOVED
                    pStatusText = "El recurso solicitado se ha asignado a un nuevo URI permanente (Uniform Resource Identifier), y cualquier referencia futura a este recurso se debe hacer usando uno de los URIs devueltos."
                Caso HTTP_STATUS_REDIRECT
                    pStatusText = "El recurso solicitado reside temporalmente bajo un URI diferente (Uniform Resource Identifier)."
                Caso HTTP_STATUS_BAD_REQUEST
                    pStatusText = "La solicitud no pudo ser procesada por el servidor debido a la sintaxis no válida."
                Caso HTTP_STATUS_FORBIDDEN
                    pStatusText = "Acceso denegado."
                Caso HTTP_STATUS_NOT_FOUND
                    pStatusText = "El servidor no ha encontrado nada que coincida con el URI solicitado (Uniform Resource Identifier)."
                Caso HTTP_STATUS_SERVER_ERROR
                    pStatusText = "El servidor encontró una condición inesperada que le impidió cumplir con la solicitud."
                Caso HTTP_STATUS_SERVICE_UNAVAIL
                    pStatusText = "El servicio está temporalmente sobrecargado."
            FinSeleccionar
        FinProc

        Proc SetError
            Seleccionar GetLastError()
                Caso ERROR_INTERNET_OPERATION_CANCELLED
                    pError = "La operación se canceló, normalmente porque el identificador en el que se estaba ejecutando la solicitud se cerró antes de que se completase la operación."
                Caso ERROR_INTERNET_INCORRECT_HANDLE_TYPE
                    pError = "El tipo de identificador suministrado es incorrecto para esta operación."
                Caso ERROR_INTERNET_INTERNAL_ERROR
                    pError = "Ha ocurrido un error interno."
                Caso ERROR_INTERNET_INVALID_URL
                    pError = "La URL no es válida."
                Caso ERROR_INTERNET_UNRECOGNIZED_SCHEME
                    pError = "El esquema de la URL es distinto de \x22http:\x22 o \x22https:\x22."
                Caso ERROR_INTERNET_SHUTDOWN
                    pError = "La ayuda de la función INTERNET se está cerrando o está fuera del alcance."
                Caso ERROR_NOT_ENOUGH_MEMORY
                    pError = "No hay suficiente memoria disponible para completar la operación solicitada."
                Caso ERROR_INTERNET_CANNOT_CONNECT
                    pError = "La conexión al servidor falló."
                Caso ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED
                    pError = "El servidor requiere autenticación de cliente SSL."
                Caso ERROR_INTERNET_CONNECTION_ERROR
                    pError = "Se ha restablecido o se ha finalizado la conexión con el servidor o se ha detectado un protocolo SSL incompatible."
                Caso ERROR_INTERNET_INCORRECT_HANDLE_STATE
                    pError = "La operación solicitada no se puede realizar porque el identificador suministrado no está en el estado correcto."
                Caso ERROR_INTERNET_LOGIN_FAILURE
                    pError = "El intento de inicio de sesión falló. Cuando se encuentra este error, el identificador de solicitud debe cerrarse con InternetCloseHandle."
                Caso ERROR_INTERNET_NAME_NOT_RESOLVED
                    pError = "No se puede resolver el nombre del servidor."
                Caso ERROR_INTERNET_RESPONSE_DRAIN_OVERFLOW
                    pError = "La respuesta entrante excede un tamaño límite interno."
                Caso ERROR_INTERNET_SECURE_FAILURE
                    pError = "Uno o más errores se encontraron en el certificado SSL enviado por el servidor."
                Caso ERROR_INTERNET_TIMEOUT
                    pError = "El tiempo de la solicitud se ha agotado."
                Caso ERROR_INVALID_PARAMETER
                    pError = "El parámetro es invalido"
                Caso ERROR_INTERNET_RESEND_REQUEST
                    pError = "La aplicación debe llamar HttpSendRequest de nuevo debido a un problema de redirección o la autenticación."
                Caso ERROR_INSUFFICIENT_BUFFER
                    pError = "Buffer insuficiente."
            FinSeleccionar
            SetLastError(0)
        FinProc

        Proc escribirServidor(dato:Cadena)
            pServidor = dato
        FinProc
        Proc leerServidor:Cadena
            Resultado = pServidor
        FinProc
        
        Proc escribirPuerto(dato:Word)
            pPuerto = dato
        FinProc
        Proc leerPuerto:Word
            Resultado = pPuerto
        FinProc

        Proc escribirAgente(dato:Cadena)
            pAgente = dato
            Si (pRequest) Entonces
                HttpAddRequestHeaders(pRequest, pAgente, -1, (HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD))
            FinSi
        FinProc
        Proc leerAgente:Cadena
            Resultado = pAgente
        FinProc

        Proc escribirMetodo(dato:Cadena)
            pMetodo = Mayúsculas(dato)
        FinProc
        Proc leerMetodo:Cadena
            Resultado = pMetodo
        FinProc

        Proc escribirDirección(dato:Cadena)
            pDirección = dato
        FinProc
        Proc leerDirección:Cadena
            Resultado = pDirección
        FinProc

        Proc escribirError(dato:Cadena)

        FinProc
        Proc leerError:Cadena
            Resultado = pError
        FinProc

        Proc escribirVersion(dato:Cadena)
            pVersion = dato
        FinProc
        Proc leerVersion:Cadena
            Resultado = pVersion
        FinProc

        Proc escribirStatusCode(dato:Entero)
            pStatusCode = dato
            SetStatusText
        FinProc
        Proc leerStatusCode:Entero
            Resultado = pStatusCode
        FinProc

        Proc escribirStatusText(dato:Cadena)
            pStatusText = dato
        FinProc
        Proc leerStatusText:Cadena
            Resultado = pStatusText
        FinProc

        Proc escribirTamañoPagina(dato:Entero)
            pTamañoPagina = dato
        FinProc
        Proc leerTamañoPagina:Entero
            Resultado = pTamañoPagina
        FinProc

    Sección Pública
        Prop Version:Cadena
            Lectura:leerVersion
            Escritura:escribirVersion
        FinProp

        Prop Agente:Cadena
            Lectura:leerAgente
            Escritura:escribirAgente
        FinProp

        Prop Servidor:Cadena
            Lectura:leerServidor
            Escritura:escribirServidor
        FinProp

        Prop Puerto:Word
            Lectura:leerPuerto
            Escritura:escribirPuerto
        FinProp

        Prop Metodo:Cadena
            Lectura:leerMetodo
            Escritura:escribirMetodo
        FinProp

        Prop Dirección:Cadena
            Lectura:leerDirección
            Escritura:escribirDirección
        FinProp

        Prop Error:Cadena
            Lectura:leerError
            Escritura:escribirError
        FinProp

        Prop StatusCode:Entero
            Lectura:leerStatusCode
            Escritura:escribirStatusCode
        FinProp

        Prop StatusText:Cadena
            Lectura:leerStatusText
            Escritura:escribirStatusText
        FinProp

        Prop TamañoPagina:Entero
            Lectura:leerTamañoPagina
            Escritura:escribirTamañoPagina
        FinProp

        Proc Conectar(Opcional Usuario:Cadena = Nulo, Opcional Contraseña:Cadena = Nulo):Booleano
            Si pServidor = "" Entonces
                Salir
            FinSi

            ppOpen = InternetOpen(pAgente, INTERNET_OPEN_TYPE_PRECONFIG, Nulo, Nulo, 0)

            Si (ppOpen) Entonces
                pConnect = InternetConnect(ppOpen, pServidor, pPuerto, Usuario, Contraseña, INTERNET_SERVICE_HTTP, 0, 0)
                Si (pConnect) Entonces
                    Devolver Verdad
                SiNo
                    SetError()
                    Devolver Falso
                FinSi
            SiNo
                Salir
            FinSi
        FinProc

        Proc Enviar():Entero
            Si (pConnect = 0) Entonces 
                Devolver Falso
            FinSi

            pRequest = HttpOpenRequest(pConnect, pMetodo, pDirección, pVersion, Nulo, Nulo, (INTERNET_FLAG_NO_COOKIES Or INTERNET_FLAG_NO_CACHE_WRITE), 0)

            Si (pRequest = 0) Entonces
                SetError
                Devolver Falso
            FinSi

            Si (pAgente != "") Entonces
                HttpAddRequestHeaders(pRequest, pAgente, -1, (HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD))
            FinSi

            Seleccionar pMetodo
                Caso "POST"
                    Content = "Content-Type: application/x-www-form-urlencoded"
                    Si CadLong(Parametros) <> 0 Entonces
                        Si HttpSendRequest(pRequest, Content, CadLong(Content), Parametros, CadLong(Parametros)) = Falso Entonces
                            SetError
                            Devolver Falso
                        FinSi
                    FinSi
                Caso "GET"
                    Si HttpSendRequest(pRequest, Nulo, 0, Nulo, 0) = Falso Entonces
                        SetError
                        Devolver Falso
                    FinSi
            FinSeleccionar

            QueryInfo = Espacio(1024)
            TamQueryInfo = CadLong(QueryInfo)
            HttpQueryInfo(pRequest, HTTP_QUERY_STATUS_CODE, StrPtr(QueryInfo), TamQueryInfo@, BufferSta@ )
            EsteObjeto.StatusCode = CadEnt(QueryInfo)

            QueryInfo = Espacio(1024)
            TamQueryInfo = CadLong(QueryInfo)
            HttpQueryInfo(pRequest, HTTP_QUERY_CONTENT_LENGTH, StrPtr(QueryInfo), TamQueryInfo@, BufferSta@ )
            EsteObjeto.TamañoPagina = CadEnt(QueryInfo)

            Resultado = Verdad
        FinProc

        Proc LeerRespuesta:Cadena
            Var control:Booleano
            Si (pRequest) Entonces
                control = Verdad
                Buffer = Espacio(400)
                Mientras control != Falso
                    InternetReadFile(pRequest, StrPtr(Buffer), 400, Lent@) 
                    Si Lent = Falso Entonces
                        control = Falso
                        SetError
                        Salir
                    FinSi
                    Resultado = Resultado + Buffer
                FinMientras
            FinSi
        FinProc

FinClase

'/**
' * Constantes para el HTTPRequest
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: Constantes.cml
' * ---------------------------------------
'*/

'Constantes HTTP
    Const INTERNET_OPEN_TYPE_PRECONFIG                   = 0
    Const INTERNET_OPEN_TYPE_DIRECT                      = 1
    Const INTERNET_OPEN_TYPE_PROXY                       = 3
    Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
    
    Const INTERNET_SERVICE_FTP    = 1
    Const INTERNET_SERVICE_GOPHER = 2
    Const INTERNET_SERVICE_HTTP   = 3

    Const INTERNET_INVALID_PORT_NUMBER = 0    ''
    Const INTERNET_DEFAULT_HTTP_PORT   = 80   ''
    Const INTERNET_DEFAULT_HTTPS_PORT  = 443  ''
    Const INTERNET_DEFAULT_FTP_PORT    = 21   ''
    Const INTERNET_DEFAULT_SOCKS_PORT  = 1080 ''

    Const INTERNET_FLAG_RELOAD         = &80000000
    Const INTERNET_FLAG_NO_CACHE_WRITE = &04000000
    Const INTERNET_FLAG_PRAGMA_NOCACHE = &00000100
    Const INTERNET_FLAG_NO_COOKIES     = &00080000
    Const INTERNET_FLAG_SECURE         = &00800000

    Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
    Const INTERNET_OPTION_SEND_TIMEOUT    = 5
    Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
    Const INTERNET_OPTION_SECURITY_FLAGS  = 31
    Const SECURITY_FLAG_IGNORE_UNKNOWN_CA = &100

    Const HTTP_ADDREQ_FLAG_ADD_IF_NEW              = &10000000
    Const HTTP_ADDREQ_FLAG_ADD                     = &20000000
    Const HTTP_ADDREQ_FLAG_COALESCE_WITH_COMMA     = &40000000
    Const HTTP_ADDREQ_FLAG_COALESCE_WITH_SEMICOLON = &01000000
    Const HTTP_ADDREQ_FLAG_REPLACE                 = &80000000

    Const HTTP_QUERY_STATUS_CODE      = 19
    Const HTTP_QUERY_STATUS_TEXT      = 20
    Const HTTP_QUERY_RAW_HEADERS      = 21
    Const HTTP_QUERY_RAW_HEADERS_CRLF = 22

    Const CONNECTION_TIMEOUT_MILLIS = 60000

    'Status'
        Const HTTP_STATUS_CONTINUE         = 100
        Const HTTP_STATUS_SWITCH_PROTOCOLS = 101

        Const HTTP_STATUS_OK              = 200
        Const HTTP_STATUS_CREATED         = 201
        Const HTTP_STATUS_ACCEPTED        = 202
        Const HTTP_STATUS_PARTIAL         = 203
        Const HTTP_STATUS_NO_CONTENT      = 204
        Const HTTP_STATUS_RESET_CONTENT   = 205
        Const HTTP_STATUS_PARTIAL_CONTENT = 206

        Const HTTP_STATUS_AMBIGUOUS          = 300
        Const HTTP_STATUS_MOVED              = 301
        Const HTTP_STATUS_REDIRECT           = 302
        Const HTTP_STATUS_REDIRECT_METHOD    = 303
        Const HTTP_STATUS_NOT_MODIFIED       = 304
        Const HTTP_STATUS_USE_PROXY          = 305
        Const HTTP_STATUS_REDIRECT_KEEP_VERB = 307

        Const HTTP_STATUS_BAD_REQUEST       = 400
        Const HTTP_STATUS_DENIED            = 401
        Const HTTP_STATUS_PAYMENT_REQ       = 402
        Const HTTP_STATUS_FORBIDDEN         = 403
        Const HTTP_STATUS_NOT_FOUND         = 404
        Const HTTP_STATUS_BAD_METHOD        = 405
        Const HTTP_STATUS_NONE_ACCEPTABLE   = 406
        Const HTTP_STATUS_PROXY_AUTH_REQ    = 407
        Const HTTP_STATUS_REQUEST_TIMEOUT   = 408
        Const HTTP_STATUS_CONFLICT          = 409
        Const HTTP_STATUS_GONE              = 410
        Const HTTP_STATUS_LENGTH_REQUIRED   = 411
        Const HTTP_STATUS_PRECOND_FAILED    = 412
        Const HTTP_STATUS_REQUEST_TOO_LARGE = 413
        Const HTTP_STATUS_URI_TOO_LONG      = 414
        Const HTTP_STATUS_UNSUPPORTED_MEDIA = 415
        Const HTTP_STATUS_RETRY_WITH        = 449

        Const HTTP_STATUS_SERVER_ERROR    = 500
        Const HTTP_STATUS_NOT_SUPPORTED   = 501
        Const HTTP_STATUS_BAD_GATEWAY     = 502
        Const HTTP_STATUS_SERVICE_UNAVAIL = 503
        Const HTTP_STATUS_GATEWAY_TIMEOUT = 504
        Const HTTP_STATUS_VERSION_NOT_SUP = 505
    'Status'

    'POST Header'
        Const HTTP_QUERY_ACCEPT                    = 24
        Const HTTP_QUERY_ACCEPT_CHARSET            = 25
        Const HTTP_QUERY_ACCEPT_ENCODING           = 26
        Const HTTP_QUERY_ACCEPT_LANGUAGE           = 27
        Const HTTP_QUERY_ACCEPT_RANGES             = 42
        Const HTTP_QUERY_AGE                       = 48
        Const HTTP_QUERY_ALLOW                     = 7
        Const HTTP_QUERY_AUTHORIZATION             = 28
        Const HTTP_QUERY_CACHE_CONTROL             = 49
        Const HTTP_QUERY_CONNECTION                = 23
        Const HTTP_QUERY_CONTENT_BASE              = 50
        Const HTTP_QUERY_CONTENT_DESCRIPTION       = 4
        Const HTTP_QUERY_CONTENT_DISPOSITION       = 47
        Const HTTP_QUERY_CONTENT_ENCODING          = 29
        Const HTTP_QUERY_CONTENT_ID                = 3
        Const HTTP_QUERY_CONTENT_LANGUAGE          = 6
        Const HTTP_QUERY_CONTENT_LENGTH            = 5
        Const HTTP_QUERY_CONTENT_LOCATION          = 51
        Const HTTP_QUERY_CONTENT_MD5               = 52
        Const HTTP_QUERY_CONTENT_RANGE             = 53
        Const HTTP_QUERY_CONTENT_TRANSFER_ENCODING = 2
        Const HTTP_QUERY_CONTENT_TYPE              = 1
        Const HTTP_QUERY_COOKIE                    = 44
        Const HTTP_QUERY_COST                      = 15
        Const HTTP_QUERY_CUSTOM                    = 65535
        Const HTTP_QUERY_DATE                      = 9
        Const HTTP_QUERY_DERIVED_FROM              = 14
        Const HTTP_QUERY_ECHO_HEADERS              = 73
        Const HTTP_QUERY_ECHO_HEADERS_CRLF         = 74
        Const HTTP_QUERY_ECHO_REPLY                = 72
        Const HTTP_QUERY_ECHO_REQUEST              = 71
        Const HTTP_QUERY_ETAG                      = 54
        Const HTTP_QUERY_EXPECT                    = 68
        Const HTTP_QUERY_EXPIRES                   = 10
        Const HTTP_QUERY_FORWARDED                 = 30
        Const HTTP_QUERY_FROM                      = 31
        Const HTTP_QUERY_HOST                      = 55
        Const HTTP_QUERY_IF_MATCH                  = 56
        Const HTTP_QUERY_IF_MODIFIED_SINCE         = 32
        Const HTTP_QUERY_IF_NONE_MATCH             = 57
        Const HTTP_QUERY_IF_RANGE                  = 58
        Const HTTP_QUERY_IF_UNMODIFIED_SINCE       = 59
        Const HTTP_QUERY_LAST_MODIFIED             = 11
        Const HTTP_QUERY_LINK                      = 16
        Const HTTP_QUERY_LOCATION                  = 33
        Const HTTP_QUERY_MAX                       = 78
        Const HTTP_QUERY_MAX_FORWARDS              = 60
        Const HTTP_QUERY_MESSAGE_ID                = 12
        Const HTTP_QUERY_MIME_VERSION              = 0
        Const HTTP_QUERY_ORIG_URI                  = 34
        Const HTTP_QUERY_PRAGMA                    = 17
        Const HTTP_QUERY_PROXY_AUTHENTICATE        = 41
        Const HTTP_QUERY_PROXY_AUTHORIZATION       = 61
        Const HTTP_QUERY_PROXY_CONNECTION          = 69
        Const HTTP_QUERY_PUBLIC                    = 8
        Const HTTP_QUERY_RANGE                     = 62
        Const HTTP_QUERY_RAW_HEADERS               = 21
        Const HTTP_QUERY_RAW_HEADERS_CRLF          = 22
        Const HTTP_QUERY_REFERER                   = 35
        Const HTTP_QUERY_REFRESH                   = 46
        Const HTTP_QUERY_REQUEST_METHOD            = 45
        Const HTTP_QUERY_RETRY_AFTER               = 36
        Const HTTP_QUERY_SERVER                    = 37
        Const HTTP_QUERY_SET_COOKIE                = 43
        Const HTTP_QUERY_STATUS_CODE               = 19
        Const HTTP_QUERY_STATUS_TEXT               = 20
        Const HTTP_QUERY_TITLE                     = 38
        Const HTTP_QUERY_TRANSFER_ENCODING         = 63
        Const HTTP_QUERY_UNLESS_MODIFIED_SINCE     = 70
        Const HTTP_QUERY_UPGRADE                   = 64
        Const HTTP_QUERY_URI                       = 13
        Const HTTP_QUERY_USER_AGENT                = 39
        Const HTTP_QUERY_VARY                      = 65
        Const HTTP_QUERY_VERSION                   = 18
        Const HTTP_QUERY_VIA                       = 66
        Const HTTP_QUERY_WARNING                   = 67
        Const HTTP_QUERY_WWW_AUTHENTICATE          = 40
    'POST Header'

    Const INTERNET_ERROR_BASE                    = 12000                     ''
    Const ERROR_INTERNET_TIMEOUT                 = (INTERNET_ERROR_BASE + 2) ''
    Const ERROR_INTERNET_INTERNAL_ERROR          = (INTERNET_ERROR_BASE + 4) ''
    Const ERROR_INTERNET_INVALID_URL             = (INTERNET_ERROR_BASE + 5) ''
    Const ERROR_INTERNET_UNRECOGNIZED_SCHEME     = (INTERNET_ERROR_BASE + 6) ''
    Const ERROR_INTERNET_NAME_NOT_RESOLVED       = (INTERNET_ERROR_BASE + 7) ''
    Const ERROR_INTERNET_SHUTDOWN                = (INTERNET_ERROR_BASE + 12) ''
    Const ERROR_INTERNET_LOGIN_FAILURE           = (INTERNET_ERROR_BASE + 15) ''
    Const ERROR_INTERNET_OPERATION_CANCELLED     = (INTERNET_ERROR_BASE + 17) ''
    Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE   = (INTERNET_ERROR_BASE + 18) ''
    Const ERROR_INTERNET_INCORRECT_HANDLE_STATE  = (INTERNET_ERROR_BASE + 19) ''
    Const ERROR_INTERNET_CANNOT_CONNECT          = (INTERNET_ERROR_BASE + 29) ''
    Const ERROR_INTERNET_CONNECTION_ERROR        = (INTERNET_ERROR_BASE + 30) ''
    Const ERROR_INTERNET_RESEND_REQUEST          = (INTERNET_ERROR_BASE + 32) ''
    Const ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED = (INTERNET_ERROR_BASE + 44) ''
    Const ERROR_INTERNET_SECURE_FAILURE          = (INTERNET_ERROR_BASE + 175) ''
    Const ERROR_INTERNET_RESPONSE_DRAIN_OVERFLOW = (INTERNET_ERROR_BASE + 184) ''
    Const ERROR_INVALID_PARAMETER                = 87                         ''
    Const ERROR_NOT_ENOUGH_MEMORY                = 8                          ''
    Const ERROR_INSUFFICIENT_BUFFER              = 122
'Constantes HTTP

'/**
' * APIS para el HTTP Request
' *
' * @author  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: APIS.cml
' * ---------------------------------------
'*/

'APIS HTTP'
    API InternetOpen(sAgent:Cadena, lAccessType:Entero, sProxyName:Cadena, sProxyBypass:Cadena, lFlags:Entero):Entero, "wininet.dll" "InternetOpenA"
    API InternetConnect(hInternetSession:Entero, sServerName:Cadena, nServerPort:Entero, sUsername:Cadena, sPassword:Cadena, lService:Entero, lFlags:Entero, lContext:Entero):Entero, "wininet.dll" "InternetConnectA"
    API InternetCloseHandle(hInet:Entero):Entero, "wininet.dll"
    API InternetQueryDataAvailable(hHttpRequest:Entero, lNumberOfBytesAvailable:Entero, lFlags:Entero, lContext:Entero):Entero, "wininet.dll"
    API InternetReadFile(hFile:Entero, sBuffer:Entero, lNumBytesToRead:Entero, lNumberOfBytesRead:Entero):Entero, "wininet.dll"
    API InternetQueryOption(hHttpRequest:Entero, dwOption:Entero, lpBuffer:Entero, dwBufferLength:Entero):Entero, "wininet.dll" "InternetQueryOptionA"
    API InternetSetOption(hHttpRequest:Entero, dwOption:Entero, lpBuffer:Entero, dwBufferLength:Entero):Entero, "wininet.dll" "InternetSetOptionA" 
    API HttpOpenRequest(hHttpSession:Entero, sVerb:Cadena, sObjectName:Cadena, sVersion:Cadena, sReferer:Cadena, sAcceptTypes:Cadena, lFlags:Entero, lContext:Entero):Entero, "wininet.dll" "HttpOpenRequestA"
    API HttpAddRequestHeaders(hHttpRequest:Entero, sHeaders:Cadena, lHeadersLength:Entero, lModifiers:Entero):Entero, "wininet.dll" "HttpAddRequestHeadersA"
    API HttpSendRequest(hHttpRequest:Entero, sHeaders:Cadena, lHeadersLength:Entero, sOptional:Cadena, lOptionalLength:Entero):Entero, "wininet.dll" "HttpSendRequestA"
    API HttpQueryInfo(hHttpRequest:Entero, lInfoLevel:Entero, lBuffer:Entero, lBufferLength:Entero, lIndex:Entero), "wininet.dll" "HttpQueryInfoA"
    API HttpEndRequest(hHttpRequest:Entero, lpBuffersOut:Entero, dwFlags:Entero, dwContext:Entero):Entero, "wininet.dll" "HttpEndRequestA" 
'APIS HTTP'

Importar "Cramel.cml"
Importar "MSVBVM60\MSVBVM60.cml"
Importar "Constantes.cml"
Importar "APIS.cml"
Importar "HTTPRequest.cml"

Var request:HTTP
Var text:Cadena

Crear request
    request.Metodo = "POST"
    request.Parametros = "test=Hola"
    request.Puerto = INTERNET_DEFAULT_HTTP_PORT
    request.Servidor = "localhost"
    request.Dirección = "/index.php"
    request.Agente = "CramelRequest [POST]"

    Si ( request.Conectar ) Entonces
        Si ( request.Enviar ) Entonces
            text = request.LeerRespuesta
            Si ( request.StatusCode = HTTP_STATUS_NOT_FOUND ) Entonces
                Mensaje("La dirección es incorrecta")
            SiNo
                Mensaje(EntCad(request.StatusCode) + CRLF + request.StatusText + CRLF + "Tamaño de respuesta: " + EntCad(request.TamañoPagina) + CRLF + text)
            FinSi
        SiNo
            Mensaje(request.Error)
        FinSi
    SiNo
        Mensaje(request.Error)
    FinSi

Destruir request

'/**
' * AdminFinder
' *
' * @by         @79137913
' * @Ported by  Jovani Pérez Damián (@BlackBlex)
' *
' * ==============Information==============
' *      Filename: AdminFinder.cml
' * ---------------------------------------
'*/

Importar "Cramel.cml"
Importar "MSVBVM60\MSVBVM60.cml"
Importar "Constantes.cml"
Importar "APIS.cml"
Importar "Archivo.cml"
Importar "Consola.cml"
Importar "HTTPRequest.cml"

Var cmd:Consola
Var archivoC:ArchivoC

Var controlArchivo:Booleano

Var paths[], pathsFound:Cadena
Var contenido, salida:Cadena

Crear archivoC
    archivoC.abrir("paths.txt", GENERIC_READ, OPEN_EXISTING)
    Si ( archivoC.conseguirPtr <> INVALID_HANDLE ) Entonces
        contenido = archivoC.leer()
        paths = Separar(contenido, CRLF)
        controlArchivo = Verdad
    SiNo
        Mensaje("El archivo paths.txt no existe, favor de crearlo y poner su lista separada por linea")
        controlArchivo = Falso
    FinSi
    archivoC.cerrar()
Destruir archivoC

Var objetivo:Cadena
Var correcto:Booleano
correcto = Falso

Si ( controlArchivo ) Entonces
    Crear cmd
        cmd.establecerTitulo("AdminFinder by 79137913 ~ Ported to Cramel Console by BlackBlex")
        cmd.escribirLinea(CRLF + "    /=======================\\")
        cmd.escribirLinea("      Paths encontrados:" + EntCad(&paths))
        cmd.escribirLinea("    \\=======================/" + CRLF)
        Mientras correcto = Falso
            cmd.escribir("(No incluya el http:// al inicio, ni el / al final)" + CRLF + "Ingrese el destino: ")
            objetivo = cmd.leer
            Si ( Buscar(objetivo, "http://") = Falso ) Entonces
                correcto = Verdad
            FinSi
        FinMientras
        Si ( correcto ) Entonces        
            Si ( buscarObjetivos ) Entonces
                cmd.limpiarConsola()
                cmd.escribirLinea(CRLF)
                cmd.escribirLinea("  URLS encontradas: ")
                cmd.escribir(pathsFound + CRLF)
                cmd.pausarConsola()
            SiNo
                cmd.limpiarConsola()
                cmd.escribirLinea(CRLF)
                cmd.escribirLinea("  No se encontro ninguna url" + CRLF)
                cmd.pausarConsola()
            FinSi
        FinSi
    Destruir cmd
FinSi

Proc buscarObjetivos:Booleano
    cmd.escribirLinea("  Examinando...")
    Var request:HTTP
    Var text:Cadena
    Var id:Entero
    Resultado = Falso
    Crear request
        id = 0
        Contar id a &paths Paso 1
            request.Metodo = "GET"
            request.Puerto = INTERNET_DEFAULT_HTTP_PORT
            request.Servidor = objetivo
            request.Dirección = "/" + paths[id]
            request.Agente = "RequestTest [GET]"

            Si ( request.Conectar ) Entonces
                Si ( request.Enviar ) Entonces
                    cmd.escribir("    http://" + request.Servidor + request.Dirección + " ~ Estado: ")
                    Si ( request.StatusCode = HTTP_STATUS_OK ) Entonces
                        cmd.escribirLinea("[OK]")
                        pathsFound = pathsFound + "    http://" + request.Servidor + request.Dirección + CRLF
                        Resultado = Verdad
                    SiNo
                        cmd.escribirLinea("[FAILED]")
                    FinSi
                FinSi
            FinSi
        Seguir
    Destruir request
    Pausar(2500)
FinProc

Importar "Cramel.cml"
Importar "MSVBVM60\MSVBVM60.cml"
Importar "Interfaz\Interfaz.cml"

Var frame, frameNuevo:CMLframe
Var botonExaminar, botonNuevo:CMLBotón
Var checkboxReemplazar:CMLCheckbox
Var grupoReemplazar:CMLGroupbox
Var radioReemplazar, radioNoReemplazar:CMLRadiobotón
Var etiquetaElección, etiquetaProgreso, etiquetaNuevo:CMLEtiqueta
Var comboboxOpciones:CMLCombobox
Var barraProgresoTest, barraProgresoMarquee, barraProgresoVertical:CMLBarraprogreso
Var cajaTextoPrueba, cajaTextoContra:CMLCajatexto
Var listViewTest:CMLListview

Proc alertaMensaje(hWnd:Entero)
    Mensaje("Holaa " + EntCad(hWnd))
FinProc

Proc alertaBotonExaminar(hWnd:Entero,Botón:Byte,Presionado:Booleano,X,Y:Entero)
    Seleccionar Botón
        Caso BOTON_IZQUIERDO
            Seleccionar Presionado
                Caso Falso
                    Mensaje("Botón izquierdo presionado")
                    Mensaje("El checkbox esta: " + EntCad(checkboxReemplazar.estaSeleccionado) )
            FinSeleccionar
        Caso BOTON_DERECHO
            Seleccionar Presionado
                Caso Falso
                    Mensaje("Botón derecho presionado")
                    Mensaje(cajaTextoPrueba.cTexto)
                    cajaTextoPrueba.Limite = 20
                    cajaTextoPrueba.agrTexto = " agregado"
            FinSeleccionar
        Caso BOTON_CENTRAL
            Seleccionar Presionado
                Caso Falso
                    Mensaje("Botón central presionado")
                    Mensaje("Carácter: " + Carácter(cajaTextoContra.ContraseñaCaracter))
            FinSeleccionar
    FinSeleccionar
FinProc

Proc alertaComboBox(hWnd:Entero, Referencia Item:GUI_COMBOBOX_ITEM_INFO)
    Mensaje("Item #" + EntCad(Item.Posición) + " seleccionado: " + Item.Item)
FinProc

Proc listViewTestEventClic(hWnd:Entero,Botón:Byte,Presionado:Booleano,X,Y:Entero,Referencia ItemInfo:GUI_LISTVIEW_ITEM_INFO)
    Seleccionar Botón
        Caso BOTON_DERECHO, BOTON_IZQUIERDO
            Seleccionar Presionado
                Caso Verdad
                    Mensaje("Posición: " + EntCad(ItemInfo.Columna) + CRLF + "Item: " + EntCad(ItemInfo.Item))
            FinSeleccionar
    FinSeleccionar
FinProc

Crear frame
Crear frameNuevo
Crear botonExaminar
Crear botonNuevo
Crear grupoReemplazar
Crear checkboxReemplazar
Crear radioReemplazar
Crear radioNoReemplazar
Crear etiquetaElección
Crear etiquetaProgreso
Crear etiquetaNuevo
Crear comboboxOpciones
Crear barraProgresoTest
Crear barraProgresoMarquee
Crear barraProgresoVertical
Crear cajaTextoPrueba
Crear cajaTextoContra
Crear listViewTest

    frame.Texto = "CMLFrame clase"
    frame.Ancho = 400
    frame.Alto = 400
    frame.Padre = 0
    frame.Centrar = 1
    'frame.eventos.Cargar@ = alertaMensaje@
    frame.construir(WS_OVERLAPPED+WS_CAPTION+WS_SYSMENU)

    frameNuevo.Texto = "2do Frame"
    frameNuevo.Ancho = 550
    frameNuevo.Alto = 400
    frameNuevo.Padre = 0
    frameNuevo.Centrar = Verdad
    frameNuevo.construir(WS_OVERLAPPED+WS_CAPTION+WS_SYSMENU)

    etiquetaElección.Texto = "\x191Qué quieres hacer?"
    etiquetaElección.PosX  = 10
    etiquetaElección.PosY  = 10
    etiquetaElección.Ancho = 150
    etiquetaElección.Alto  = 30
    etiquetaElección.Padre = frame.hWnd
    etiquetaElección.construir()

    etiquetaNuevo.Texto = "Hola :D"
    etiquetaNuevo.PosX  = 10
    etiquetaNuevo.PosY  = 10
    etiquetaNuevo.Ancho = frameNuevo.Ancho - 30
    etiquetaNuevo.Alto  = 20
    etiquetaNuevo.Padre = frameNuevo.hWnd
    etiquetaNuevo.fuente.Nombre = "Roboto light"
    etiquetaNuevo.fuente.Tamaño = 14
    etiquetaNuevo.fuente.Bold = Verdad
    etiquetaNuevo.construir(ES_CENTER)

    listViewTest.PosX  = 10
    listViewTest.PosY  = (etiquetaNuevo.PosY + etiquetaNuevo.Alto) + 5
    listViewTest.Ancho = frameNuevo.Ancho - 30
    listViewTest.Alto  = (frameNuevo.Alto - listViewTest.PosY) - 50
    listViewTest.Padre = frameNuevo.hWnd
    listViewTest.fuente.Nombre = "Arial"
    listViewTest.fuente.Tamaño = 11
    listViewTest.eventos.ListView.Clic@ = listViewTestEventClic@
    listViewTest.construir()

    Var listColumnas[]:INFO_COLUMNA
    ReDim listColumnas, 5

    listColumnas[0].Indice   = 0
    listColumnas[0].Ancho    = (listViewTest.Ancho/5)
    listColumnas[0].Posición = LVCFMT_LEFT
    listColumnas[0].Texto    = "Nombre"

    listColumnas[1].Indice   = 1
    listColumnas[1].Ancho    = (listViewTest.Ancho/5)
    listColumnas[1].Posición = LVCFMT_CENTER
    listColumnas[1].Texto    = "Dirección IP"

    listColumnas[2].Indice   = 2
    listColumnas[2].Ancho    = (listViewTest.Ancho/5)
    listColumnas[2].Posición = LVCFMT_CENTER
    listColumnas[2].Texto    = "Usuario@Host"

    listColumnas[3].Indice   = 3
    listColumnas[3].Ancho    = (listViewTest.Ancho/5)
    listColumnas[3].Posición = LVCFMT_CENTER
    listColumnas[3].Texto    = "SO"

    listColumnas[4].Indice   = 4
    listColumnas[4].Ancho    = (listViewTest.Ancho/5)
    listColumnas[4].Posición = LVCFMT_CENTER
    listColumnas[4].Texto    = "País@Idioma"

    listViewTest.insertarColumnas(listColumnas)

    Var listItems:INFO_ITEM
    ReDim listItems.Texto, 5

    listItems.Texto[0] = "Test"
    listItems.Texto[1] = "Test1"
    listItems.Texto[2] = "Test2"
    listItems.Texto[3] = "Test3"
    listItems.Texto[4] = "Test4"
    listItems.Indice   = 0

    Var listItems2:INFO_ITEM
    ReDim listItems2.Texto, 5

    listItems2.Texto[0] = "Test2"
    listItems2.Texto[1] = "Test21"
    listItems2.Texto[2] = "Test22"
    listItems2.Texto[3] = "Test23"
    listItems2.Texto[4] = "Test24"
    listItems2.Indice   = 1

    listViewTest.insertarItem(listItems)
    listViewTest.insertarItem(listItems2)

    comboboxOpciones.PosX = 170
    comboboxOpciones.PosY = 10
    comboboxOpciones.Ancho = 150
    comboboxOpciones.Alto = 20
    comboboxOpciones.Padre = frame.hWnd
    comboboxOpciones.eventos.ComboBox.Selección@ = alertaComboBox@
    comboboxOpciones.construir(CBS_DROPDOWNLIST)

    comboboxOpciones.agregarItem("Hola")
    comboboxOpciones.agregarItem("\x191Como estas?")
    comboboxOpciones.agregarItem("Bien")
    comboboxOpciones.agregarItem("Genial")
    comboboxOpciones.agregarItem("y tu??")
    comboboxOpciones.agregarItem("Bien, igual")
    comboboxOpciones.agregarItem("Que padre")

    botonExaminar.Texto = "Examinar"
    botonExaminar.PosX  = 10
    botonExaminar.PosY  = 30
    botonExaminar.Ancho = 100
    botonExaminar.Alto  = 50
    botonExaminar.Padre = frame.hWnd
    botonExaminar.eventos.Mouse.Clic@ = alertaBotonExaminar@
    botonExaminar.construir()

    botonNuevo.Texto = "Nueva ventana"
    botonNuevo.PosX  = 10
    botonNuevo.PosY  = 300
    botonNuevo.Ancho = 100
    botonNuevo.Alto  = 50
    botonNuevo.Padre = frame.hWnd
    botonNuevo.eventos.Mouse.Clic@ = nuevaVentana@
    botonNuevo.construir()

    checkboxReemplazar.Texto = "Reemplazar archivo"
    checkboxReemplazar.PosX  = 10
    checkboxReemplazar.PosY  = 90
    checkboxReemplazar.Ancho = 200
    checkboxReemplazar.Alto  = 30
    checkboxReemplazar.Padre = frame.hWnd
    checkboxReemplazar.Deshabilitado = Verdad
    checkboxReemplazar.construir()

    grupoReemplazar.Texto = "Opciones"
    grupoReemplazar.PosX  = 10
    grupoReemplazar.PosY  = 130
    grupoReemplazar.Ancho = 270
    grupoReemplazar.Alto  = 50
    grupoReemplazar.Padre = frame.hWnd
    grupoReemplazar.construir()

        radioReemplazar.Texto = "Reemplazar archivo"
        radioReemplazar.PosX  = 20
        radioReemplazar.PosY  = 145
        radioReemplazar.Ancho = 110
        radioReemplazar.Alto  = 30
        radioReemplazar.Padre = frame.hWnd
        radioReemplazar.construir()

        radioNoReemplazar.Texto = "No reemplazar archivo"
        radioNoReemplazar.PosX  = 140
        radioNoReemplazar.PosY  = 145
        radioNoReemplazar.Ancho = 130
        radioNoReemplazar.Alto  = 30
        radioNoReemplazar.Padre = frame.hWnd
        radioNoReemplazar.construir()

    grupoReemplazar.cerrar()

    barraProgresoTest.PosX  = 10
    barraProgresoTest.PosY  = 190
    barraProgresoTest.Ancho = 150
    barraProgresoTest.Alto  = 30
    barraProgresoTest.Padre = frame.hWnd
    barraProgresoTest.construir()
    barraProgresoTest.empezar(ProgresoBarra@)
    
    etiquetaProgreso.Texto = "0 %"
    etiquetaProgreso.PosX  = 10
    etiquetaProgreso.PosY  = 230
    etiquetaProgreso.Ancho = 150
    etiquetaProgreso.Alto  = 30
    etiquetaProgreso.Padre = frame.hWnd
    etiquetaProgreso.construir(SS_CENTER)

    barraProgresoMarquee.PosX  = 170
    barraProgresoMarquee.PosY  = 190
    barraProgresoMarquee.Ancho = 150
    barraProgresoMarquee.Alto  = 30
    barraProgresoMarquee.Padre = frame.hWnd
    barraProgresoMarquee.construir(PBS_MARQUEE)
    barraProgresoMarquee.Marquee = 20

    barraProgresoVertical.PosX  = 330
    barraProgresoVertical.PosY  = 70
    barraProgresoVertical.Ancho = 30
    barraProgresoVertical.Alto  = 150
    barraProgresoVertical.Padre = frame.hWnd
    barraProgresoVertical.construir(PBS_VERTICAL)
    barraProgresoVertical.empezar(ProgresoBarraVertical@)

    cajaTextoPrueba.Texto = "Holaa"
    cajaTextoPrueba.PosX  = 10
    cajaTextoPrueba.PosY  = 270
    cajaTextoPrueba.Ancho = 150
    cajaTextoPrueba.Alto  = 20
    cajaTextoPrueba.Padre = frame.hWnd
    cajaTextoPrueba.construir()

    cajaTextoPrueba.Limite = 10

    cajaTextoContra.Texto = "Password"
    cajaTextoContra.PosX  = 170
    cajaTextoContra.PosY  = 270
    cajaTextoContra.Ancho = 150
    cajaTextoContra.Alto  = 20
    cajaTextoContra.Padre = frame.hWnd
    cajaTextoContra.construir(ES_PASSWORD)
    cajaTextoContra.ContraseñaCaracter = ASCII("+")

    frame.mostrar()
    'Pausar(2500)
    'Mensaje("Cambio")
    'etiquetaElección.cambiarTexto("Groo")
    frame.correr()

Proc nuevaVentana NoResultado
    frameNuevo.mostrar()
    frameNuevo.correr()
FinProc

Proc ProgresoBarra():Entero NoResultado
    Var rango:PBRANGE
    Var i:Entero
    rango = barraProgresoTest.Rango
    Mientras i <= rango.iHigh
        barraProgresoTest.Progreso = i
        'etiquetaProgreso.cambiarTexto(EntCad(barraProgresoTest.Progreso) + " %")
        Pausar(50)
        i = i + 1
    FinMientras
    barraProgresoMarquee.MarqueeStop
FinProc

Proc ProgresoBarraVertical():Entero NoResultado
    Var rango:PBRANGE
    Var i:Entero
    rango = barraProgresoVertical.Rango
    Mientras i <= rango.iHigh
        barraProgresoVertical.Progreso = i
        Pausar(150)
        i = i + 1
    FinMientras
FinProc

Destruir listViewTest
Destruir cajaTextoContra
Destruir cajaTextoPrueba
Destruir barraProgresoVertical
Destruir barraProgresoMarquee
Destruir barraProgresoTest
Destruir comboboxOpciones
Destruir etiquetaNuevo
Destruir etiquetaProgreso
Destruir etiquetaElección
Destruir radioNoReemplazar
Destruir radioReemplazar
Destruir checkboxReemplazar
Destruir grupoReemplazar
Destruir botonNuevo
Destruir botonExaminar
Destruir frameNuevo
Destruir frame

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
    <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
        <assemblyIdentity
            version="1.0.0.0"
            processorArchitecture="X86"
            name="CramelFrame"
            type="win32"
        />
        <description></description>
        <dependency>
        <dependentAssembly>
        <assemblyIdentity
            type="win32"
            name="Microsoft.Windows.Common-Controls"
            version="6.0.0.0"
            processorArchitecture="X86"
            publicKeyToken="6595b64144ccf1df"
            language="*"
        />
        </dependentAssembly>
    </dependency>
</assembly>