pero como que estilos quieres de tipo flash de letras medio raras o de ese tipo con colores y eso
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes MenúCita de: yalosabes en 14 Febrero 2006, 04:58 AMPues parecio que te quisieras ameritar los creditos porque primero lo dijiste que lo sacaste de una pagina de microsoft y despues k tu le agregaste los shapes
copie el texto completamente de canal visual basic, sin embargo me parecio bueno ponerlo en este foro, porque podria ser de utilidad para alguien, o estoy ekivokado?
CitarYo le agreguè una barra de progreso pero no usando el Progressbar , sino mediante 2 Shapetu se lo agregaste o MAS BIEN querras decir la copiaste de canal visual basic
Cita de: pisagatos en 13 Febrero 2006, 19:18 PMy de paso tambien me confundiste a miCitarsi TU Tienes un antivirus con antiespam en TU computadora de nada te va a servir en hotmail ya que se ejecuta en EL SERVIDOR debido a que el WEBMAIL, no se baja a TU pc por eso no sirve TU antispam que esta en TU pc.
a menos de que tenga contratada la de 2 gigas.
Ostras se me paso eso, es verdad, lo siento, lo del anti-spam no sirve, tienes que hacerlo manualmetne desde la web como te dice jvchino
Option Explicit
Private mvarIPDestino As String
Private mvarLongitudDatos As Long
Private mvarTimeOut As Long
Private mvarEstado As Long
Private mvarDescripcion As String
Private mvarTiempo As Long
Private Const IP_STATUS_BASE = 11000
Private Const IP_SUCCESS = 0
Private Const IP_BUF_TOO_SMALL = (11000 + 1)
Private Const IP_DEST_NET_UNREACHABLE = (11000 + 2)
Private Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)
Private Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)
Private Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)
Private Const IP_NO_RESOURCES = (11000 + 6)
Private Const IP_BAD_OPTION = (11000 + 7)
Private Const IP_HW_ERROR = (11000 + 8)
Private Const IP_PACKET_TOO_BIG = (11000 + 9)
Private Const IP_REQ_TIMED_OUT = (11000 + 10)
Private Const IP_BAD_REQ = (11000 + 11)
Private Const IP_BAD_ROUTE = (11000 + 12)
Private Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)
Private Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)
Private Const IP_PARAM_PROBLEM = (11000 + 15)
Private Const IP_SOURCE_QUENCH = (11000 + 16)
Private Const IP_OPTION_TOO_BIG = (11000 + 17)
Private Const IP_BAD_DESTINATION = (11000 + 18)
Private Const IP_ADDR_DELETED = (11000 + 19)
Private Const IP_SPEC_MTU_CHANGE = (11000 + 20)
Private Const IP_MTU_CHANGE = (11000 + 21)
Private Const IP_UNLOAD = (11000 + 22)
Private Const IP_ADDR_ADDED = (11000 + 23)
Private Const IP_GENERAL_FAILURE = (11000 + 50)
Private Const MAX_IP_STATUS = 11000 + 50
Private Const IP_PENDING = (11000 + 255)
Private Const PING_TIMEOUT = 200
Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
'estructuras
Private Type ICMP_OPTIONS
Ttl As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type
Private ICMPOPT As ICMP_OPTIONS
Private Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
DataPointer As Long
Options As ICMP_OPTIONS
Data As String * 250
End Type
Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type
Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
(ByVal IcmpHandle As Long) As Long
Private Declare Function IcmpSendEcho Lib "icmp.dll" _
(ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, _
ByVal RequestData As String, ByVal RequestSize As Integer, _
ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, _
ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Private Declare Function WSAGetLastError Lib "wsock32.dll" () As Long
Private Declare Function WSAStartup Lib "wsock32.dll" _
(ByVal wVersionRequired As Long, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Function HiByte(ByVal wParam As Integer)
HiByte = wParam \ &H100 And &HFF&
End Function
Private Function LoByte(ByVal wParam As Integer)
LoByte = wParam And &HFF&
End Function
Public Function SocketsCleanup() As Boolean
Dim X As Long
X = WSACleanup()
If X <> 0 Then
SocketsCleanup = False
Else
SocketsCleanup = True
End If
End Function
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSAdata
Dim X As Integer
Dim szLoByte As String, szHiByte As String, szBuf As String
X = WSAStartup(WS_VERSION_REQD, WSAD)
If X <> 0 Then
MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."
SocketsInitialize = False
Exit Function
End If
If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
szHiByte = Trim$(Str$(HiByte(WSAD.wVersion)))
szLoByte = Trim$(Str$(LoByte(WSAD.wVersion)))
szBuf = "Windows Sockets Version " & szLoByte & "." & szHiByte
szBuf = szBuf & " is not supported by Windows " & _
"Sockets for 32 bit Windows environments."
MsgBox szBuf, vbExclamation
SocketsInitialize = False
Exit Function
End If
If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
szBuf = "This application requires a minimum of " & _
Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
MsgBox szBuf, vbExclamation
SocketsInitialize = False
Exit Function
End If
SocketsInitialize = True
End Function
Public Sub ping(dwAddress As Long)
Dim hPort As Long
Dim sDataToSend As String
Dim iOpt As Long
Dim ECHO As ICMP_ECHO_REPLY
Dim res As Boolean
res = SocketsInitialize
If res Then
sDataToSend = String$(mvarLongitudDatos, "A")
hPort = IcmpCreateFile()
If IcmpSendEcho(hPort, dwAddress, sDataToSend, Len(sDataToSend), _
0, ECHO, Len(ECHO), mvarTimeOut) Then
mvarEstado = 0
mvarTiempo = ECHO.RoundTripTime
Else
mvarTiempo = 0
mvarEstado = Abs(ECHO.status)
If mvarEstado = 0 Then mvarEstado = IP_GENERAL_FAILURE
End If
Call IcmpCloseHandle(hPort)
res = SocketsCleanup
Else
mvarEstado = IP_GENERAL_FAILURE
mvarTiempo = 0
End If
mvarDescripcion = GetStatusCode(mvarEstado)
End Sub
Private Function GetStatusCode(status As Long) As String
Dim msg As String
Select Case status
Case IP_SUCCESS: msg = ""
Case IP_BUF_TOO_SMALL: msg = "buffer demasiado pequeño"
Case IP_DEST_NET_UNREACHABLE: msg = "red de destino no encontrada"
Case IP_DEST_HOST_UNREACHABLE: msg = "host destino no encontrado"
Case IP_DEST_PROT_UNREACHABLE: msg = "dest prot unreachable"
Case IP_DEST_PORT_UNREACHABLE: msg = "puerto destino no encontrado"
Case IP_NO_RESOURCES: msg = "sin recursos"
Case IP_BAD_OPTION: msg = "opción inválida"
Case IP_HW_ERROR: msg = "error hardware"
Case IP_PACKET_TOO_BIG: msg = "paquete demasiado grande"
Case IP_REQ_TIMED_OUT: msg = "timeout"
Case IP_BAD_REQ: msg = "respuesta incorrecta"
Case IP_BAD_ROUTE: msg = "ruta inválida"
Case IP_TTL_EXPIRED_TRANSIT: msg = "ttl finalizado"
Case IP_TTL_EXPIRED_REASSEM: msg = "ttl expired reassem"
Case IP_PARAM_PROBLEM: msg = "error en parámetros"
Case IP_SOURCE_QUENCH: msg = "source quench"
Case IP_OPTION_TOO_BIG: msg = "opción demasiado grande"
Case IP_BAD_DESTINATION: msg = "destino incorrecto"
Case IP_ADDR_DELETED: msg = "addr deleted"
Case IP_SPEC_MTU_CHANGE: msg = "spec mtu change"
Case IP_MTU_CHANGE: msg = "ip mtu_change"
Case IP_UNLOAD: msg = "unload"
Case IP_ADDR_ADDED: msg = "addr added"
Case IP_GENERAL_FAILURE: msg = "fallo general"
Case IP_PENDING: msg = "pendiente"
Case PING_TIMEOUT: msg = "ping timeout"
Case Else: msg = "recibido mensaje desconocido"
End Select
GetStatusCode = msg
End Function
Public Property Get Tiempo() As Long
Tiempo = mvarTiempo
End Property
Public Property Get Descripcion() As String
Descripcion = mvarDescripcion
End Property
Public Property Get Estado() As Long
Estado = mvarEstado
End Property
Public Property Let Timeout(ByVal vData As Long)
mvarTimeOut = vData
If mvarTimeOut < 1 Then mvarTimeOut = 1
End Property
Public Property Get Timeout() As Long
Timeout = mvarTimeOut
End Property
Public Property Let LongitudDatos(ByVal vData As Long)
mvarLongitudDatos = vData
If mvarLongitudDatos > 250 Then mvarLongitudDatos = 250
If mvarLongitudDatos < 1 Then mvarLongitudDatos = 1
End Property
Public Property Get LongitudDatos() As Long
LongitudDatos = mvarLongitudDatos
End Property
Public Property Let IPDestino(ByVal vData As String)
mvarIPDestino = vData
End Property
Public Property Get IPDestino() As String
IPDestino = mvarIPDestino
End Property
Private Sub Class_Initialize()
mvarLongitudDatos = 32
mvarTimeOut = 4000
End Sub
Public CANCELAR As Boolean
Public SumaTiempo As Long
Public cfg_PACKCOUNT As Integer
Public INFO_RECIEN As Boolean
Public Enum eSEMAFORO
ROJO = 0
AMARILLO = 1
VERDE = 2
End Enum
Public Type Hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Option Explicit
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Dim ping As cPing
Private Sub cmdCancel_Click()
CANCELAR = True
cmdCancel.Enabled = False
End Sub
Private Sub cmdConfig_Click()
Dim X As Integer
If cmdConfig.Caption = "Config >>" Then
cmdConfig.Caption = "Ocultar"
For X = Me.Height To 3345 Step 50
Me.Height = X
Me.Refresh
Next X
Else
cmdConfig.Caption = "Config >>"
For X = Me.Height To 1710 Step -50
Me.Height = X
Me.Refresh
Next X
End If
End Sub
Private Sub Command1_Click()
Dim dwAddress As Long, IPDestino As String
Dim cont As Integer, exCaption As String
Dim hHostent As Hostent, AddrList As Long
Dim lpWSAdata As WSAdata
Unload Form_info
If txtIp = "" Then Exit Sub
ActualizarValores
Command1.Enabled = False
exCaption = Me.Caption
Me.Caption = "Resolviendo Host..."
IPDestino = txtIp
CANCELAR = False
cmdCancel.Enabled = True
Semaforo AMARILLO
Call WSAStartup(&H101, lpWSAdata)
If GetHostByName(IPDestino + String(64 - Len(IPDestino), 0)) <> -1 Then
CopyMemory hHostent.h_name, ByVal GetHostByName(IPDestino + String(64 - Len(IPDestino), 0)), Len(hHostent)
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory dwAddress, ByVal AddrList, 4
End If
Form_info.lblPorcen.ForeColor = vbBlack
Form_info.lblTpor(0).ForeColor = Form_info.lblPorcen.ForeColor
SumaTiempo = 0
If dwAddress = 0 Then
MsgBox "No hay ruta al host " & txtIp, vbCritical, "Error"
Me.Caption = exCaption
Semaforo ROJO
Command1.Enabled = True
txtIp.SetFocus
Exit Sub
End If
Call WSACleanup
Form_info.lblTotal = "0 de " & cfg_PACKCOUNT
Form_info.lblSize = ping.LongitudDatos & " bytes"
Form_info.lblLost = "0"
Form_info.lblRecv = "0"
Form_info.lblTime = ping.Timeout & " ms"
Form_info.Show
Me.Caption = "Haciendo Ping..."
For cont = 1 To cfg_PACKCOUNT
Form_info.lblTotal = "Haciendo ping " & cont & " de " & cfg_PACKCOUNT
DoEvents
Me.Refresh
If CANCELAR Then Exit For
ping.ping (dwAddress)
If ping.Estado = 0 Then
Form_info.lblRecv = Val(Form_info.lblRecv) + 1
Form_info.lstPing.AddItem "Ping " & cont & vbTab & "Tiempo: " & ping.Tiempo & " ms"
SumaTiempo = SumaTiempo + ping.Tiempo
Else
Form_info.lblLost = Val(Form_info.lblLost) + 1
Form_info.lstPing.AddItem "Ping " & cont & vbTab & "Falló"
End If
Form_info.lstPing.ListIndex = Form_info.lstPing.ListCount - 1
Form_info.lblPorcen = Round((Val(Form_info.lblRecv) / cont) * 100, 0) & "%"
If Val(Form_info.lblRecv) > 0 Then Form_info.lblProm = Round(SumaTiempo / Val(Form_info.lblRecv), 2) & " Ms"
Semaforo (IIf(ping.Estado = 0, VERDE, ROJO))
Me.Refresh
Next cont
Form_info.lblTotal = IIf(CANCELAR, "CANCELADO", "FINALIZADO")
Form_info.lblPorcen.ForeColor = IIf(cfg_PACKCOUNT = Val(Form_info.lblRecv), &H8000&, vbRed)
Form_info.lstPing.AddItem String(34, "-")
Form_info.lstPing.ListIndex = Form_info.lstPing.ListCount - 1
Me.Caption = exCaption
Command1.Enabled = True
cmdCancel.Enabled = False
End Sub
Private Sub Semaforo(LIGHT_ON As eSEMAFORO)
Dim i As Byte, aColor(0 To 2) As Long
aColor(0) = &HFF&
aColor(1) = &HFFFF&
aColor(2) = &HFF00&
For i = 0 To 2
Shape1(i).FillColor = IIf(i = LIGHT_ON, aColor(i), &HC0C0C0)
Next i
End Sub
Private Sub Form_Activate()
txtIp.SetFocus
End Sub
Private Sub Form_Load()
Me.Height = 1710
Set ping = New cPing
Semaforo ROJO
INFO_RECIEN = True
cmdCancel.Enabled = False
cfg_PACKCOUNT = Val(txtCant)
ping.LongitudDatos = Val(txtSize)
ping.Timeout = Val(txtTime)
End Sub
Private Sub salir_Click()
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub txtCant_KeyPress(KeyAscii As Integer)
Tratar KeyAscii
End Sub
Private Sub txtCant_LostFocus()
If Val(txtCant) < 1 Then txtCant = 1
ActualizarValores
End Sub
Private Sub txtIp_GotFocus()
txtIp.SelStart = 0
txtIp.SelLength = Len(txtIp)
End Sub
Private Sub txtSize_LostFocus()
If Val(txtSize) < 1 Then txtSize = 32
If Val(txtSize) > 250 Then txtSize = 250
ActualizarValores
End Sub
Private Sub txtTime_LostFocus()
If Val(txtTime) < 1 Then txtTime = 1
ActualizarValores
End Sub
Private Sub txtSize_KeyPress(KeyAscii As Integer)
Tratar KeyAscii
End Sub
Private Sub txtTime_KeyPress(KeyAscii As Integer)
Tratar KeyAscii
End Sub
Private Sub Tratar(ByRef KeyAscii As Integer)
If (KeyAscii < vbKey0 Or KeyAscii > vbKey9) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub ActualizarValores()
cfg_PACKCOUNT = Val(txtCant)
ping.Timeout = Val(txtTime)
ping.LongitudDatos = Val(txtSize)
End Sub
Option Explicit
Dim finX As Integer, finY As Integer
Private Sub cerrar_Click()
Unload Me
End Sub
Private Sub Form_Activate()
Dim X As Integer, Y As Integer
Dim startX As Integer, startY As Integer
If INFO_RECIEN Then
INFO_RECIEN = False
startY = Me.Width
For Y = startY To finY Step 100
Me.Width = Y
Me.Height = Y
Me.Refresh
Next Y
startX = Me.Height
For X = startX To finX Step 100
Me.Height = X
Me.Refresh
Next X
End If
End Sub
Private Sub Form_Load()
Me.Top = Form_ping.Top
Me.Left = Form_ping.Left + Form_ping.Width
If Not INFO_RECIEN Then Exit Sub
finX = Me.Height
finY = Me.Width
Me.Height = 0
Me.Width = 0
End Sub
Private Sub lblPorcen_Click()
End Sub
Private Sub lstPing_Click()
End Sub
Cita de: pisagatos en 12 Febrero 2006, 14:32 PM
puedes aplicar un filtro desde hotmail o desde cualquier anti-spam que lleve incluido un antivirus e ir redireccionado a esa direccion y dejara de llegarte el spañ
Cita de: novato117 en 10 Febrero 2006, 15:22 PMyo tengo el norton systemworks 2006 y me funciona perfectamente
pues no se si ya lo solucionaste, pero si tienes un buen antivirus, es ovio que no te funcione el c@@gle, por que es un programa que esta creado como un troyano. mas bien utiliza el CRACK DOWN. ese si te lo recomiendo. es el que yo uso.
Cita de: SmopuiM en 10 Febrero 2006, 08:59 AMCita de: fireByte en 6 Febrero 2006, 16:34 PM
jajaja te felicito mi hermano se la comio con ese link... que absurdo la gente como tu haciendonos daños entre nosotros mismos... poniendo enlaces con virus deberian sensurarte..
No mames toooooodas las paginas de cracks seriales y todas esas tienen.