Mensajes

Muy bueno Red Mx   Tambien esta muy bueno tu diseño grafico, sigue asi!


Sancho.Mazorka   

Una vez resolvio una duda mia      

Slasher-K pasara a ser una leyenda en VB6

Volve man! 

PD: Soplo sabes algo de el 



Sancho.Mazorka     

Para vos coco:

Código [Seleccionar] Expandir

Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

DeleteFile Ruta+Archivo+Extension


Sancho.Mazorka   

1 Timer1 (Interval = 50, Enabled = False)
1 Picture1

Nunca lo finalizes desde el STOP del Visual Basic porque se cuelga todo, ya que no libera la WebCam, para eso puse el QueryUnload

Código [Seleccionar] Expandir

'API's para el manejo de imagen
Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As Long, ByVal nID As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function PrintWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long

'Constantes de API avicapture
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000

'Handle de la WebCam
Private mCapHwnd As Long

Private Sub Form_Load()
mCapHwnd = capCreateCaptureWindow("BetterCam", WS_CHILD Or WS_VISIBLE, 0, 0, 320, 240, Picture1.hWnd, 0)
SendMessage mCapHwnd, CONNECT, 0, 0
Timer1.Enabled = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Timer1.Enabled = False
SendMessage mCapHwnd, DISCONNECT, 0, 0
End Sub

Private Sub Timer1_Timer()
SendMessage mCapHwnd, GET_FRAME, 0, 0
PrintWindow mCapHwnd, Picture1.hdc, 0
End Sub

Espero que te sirva 


Sancho.Mazorka   

Yo busque tambien para ver si habia algo mas, pero es lo unico que encontre, siempre usan el mismo manual



Sancho.Mazorka   

Lionheart para que no haya este tipo de inconvenientes, le puse una ayuda al modulo. Ahora paso a explicarte cada uno de esos ejemplos. 

Código [Seleccionar] Expandir

AgregarIcono Handle, Icono, ToolTipText
'En Handle, ponemos el Handle de quien lo solicita, en general es Me.hWnd
'En Icono, ponemos el icono que va a estar en el SysTray, generalmente Me.Icon
'En ToolTipText, va el texto que va a mostrar el icono cuando nos posemos sobre el
'Ej: AgregarIcono Me.hWnd, Me.Icon, "Este es el ToolTipText"

MostrarGlobo Titulo, Texto, ToolTipText, Icono
'En Titulo, va el titulo que llevara en negrita
'En Texto, va el texto que queramos
'En ToolTipText, va el texto que se mostrara al posarse sobre el icono
'En Icono, van solo 5 tipos como en un MsgBox
'Ej: MostrarGlobo "Este es el titulo", "Este es el texto", "Mira, soy un ToolTipText", Informacion

CambiarIcono Icono
'En Icono, va el nuevo icono que estara en el SysTray
'Ej: CambiarIcono Form2.Icon

QuitarIcono
'Quita el icono que esta en el SysTray
'Ej: QuitarIcono

TipText ToolTipText
'En ToolTipText, va el nuevo texto que mostrara el icono al pasar sobre el
'Ej: TipText "Este es el nuevo ToolTipText"

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
if EventTray(X) = "LEFTDOWN" then MsgBox "Click derecho apretado"
End Sub
'El evento Form_MouseMove tiene que ser si o si del form que llamo al AgregarIcono

Proba metiendo todo en un Form, y en Botones distintos. Proba de es forma y despues avisame 


Sancho.Mazorka     

Tendrias que buscar el archivo al cual esta referido en las Referencias del VB


Sancho.Mazorka     

Pero de intervalo no podes poner 1200000, no esta permitido, pero podes hacer esto:

Código [Seleccionar] Expandir

Dim Segundos As Integer

Private Sub Form_Load()
Segundos = 0
Timer1.Interval = 60000
End Sub

Private Sub Timer1_Timer()
Segundos=Segundos + 1
If Segundos = 20 Then MsgBox "Pasaron 20 Minutos"
End Sub


Sancho.Mazorka   

Che mira investigando mas encontre esto, espero que te sirva:

Código [Seleccionar] Expandir

'Paste this code into a module and set the Startup Object
'to 'Sub Main'
'(To set the startup object, go to
'Project->Project Properties->General Tab->Startup Object)

Public Const MAX_HOSTNAME_LEN = 132
Public Const MAX_DOMAIN_NAME_LEN = 132
Public Const MAX_SCOPE_ID_LEN = 260
Public Const MAX_ADAPTER_NAME_LENGTH = 260
Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
Public Const ERROR_BUFFER_OVERFLOW = 111
Public Const MIB_IF_TYPE_ETHERNET = 1
Public Const MIB_IF_TYPE_TOKENRING = 2
Public Const MIB_IF_TYPE_FDDI = 3
Public Const MIB_IF_TYPE_PPP = 4
Public Const MIB_IF_TYPE_LOOPBACK = 5
Public Const MIB_IF_TYPE_SLIP = 6

