|
234
|
Programación / Programación Visual Basic / Re: Capturar Imagen de video
|
en: 6 Abril 2007, 23:49 pm
|
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'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
|
|
|
236
|
Programación / Programación Visual Basic / Re: [Contribucion] Modulos Common Dialogs y Systray
|
en: 6 Abril 2007, 02:38 am
|
Lionheart para que no haya este tipo de inconvenientes, le puse una ayuda al modulo. Ahora paso a explicarte cada uno de esos ejemplos. 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
|
|
|
239
|
Programación / Programación Visual Basic / Re: Se puede saber la direccion fisica de NW
|
en: 1 Abril 2007, 00:02 am
|
Che mira investigando mas encontre esto, espero que te sirva: '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
|
|
|
240
|
Programación / Programación Visual Basic / Re: Se puede saber la direccion fisica de NW
|
en: 31 Marzo 2007, 23:30 pm
|
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 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 =(
|
|
|
|
|
|
|