Mensajes

hola para esos casos se utiliza una comunicacion DDE miren este articulo de como se hace

http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/161-dde.htm

hola puedes compara el tamaño por lo general un pendrive es mayor a 1457664 bytes y es "FAT" esto mas que nada para ver si esta el disco puesto (la disquetera)

Código [Seleccionar] Expandir


Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Long, lpTotalNumberOfBytes As Long, lpTotalNumberOfFreeBytes As Long) As Long


Private Sub RecuperarDiscoExtraible()
Dim strSave As String
Dim Drive As String
Dim Removible As String
Dim totalbytes As Long
Dim FSName As String

strSave = String(255, Chr$(0))

ret& = GetLogicalDriveStrings(255, strSave)

For keer = 1 To 100
    If Left$(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then Exit For
    Drive = Left$(strSave, InStr(1, strSave, Chr$(0)) - 1)

    If GetDriveType(Drive) = 2 Then
        Removible = Drive
        FSName = String$(255, Chr$(0))
   
        GetVolumeInformation Removible, 255, 255, 255, 0, 0, FSName, 255
     
        FSName = Left$(FSName, InStr(1, FSName, Chr$(0)) - 1)
   
        Call GetDiskFreeSpaceEx(Removible, 255, totalbytes, 255)
        If totalbytes <> 1457664 And FSName = "FAT" Then Me.Print Drive
    End If

    strSave = Right$(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))
Next keer

End Sub




Private Sub Form_Load()
Me.AutoRedraw = True
Call RecuperarDiscoExtraible
End Sub



Saludos

yo no lo prove con un pendrive sino con un celular pero supongo que es lo mismo

Gracias pero es raro tiene que aver alguna forma de obtenerlo sin nesidad de hacer una peticion web , osea si ipconfig /all te la devuelve  tiene que aver una forma no?

a la ip publica es a la que le llaman ip wan?

no no noes facil creo que no me entendiste, no dije ip privada dije IP ""PUBLICA"", se que este codigo lo tira pero me tira otras ip mas el tema es aislar es ip publica y como no tengo router para provar no se como hacerlo esdecir mi ip privada y mi ip publica son iguales.

al fin alguien con el mismo problema , mire yo e echo millones de prueva y es cierto lo que dice wACtOr , supongan que esta todo bien programado, osea estan los index del winsock, se envia una orden y se espera una respuesta, etc.
pero el problema es que supongamos que el index 0 estan enviando una video el cual dura 5 minutos en transferirce o en recivirce, mientrastanto con el index 1  enviamos otra cosa,  esta ultima no llega a donde deberia,o bien el index 2 , por lo que yo creo es un problema de punteros en la memoria , creo que visual basic queda chico para estas cosas. puede ser?? , alquien que la tenga realmente clara nos puede dar una explicacion?

Repito esta bien programado, pero parece ser que si los index estan trabjando al mismo tiempo no todos responden.

Buenas se que quienes tienen Router el winsock no devuelve la ip publica, yo en mi caso como no tengo router no se como hacerlo, pero me gustaria saber como se puede conseguir la ip publica sin tener que recurrir a una web. (estoy ablando de hacerlo por codigo)

bien un amigo me paso este ejemplo

Código [Seleccionar] Expandir


'In Module1:

'******************************************************************
'Created By Verburgh Peter.
' 07-23-2001
' verburgh.peter@skynet.be
'-------------------------------------
'With this small application , you can detect the IP's installed on your computer,
'including subnet mask , BroadcastAddr..
'
'I've wrote this because i've a programm that uses the winsock control, but,
'if you have multiple ip's  installed on your pc , you could get by using the Listen
' method the wrong ip ...
'Because Winsock.Localip => detects the default ip installed on your PC ,
' and in most of the cases it could be the LAN (nic) not the WAN (nic)
'So then you have to use the Bind function ,to bind to your right ip..
'but how do you know & find that ip ?
'you can find it now by this appl.. it check's in the api.. IP Table..
'******************************************************************


Const MAX_IP = 5   'To make a buffer... i dont think you have more than 5 ip on your pc..

Type IPINFO
     dwAddr As Long   ' IP address
    dwIndex As Long '  interface index
    dwMask As Long ' subnet mask
    dwBCastAddr As Long ' broadcast address
    dwReasmSize  As Long ' assembly size
    unused1 As Integer ' not currently used
    unused2 As Integer '; not currently used
End Type

Type MIB_IPADDRTABLE
    dEntrys As Long   'number of entries in the table
    mIPInfo(MAX_IP) As IPINFO  'array of IP address entries
End Type

Type IP_Array
    mBuffer As MIB_IPADDRTABLE
    BufferLen As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Sub main()
Form1.Show
End Sub

'converts a Long  to a string
Public Function ConvertAddressToString(longAddr As Long) As String
    Dim myByte(3) As Byte
    Dim Cnt As Long
    CopyMemory myByte(0), longAddr, 4
    For Cnt = 0 To 3
        ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
    Next Cnt
    ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function

Public Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE



On Error GoTo END1
    GetIpAddrTable ByVal 0&, Ret, True

    If Ret <= 0 Then Exit Sub
    ReDim bBytes(0 To Ret - 1) As Byte
    'retrieve the data
    GetIpAddrTable bBytes(0), Ret, False
     
    'Get the first 4 bytes to get the entry's.. ip installed
    CopyMemory Listing.dEntrys, bBytes(0), 4
    'MsgBox "IP's found : " & Listing.dEntrys    => Founded ip installed on your PC..
    Form1.AutoRedraw = True
    Form1.Print Listing.dEntrys & "   IP addresses found on your PC !!"
    Form1.Print "----------------------------------------"
    For Tel = 0 To Listing.dEntrys - 1
        'Copy whole structure to Listing..
       ' MsgBox bBytes(tel) & "."
        CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
         Form1.Print "IP address                   : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)
         Form1.Print "IP Subnetmask            : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask)
         Form1.Print "BroadCast IP address  : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr)
         Form1.Print "**************************************" & vbCrLf
         Form1.Refresh
    Next

'MsgBox ConvertAddressToString(Listing.mIPInfo(1).dwAddr)
Exit Sub
END1:
MsgBox "ERROR"
End Sub


Código [Seleccionar] Expandir


Private Sub Form_Load()
Module1.Start
End Sub

en su caso le aparecio en la tercera posicion su ip publica
alguno de los que tengan un router se anima a ver si puede obtener unicamente esa ip

Gracias y saludos

aca hay otro codigo parecido, aver si este muestra la ip publica
http://www.recursosvisualbasic.com.ar/htm/listado-api/api-55-ip-GetIpAddrTable.htm

hola te paso un ejemplo

En un modulo

Código [Seleccionar] Expandir


Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As Any) As Long

Private Enum FOF_Flags
        FOF_MULTIDESTFILES = &H1
        FOF_CONFIRMMOUSE = &H2
        FOF_SILENT = &H4
        FOF_RENAMEONCOLLISION = &H8
        FOF_NOCONFIRMATION = &H10
        FOF_WANTMAPPINGHANDLE = &H20
        FOF_ALLOWUNDO = &H40
        FOF_FILESONLY = &H80
        FOF_SIMPLEPROGRESS = &H100
        FOF_NOCONFIRMMKDIR = &H200
        FOF_NOERRORUI = &H400
        FOF_NOCOPYSECURITYATTRIBS = &H800
        FOF_NORECURSION = &H1000
        FOF_NO_CONNECTED_ELEMENTS = &H2000
        FOF_WANTNUKEWARNING = &H4000
End Enum

Private Enum FO_Functions
        FO_MOVE = &H1
        FO_COPY = &H2
        FO_DELETE = &H3
        FO_RENAME = &H4
End Enum

Private Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As FO_Functions
        pFrom As String
        pTo As String
        fFlags As FOF_Flags
        fAnyOperationsAborted As Long
        hNameMappings As Long
End Type

Public Function TransferFileToRecycleBin(Filename As String, Optional Confirm As Boolean = False, Optional Silent As Boolean = True) As Boolean
    Dim FileOp As SHFILEOPSTRUCT
   
    With FileOp
        .wFunc = FO_DELETE
        .pFrom = Filename
        .fFlags = True

        If Not Confirm Then .fFlags = .fFlags + FOF_NOCONFIRMATION
        If Silent Then .fFlags = .fFlags + FOF_SILENT
    End With
    TransferFileToRecycleBin = SHFileOperation(FileOp)
End Function



y para provar en un formulario con un boton

Código [Seleccionar] Expandir


Private Sub Command1_Click()
TransferFileToRecycleBin "C:\prueva.txt", True, False
End Sub


fijate si le modificas el ultimo parametro a true vas aver el formulario de progreso

Que mala onda que tienen, si alguien viene al foro por primera ves ylo tratan asi, no creo que quiera volver con la batallada que le pegaron.
ademas si nadie save lo que quiso preguntar porque le dan con un caño?. creo que fue vastante cortes el tipo no?

hola ami tambien me suele pasar que al conectar con un sitio se me cuelga , la unica solucion es ir guardando, pero me lo hace unas 4 o  5 veces despues no se cuelga mas asi anda guarando todo lo que agas hasta que no se cuelgue mas (igual segui guardando)

Saludos

Oye el ocx esta muy guapo lo estoy probando y al parecer es tuyo truena cuando agrego mas de 3 controles no hay manera de que muestres el code del ocx para anlizarlo

hola si se supone que va uno solo, si pones mas de uno explota, y ademas no es nesesario mas de uno ya que este tomara todos los controles, si abres otro formulario vasta con hacer lo siguiente

Private Sub Form_Activate()
ToolTips1.ShowToolTips Me
ToolTips1.ColorStar = vbblue
ToolTips1.ColorEnd = vbred
End Sub

en enlos demas form los mismo

Private Sub Form_Activate()
Form1.ToolTips1.ShowToolTips Me
Form1.ToolTips1.ColorStar = vbWhite
Form1.ToolTips1.ColorEnd = &HFF8080
End Sub

sirempre refiriendose al formulario en el cual esta el tooltips

por lo que decias del si tienen el visual basic instalado , pues estamos en un foro de visual basic asi que supongo que si no?, a pero talves tienes razón este link lo puse en uno de programacion mmm quizas si.
bueno voy a subir el source a esta recursosvisualbasic asi vemos que puede ser.
Saludos