Type IP_ADDR_STRING
    Next As Long
    IpAddress As String * 16
    IpMask As String * 16
    Context As Long
End Type

Type IP_ADAPTER_INFO
    Next As Long
    ComboIndex As Long
    AdapterName As String * MAX_ADAPTER_NAME_LENGTH
    Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
    AddressLength As Long
    Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
    Index As Long
    Type As Long
    DhcpEnabled As Long
    CurrentIpAddress As Long
    IpAddressList As IP_ADDR_STRING
    GatewayList As IP_ADDR_STRING
    DhcpServer As IP_ADDR_STRING
    HaveWins As Boolean
    PrimaryWinsServer As IP_ADDR_STRING
    SecondaryWinsServer As IP_ADDR_STRING
    LeaseObtained As Long
    LeaseExpires As Long
End Type

Type FIXED_INFO
    HostName As String * MAX_HOSTNAME_LEN
    DomainName As String * MAX_DOMAIN_NAME_LEN
    CurrentDnsServer As Long
    DnsServerList As IP_ADDR_STRING
    NodeType As Long
    ScopeId  As String * MAX_SCOPE_ID_LEN
    EnableRouting As Long
    EnableProxy As Long
    EnableDns As Long
End Type

Public Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long
Public Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Sub main()
    'This example was created by George Bernier (bernig@dinomail.qc.ca)
    Dim error As Long
    Dim FixedInfoSize As Long
    Dim AdapterInfoSize As Long
    Dim i As Integer
    Dim PhysicalAddress  As String
    Dim NewTime As Date
    Dim AdapterInfo As IP_ADAPTER_INFO
    Dim Adapt As IP_ADAPTER_INFO
    Dim AddrStr As IP_ADDR_STRING
    Dim FixedInfo As FIXED_INFO
    Dim Buffer As IP_ADDR_STRING
    Dim pAddrStr As Long
    Dim pAdapt As Long
    Dim Buffer2 As IP_ADAPTER_INFO
    Dim FixedInfoBuffer() As Byte
    Dim AdapterInfoBuffer() As Byte
   
    'Get the main IP configuration information for this machine using a FIXED_INFO structure
    FixedInfoSize = 0
    error = GetNetworkParams(ByVal 0&, FixedInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
           MsgBox "GetNetworkParams sizing failed with error " & error
           Exit Sub
        End If
    End If
    ReDim FixedInfoBuffer(FixedInfoSize - 1)

    error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
    If error = 0 Then
            CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo)
            MsgBox "Host Name:  " & FixedInfo.HostName 'host name
            MsgBox "DNS Servers:  " & FixedInfo.DnsServerList.IpAddress 'dns server IP
            pAddrStr = FixedInfo.DnsServerList.Next
            Do While pAddrStr <> 0
                  CopyMemory Buffer, ByVal pAddrStr, Len(Buffer)
                  MsgBox "DNS Servers:  " & Buffer.IpAddress 'dns server IP
                  pAddrStr = Buffer.Next
            Loop
           
            Select Case FixedInfo.NodeType 'node type
                       Case 1
                                  MsgBox "Node type: Broadcast"
                       Case 2
                                   MsgBox "Node type: Peer to peer"
                       Case 4
                                    MsgBox "Node type: Mixed"
                       Case 8
                                    MsgBox "Node type: Hybrid"
                       Case Else
                                    MsgBox "Unknown node type"
            End Select
           
            MsgBox "NetBIOS Scope ID:  " & FixedInfo.ScopeId 'scope ID
            'routing
            If FixedInfo.EnableRouting Then
                       MsgBox "IP Routing Enabled "
            Else
                       MsgBox "IP Routing not enabled"
            End If
            ' proxy
            If FixedInfo.EnableProxy Then
                       MsgBox "WINS Proxy Enabled "
            Else
                       MsgBox "WINS Proxy not Enabled "
            End If
            ' netbios
            If FixedInfo.EnableDns Then
                      MsgBox "NetBIOS Resolution Uses DNS "
            Else
                      MsgBox "NetBIOS Resolution Does not use DNS  "
            End If
    Else
            MsgBox "GetNetworkParams failed with error " & error
            Exit Sub
    End If
   
    'Enumerate all of the adapter specific information using the IP_ADAPTER_INFO structure.
    'Note:  IP_ADAPTER_INFO contains a linked list of adapter entries.
   
    AdapterInfoSize = 0
    error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
    If error <> 0 Then
        If error <> ERROR_BUFFER_OVERFLOW Then
           MsgBox "GetAdaptersInfo sizing failed with error " & error
           Exit Sub
        End If
    End If
   ReDim AdapterInfoBuffer(AdapterInfoSize - 1)

