Mensajes

[SourceCode Multiproposito]

.
Entonces entendi mal... Deseas hacer un servidor web (SourceCode Multiproposito) no?... si es asi lo hubieras dicho antes xP.. esa libreria seria una buena base para este objetivo!¡.

Dulce Lunas!¡.

.
Actualise los parametros de ScanX, se ve mejor en la pagina:

Código [Seleccionar] Expandir



arametro Obligatorio Descripción
IP NO DNS/IP Destinatario (Dejar en blanco para escanearse a si mismo)
Port SI Indica el Puerto Destinatario
NoHtml NO Indica si se desea usar Html ( Default = 0 )
# Parametros: 0 = Desactiva la opcion
# 1 = Resultados Sin HTML
# 2 = Resultados Sin HTML y con muestra solo el Codigo de error
# 3 = Resultados Sin HTML y con muestra el Codigo de error y su descripcion (El Codigo de Error esta separado de su descripcion por "--->".)
# Returns: -1 = Error de Rango de Puertos
# 0 = Error de Conexion
# 1 = Conexion Satisfecha
MyIPAddres NO Si se activa este parametro solo Mostra la IP en texto Plano
# Parametros: 0 = Desactiva la opcion
# 1 = Activar la Opcion



Asique para obtener tu dirreicón IP sería ai:

http://infrangelux.sytes.net/ScanX/?myipaddres=1

Código (Vb) [Seleccionar] Expandir



Option Explicit

'=========Wininet Api========
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_OPEN_TYPE_PROXY  As Long = 3
Private Const INTERNET_FLAG_RELOAD      As Long = &H80000000

Private Sub CSocket_Close()
   Call CSocket.Close
   Call CSocket.Listen
End Sub

Private Sub CSocket_ConnectionRequest(ByVal requestID As Long)
   Call CSocket.Close
   Call CSocket.Accept(requestID)
End Sub

Private Sub CSocket_DataArrival(ByVal bytesTotal As Long)
Dim sData               As String
   Call CSocket.GetData(sData)
   Debug.Print sData
End Sub

Private Sub Form_Load()
   CSocket.LocalPort = 200
   CSocket.Listen
   Debug.Print GetConnection("http://infrangelux.sytes.net/ScanX/?nohtml=2&port=200&msg=Prueba")
End Sub


Function GetConnection(ByVal sUrl As String) As String
Dim hOpen As Long, hFile As Long, sBuffer As String, Ret As Long
   sBuffer = Space(1000)
   hOpen = InternetOpen("VB6", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
   hFile = InternetOpenUrl(hOpen, sUrl, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
   Do
       InternetReadFile hFile, sBuffer, 1000, Ret
       GetConnection = GetConnection & Left(sBuffer, Ret)
       If Ret = 0 Then Exit Do
   Loop
   InternetCloseHandle hFile
   InternetCloseHandle hOpen
End Function

Private Sub CSocket_Error(ByVal Number As Integer, Description As String, ByVal sCode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
   Debug.Print Description
End Sub



Dulce Infienro Lunar!¡.

.
Sin ofenderte pero esto ya esta creado, y no pongas Limite de Experiencia, si será un proyecto OpenSource es mejor desarrollarlo en grupo comunitario sin denigrar a nadie...

Aqui lo tienes es un Parser del protocolo Http 1.1. Hace TODO lo que tu has puesto... y mas!¡.

http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Protocolos&file=Http%201.1%20Protocol.zip

Asi se usa!¡.

Código (Vb) [Seleccionar] Expandir



Sub Main()
Dim req As IHttpMessage
Set req = New IHttpMessage
s = "GET /PAGE.HTM?QUERYSTRING&=TRUE HTTP/1.1" & VBCRLF & _
    "HOST:127.0.0.1" & VBCRLF & _
    "USER-AGENT: VBIMMEDIATEWINDOW"
req.tostring = s
print req.tostring
print req.header.field(Protocol)
Set req = Nothing
End Sub



Dulce Infierno Lunar!¡.

lo primero que te recomendaria es verificar si se puede conectar a esa pc porque puede que estes detras de un router, o el firewal o antivirus bloque los puertos

de seguro que es el router

create un  server ponelo a la escucha e intenta conectar desde otro lado

lo podes hacer con el sitio de BlackZeroX

http://infrangelux.sytes.net/ScanX/

PD: Muy bueno BlackZeroX esa pagina yo hace rato quize hacer eso pero ningun servidor me permitio utilzar los sokets en puertos que no sea el 80, en que esta en linux o windows?, estaria bueno que agas un tipo api, para testear este tipo de problemas como el de ZERO, osea la pagina deberia retornar un OK o ERROR, algo bien pelado osea sin ningun html

mira esto...:

http://infrangelux.sytes.net/ScanX/?ip=www.google.com.mx&NoHtml=0&port=800&msg=texto a enviar
http://infrangelux.sytes.net/ScanX/?ip=www.google.com.mx&NoHtml=1&port=800&msg=texto a enviar
http://infrangelux.sytes.net/ScanX/?ip=www.google.com.mx&NoHtml=2&port=800&msg=texto a enviar
http://infrangelux.sytes.net/ScanX/?ip=www.google.com.mx&NoHtml=3&port=800&msg=texto a enviar

Los parametros estan aquí:

http://infrangelux.sytes.net/ScanX/

Dulce Infierno Lunar!¡.
.

[Novecientos noventa y nueve Octillónes novecientos noventa y nueve Sextillónes novecientos noventa y nueve Quintillónes novecientos noventa y nueve Cuatrillónes novecientos noventa y nueve Trillones novecientos noventa y nueve Billones novecientos noventa y nueve Mil novecientos noventa y nueve Millones novecientos noventa y nueve Mil novecientos noventa y nueve]

.
El siguiente codigo me costo un Ojo de la cara... es para convertir cualquier Numero a Texto Plano. lo hice por Hobby mas que por nesesidad, espero le saquen provecho!¡.

Como maximo mumero que puede leer son es: 999999999999999999999999999999

Novecientos noventa y nueve Octillónes novecientos noventa y nueve Sextillónes novecientos noventa y nueve Quintillónes novecientos noventa y nueve Cuatrillónes novecientos noventa y nueve Trillones novecientos noventa y nueve Billones novecientos noventa y nueve Mil novecientos noventa y nueve Millones novecientos noventa y nueve Mil novecientos noventa y nueve

Billon          10^12       <--( 5 ).
Trillon         10^18       <--( 4 ).
Cuatrillón      10^24       <--( 3 ).
Quintillón      10^30       <--( 2 ).
Sextillón       10^36       <--( 1 ).
Octillón        10^42       <--( 0 ).
<--Obviamente Los siguientes numeros no los tomaremos en cuenta-->
Gúgol           10^100      <--(-1 ).
Googolplex      10^10^Gúgol <--(-2 ).


http://infrangelux.sytes.net/Blog/index.php?option=com_content&view=article&id=8:arrtnum2string&catid=2:catprocmanager&Itemid=8

Código (Vb) [Seleccionar] Expandir


'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Public Function Number2String(ByVal VInNumber As String) As String
'   //  Meximo  --> 999999999999999999999999999999 ' sección Octillón...
'   //  Billon          10^12       <--( 5 ).
'   //  Trillon         10^18       <--( 4 ).
'   //  Cuatrillón      10^24       <--( 3 ).
'   //  Quintillón      10^30       <--( 2 ).
'   //  Sextillón       10^36       <--( 1 ).
'   //  Octillón        10^42       <--( 0 ).
'   //  <--Obviamente Los siguientes numeros no los tomaremos en cuenta-->
'   //  Gúgol           10^100      <--(-1 ).
'   //  Googolplex      10^10^Gúgol <--(-2 ).
Dim Str_Temp                            As String
Dim Byt_Index                           As Byte
Dim Byt_Digito                          As Byte
Dim Byt_Centena                         As Byte
Dim Byt_Decena                          As Byte
Dim Byt_Unidad                          As Byte
Dim Str_Leyenda                         As String
Dim lng_LenStr                          As Long
Const clng_MaxLen = &H1E

    lng_LenStr = Len(VInNumber)
    If lng_LenStr > clng_MaxLen Or lng_LenStr = 0 Then Exit Function
    Str_Temp = String$(clng_MaxLen, "0")
    Mid(Str_Temp, clng_MaxLen - lng_LenStr + 1) = Mid$(VInNumber, 1, lng_LenStr)

    For Byt_Index = 1 To clng_MaxLen / 3

        Byt_Centena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 2, 1))
        Byt_Decena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 1, 1))
        Byt_Unidad = CByte(Mid$(Str_Temp, Byt_Index * 3, 1))

        Select Case Byt_Index
            Case 1
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Octillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Octillónes "
                End If
            Case 2
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Sextillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Sextillónes "
                End If
            Case 3
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Quintillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Quintillónes "
                End If
            Case 4
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Cuatrillón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Cuatrillónes "
                End If
            Case 5
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Trillon "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Trillones "
                End If
            Case 6
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Billón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Billones "
                End If
            Case 7
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 And Val(Mid$(Str_Temp, 21, 3)) = 0 Then
                    Str_Leyenda = "Mil Millones "
                ElseIf Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then
                    Str_Leyenda = "Mil "
                End If
            Case 8
                If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
                    Str_Leyenda = "Millón "
                ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
                    Str_Leyenda = "Millones "
                End If
            Case 9
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = "Mil "
            Case 10
                If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = ""
        End Select
        Number2String = Number2String + Centena(Byt_Unidad, Byt_Decena, Byt_Centena) + Decena(Byt_Unidad, Byt_Decena) + Unidad(Byt_Unidad, Byt_Decena) + Str_Leyenda
        Str_Leyenda = ""
    Next