' Get actual adapter information
   error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
   If error <> 0 Then
      MsgBox "GetAdaptersInfo failed with error " & error
      Exit Sub
   End If
   CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo)
   pAdapt = AdapterInfo.Next

   Do While pAdapt <> 0
        CopyMemory Buffer2, AdapterInfo, Len(Buffer2)
          Select Case Buffer2.Type
                Case MIB_IF_TYPE_ETHERNET
                    MsgBox "Ethernet adapter "
                Case MIB_IF_TYPE_TOKENRING
                    MsgBox "Token Ring adapter "
                Case MIB_IF_TYPE_FDDI
                    MsgBox "FDDI adapter "
                Case MIB_IF_TYPE_PPP
                    MsgBox "PPP adapter"
                Case MIB_IF_TYPE_LOOPBACK
                    MsgBox "Loopback adapter "
                Case MIB_IF_TYPE_SLIP
                    MsgBox "Slip adapter "
                Case Else
                    MsgBox "Other adapter "
        End Select
    MsgBox " AdapterName: " & Buffer2.AdapterName
    MsgBox "AdapterDescription: " & Buffer2.Description 'adatpter name

    For i = 0 To Buffer2.AddressLength - 1
           PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
            If i < Buffer2.AddressLength - 1 Then
             PhysicalAddress = PhysicalAddress & "-"
            End If

    Next
    MsgBox "Physical Address: " & PhysicalAddress 'mac address
    If Buffer2.DhcpEnabled Then
            MsgBox "DHCP Enabled "
    Else
            MsgBox "DHCP disabled"
    End If

    pAddrStr = Buffer2.IpAddressList.Next
    Do While pAddrStr <> 0
           CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
           MsgBox "IP Address: " & Buffer.IpAddress
           MsgBox "Subnet Mask: " & Buffer.IpMask
           pAddrStr = Buffer.Next
           If pAddrStr <> 0 Then
            CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, Len(Buffer2.IpAddressList)
           End If
   Loop
    MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress
    pAddrStr = Buffer2.GatewayList.Next
    Do While pAddrStr <> 0
            CopyMemory Buffer, Buffer2.GatewayList, Len(Buffer)
            MsgBox "IP Address: " & Buffer.IpAddress
            pAddrStr = Buffer.Next
            If pAddrStr <> 0 Then
            CopyMemory Buffer2.GatewayList, ByVal pAddrStr, Len(Buffer2.GatewayList)
            End If
    Loop

    MsgBox "DHCP Server: " & Buffer2.DhcpServer.IpAddress
    MsgBox "Primary WINS Server: " & Buffer2.PrimaryWinsServer.IpAddress
    MsgBox "Secondary WINS Server: " & Buffer2.SecondaryWinsServer.IpAddress

    ' Display time
    NewTime = CDate(Adapt.LeaseObtained)
    MsgBox "Lease Obtained: " & CStr(NewTime)

    NewTime = CDate(Adapt.LeaseExpires)
    MsgBox "Lease Expires :  " & CStr(NewTime)
    pAdapt = Buffer2.Next
    If pAdapt <> 0 Then
        CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo)
    End If

   Loop
   
End Sub


Sancho.Mazorka   

No tengo ni la mas minima idea, en google no encontre nada!
Pero toma te dejo unas API's sobre NetWork osea la red, desde Adaptadores hasta IP's

Código [Seleccionar] Expandir

Declare Function GetAdaptersInfo Lib "IPHlpApi" (IpAdapterInfo As Any, pOutBufLen As Long) As Long

Declare Function GetNetworkParams Lib "IPHlpApi" (FixedInfo As Any, pOutBufLen As Long) As Long

Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long

Declare Function Netbios Lib "netapi32.dll" Alias "Netbios" (pncb As NCB) As Byte

Declare Function NetMessageBufferSend Lib   "NETAPI32.DLL" (yServer As Any, yToName As Byte,   yFromName As Any, yMsg As Byte, ByVal lSize As Long) As Long

Public Declare Function NetShareAdd Lib "netapi32.dll" (ByVal servername As Any, ByVal slevel As Long, buf As SHARE_INFO_502, ByVal cbbuf As Long) As Long

Declare Function NetShareDel Lib "netapi32.dll" (ByVal servername As Any, ByVal netname As String, ByVal reserved As Long) As Long

Declare Function NetShareGetInfo Lib "Netapi32.dll" (strServerName As Any, strNetName As Any, ByVal nLevel As Long, pBuffer As Long) As Long

Declare Function NetUserGetInfo Lib "netapi32" (ByVal servername As String, ByVal username As String, ByVal level As Long, bufptr As Long) As Long

Function NetWkstaGetInfo Lib "netapi32" (ByVal servername As String, ByVal level As Long, lpBuf As Any) As Long

Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long

Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long

Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long

Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long

Declare Function WNetCloseEnum Lib "mpr.dll" Alias "WNetCloseEnum" (ByVal hEnum As Long) As Long

Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As Any, lpBufferSize As Long) As Long

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long

Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As NETRESOURCE, lphEnum As Long) As Long

Fijate en la API-Guide ahi esta todo bien documentado, la web de la API-Guide no existe mas creo =(


Sancho.Mazorka