End Function

Private Function Centena(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte, ByVal Byt_Centena As Byte) As String
    Select Case Byt_Centena
        Case 1: If Byt_Decimal + Byt_Uni = 0 Then Centena = "cien " Else Centena = "ciento "
        Case 2: Centena = "doscientos "
        Case 3: Centena = "trescientos "
        Case 4: Centena = "cuatrocientos "
        Case 5: Centena = "quinientos "
        Case 6: Centena = "seiscientos "
        Case 7: Centena = "setecientos "
        Case 8: Centena = "ochocientos "
        Case 9: Centena = "novecientos "
    End Select
End Function

Private Function Decena(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
    Select Case Byt_Decimal
        Case 1
            Select Case Byt_Uni
                Case 0: Decena = "diez "
                Case 1: Decena = "once "
                Case 2: Decena = "doce "
                Case 3: Decena = "trece "
                Case 4: Decena = "catorce "
                Case 5: Decena = "quince "
                Case 6 To 9: Decena = "dieci "
            End Select
        Case 2
            If Byt_Uni = 0 Then
                Decena = "veinte "
            ElseIf Byt_Uni > 0 Then
                Decena = "veinti "
            End If
        Case 3: Decena = "treinta "
        Case 4: Decena = "cuarenta "
        Case 5: Decena = "cincuenta "
        Case 6: Decena = "sesenta "
        Case 7: Decena = "setenta "
        Case 8: Decena = "ochenta "
        Case 9: Decena = "noventa "
    End Select
    If Byt_Uni > 0 And Byt_Decimal > 2 Then Decena = Decena + "y "
End Function

Private Function Unidad(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
    If Byt_Decimal <> 1 Then
        Select Case Byt_Uni
            Case 1: Unidad = "un "
            Case 2: Unidad = "dos "
            Case 3: Unidad = "tres "
            Case 4: Unidad = "cuatro "
            Case 5: Unidad = "cinco "
        End Select
    End If
    Select Case Byt_Uni
            Case 6: Unidad = "seis "
            Case 7: Unidad = "siete "
            Case 8: Unidad = "ocho "
            Case 9: Unidad = "nueve "
    End Select
End Function



Dulce Infierno Lunar!¡.

[SetTcpEntry]

.
pues eso es para CERRAR CUALQUIER puerto que desees de cualquier puerto, y esactamente ashy solo se pone el estado... pero en si aun hay no se cierra se cierra hasta que se pasa la estructura ya configurada en la api SetTcpEntry cuando se pasa la estrucra a esta api se actualiza la informacion]!¡.

Se me ocurre que el programa que abrio el puerto debera de volver a abrirlo den su forma habitual... o quisas tambien solo cambia el estado... no es gran cosas hay trae una numeracion de los estados disponibles de los Socket.

Ducle Lunas!¡.

.
y asi?

Código (Vb) [Seleccionar] Expandir



  DetectorHumano = DetectorHumano + 1
  If DetectorHumano > val(Text3.Text) Then



si quieres esperar X tiempo puedes usar esto:

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Option Explicit

Private Declare Function WaitMessage Lib "user32" () As Long

Enum eTime
   Horas = 3600
   Minutos = 60
   Segundos = 1
End Enum

Public Sub Wait(ByVal vToWait&, Optional ByVal ThisWait As eTime = Segundos, Optional ByVal UseAllProc As Boolean = False)
Dim vDateE      As Date
   vDateE = DateAdd("s", vToWait& * (ThisWait + 0), Time)
   Do While vDateE > Time
       Call WaitMessage
       If Not UseAllProc Then DoEvents
   Loop
End Sub



Dulce Lunas!¡.

[@azul27]

.
@azul27

Has oido hablar de las estaciones de radio en internet?... has visto los videos de youtube, Megavideo?.. eso es Streeming.

Si escribes en google "define: Streaming" te apararecera esto... es solo cosa de saber Google.

Streaming

Código [Seleccionar] Expandir



El streaming consiste en la distribución de audio o vídeo por internet. La palabra "streaming" se refiere a que se trata de una corriente contínua (sin interrupción). El usuario puede escuchar o ver en el momento que quiera. No es necesario estar suscrito para escuchar o ver. ...



PAra que te des una idea de como se usa se crean buffers y se mandan Sin execepcion y sin espera de cola SOLO se mandan... jamas se verifica nada (No estoy muy seguro como trabajen las estaciones de radio Grandes como EXE[/n], este modo... ). en pocas palabras el Streaming es para no tocar el HD y al momento de resivir los datos "instantaneamente" (Obviamente no es instantaneo pero no encontre otra palabra) tratar los datos sin espera... solo creando un buffer de los mismo y hay prosesarlos AUN CUANDO NO ESTEN TODOS.

Dulce Infierno Lunar!¡.!¡.

pz miren lo hize de esta forma:

Código [Seleccionar] Expandir

adoConsulta.RecordSource = "SELECT tipocomprobante,serie,cod_comprobante,fecha,razon,des_servicio,identificador,login,password,fechainicio,fechafin,cod_proveedor, MAX(fecha) FROM vistaFactura WHERE (cod_tipodeservicio=2)and(identificador IS NOT NULL) AND (anulado = 'No') AND identificador like'" & txtDominio.Text & "%' group by razon, identificador"
    adoConsulta.Refresh
y nada me bota error : column 'vistaFactura.tipocomprobante'is invalid en the select list because it is not
contained in either an aggregate function or the group by clause.

segun tu mensaje de error dice que en vistaFactura no hay un campo razon... o algo asi dice tu mensaje de error tampoco es para ser mago!¡.

Dulce Lunas!¡.

.
Enviale un MP a "TyFa" es de este foro ( Participdemasiado en este subforo mde vb6 ) ella s eme hace una buena candidata para que preguntes sobre SQL Query... muchos de aqui estamos mas orientados a vb6 puro... y de SQL no sabremos mucho pero siempre esta la indagación en un tema propuesto.

UN CONSEJO para que tu programa sea mas moldeale y dejes a tu jefe contento... crea otro campo, tabla que se yo donde guardes el nombre de las columnas (Obviamente por separado), con su descripción, esto será muy bueno en un futuro, dejando a expancion la BDD... ya tu APP.

ID, CAMPO, DESCRIPCIÓN

Dulce Lunas!¡.