Mensajes

io puse una respuesta para utilizar el WMP en este post. Creo k te sera de ayuda.

http://foro.elhacker.net/index.php/topic,182439.0.html

Salu2

[CARRY-ON]

CARRY-ON

No te pido k sepas todo.. pero LOL!

man, todos los elementos (Text, Labels, Commands B.) del VB tienen Eventos.. el evento k yo puse, es el evento "KeyPress", el k tiene por "Default" es el "Click". No mas cambialo.

Y sobre el 8, lo k pasa es k los Ascci son los caracteres de la PC nombrados por numeros como kien dice.. Y ps, el Numero 8 le pertenece al [BackSpace], asi como el Enter = 13. Y asi..

Salu2

[En Form]

Te pondre este codigo hecho de otra persona.

Pero de ahi ps, partes, y haces tu propio globo, y tu propio simbolo.

Necesitas.

4 Commands Buttons.
2 TextBox.
1 Pb Tray (No importante >.>)

En Form

Private Sub Form_Load()
Dim tmp
   tmp = RegRead(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "EnableBalloonTips")
   If tmp = 0 Then
       If MsgBox("Balloon tips  desactivados temporalmente.Desea volverlos a activar", vbQuestion + vbYesNo, "Activar...") = vbYes Then
           WriteDWORD HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "EnableBalloonTips", 1
           If MsgBox("Para que los cambios surtan efecto debes reiniciar el pc" & Chr(13) & "Desea reiniciar ahora", vbQuestion + vbYesNo, "Apagar...") = vbYes Then
               LogOffNT True
               End
           End If
       End If
   End If
   AgregarTray pbTray
End Sub
Private Sub cmdBalloon_Click(Index As Integer)
   TrayBalloon pbTray, txtTitle.Text, txtMsg.Text, Index
End Sub
Private Sub Form_Unload(Cancel As Integer)
  EliminarTray pbTray
End Sub

Private Sub pbTray_Click()

End Sub

Modulo 1. (LogOff)

Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32.dll" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long

Private Const EWX_LOGOFF = 0
Private Const EWX_SHUTDOWN = 1
Private Const EWX_REBOOT = 2
Private Const EWX_FORCE = 4
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type

Public Type LUID
   LowPart As Long
   HighPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
   pLuid As LUID
   Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
   PrivilegeCount As Long
   Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type


Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO

   myOS.dwOSVersionInfoSize = Len(myOS)
   GetVersionEx myOS
   IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
   
End Function

Private Sub EnableShutDown()
   Dim hProc As Long
   Dim hToken As Long
   Dim mLUID As LUID
   Dim mPriv As TOKEN_PRIVILEGES
   Dim mNewPriv As TOKEN_PRIVILEGES

   hProc = GetCurrentProcess()
   OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
   LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
   mPriv.PrivilegeCount = 1
   mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
   mPriv.Privileges(0).pLuid = mLUID
   
   AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub

Public Sub RebootNT(Force As Boolean)
Dim r As Long, Flags As Long

   Flags = EWX_REBOOT
   If Force Then Flags = Flags + EWX_FORCE
   If IsWinNT Then EnableShutDown
   ExitWindowsEx Flags, 0
End Sub

Public Sub LogOffNT(Force As Boolean)
Dim r As Long, Flags As Long

   Flags = EWX_LOGOFF
   If Force Then Flags = Flags + EWX_FORCE
   ExitWindowsEx Flags, 0
End Sub

Modulo 2. (RedEdit)

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal KeyRoot As kRoot, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Public Enum regType
   REG_SZ = 1
   REG_EXPAND_SZ = 2
   REG_BINARY = 3
   REG_DWORD = 4
End Enum

Const REG_OPTION_NON_VOLATILE = 0

Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                   
Public Enum kRoot
   HKEY_CLASSES_ROOT = &H80000000
   HKEY_CURRENT_USER = &H80000001
   HKEY_LOCAL_MACHINE = &H80000002
   HKEY_USERS = &H80000003
   HKEY_PERFORMANCE_DATA = &H80000004
   HKEY_CURRENT_CONFIG = &H80000005
   HKEY_DYN_DATA = &H80000006
End Enum

Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0

Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Boolean
End Type

Public Function WriteDWORD(ByVal KeyRoot As kRoot, ByVal KeyName As String, ByVal SubKeyName As String, ByVal SubKeyValue As Long) As Boolean
Dim r As Long, hkey As Long
   
   r = RegCreateKey(KeyRoot, KeyName, hkey)
   
   If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd
   
   r = RegSetValueEx(hkey, SubKeyName, 0, REG_DWORD, SubKeyValue, 4)
                     
   If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd

   RegCloseKey hkey
   
   WriteDWORD = True

Exit Function
Err_Hnd:
   
   WriteDWORD = False
   RegCloseKey hkey
   
End Function

Public Function RegRead(KeyRoot As kRoot, KeyName As String, SubKeyName As String) As String
Dim i As Long, r As Long, hkey As Long, hDepth As Long, lKeyValType As Long, KeyValSize As Long
Dim sKeyVal As String, tmpVal As String
   
   r = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hkey)
   
   If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd
   
   tmpVal = String$(1024, 0)
   KeyValSize = 1024
   
   r = RegQueryValueEx(hkey, SubKeyName, 0, lKeyValType, tmpVal, KeyValSize)
                       
   If (r <> ERROR_SUCCESS) Then GoTo Err_Hnd
     
   tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)

   Select Case lKeyValType
       Case REG_SZ, REG_EXPAND_SZ
           sKeyVal = tmpVal
       Case REG_DWORD
           For i = Len(tmpVal) To 1 Step -1
               sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
           Next
           sKeyVal = Val(Format$("&h" + sKeyVal))
   End Select
   
   RegRead = sKeyVal
   RegCloseKey hkey

Exit Function
Err_Hnd:
   
   RegRead = vbNullString
   RegCloseKey hkey
   
End Function

Modulo 3. (Tray o "Simbolo en barra reloj")

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Const GWL_WNDPROC As Long = (-4)
Public Const GWL_HWNDPARENT As Long = (-8)
Public Const GWL_ID As Long = (-12)
Public Const GWL_STYLE As Long = (-16)
Public Const GWL_EXSTYLE As Long = (-20)
Public Const GWL_USERDATA As Long = (-21)

Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIM_SETFOCUS = &H3
Public Const NIM_SETVERSION = &H4
Public Const NIM_VERSION = &H5

Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2

Public Const WM_USER As Long = &H400
Public Const WM_MYHOOK As Long = WM_USER + 1
Public Const WM_NOTIFY As Long = &H4E
Public Const WM_COMMAND As Long = &H111
Public Const WM_CLOSE As Long = &H10
Public Const WM_MOUSEMOVE As Long = &H200
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_LBUTTONUP As Long = &H202
Public Const WM_LBUTTONDBLCLK As Long = &H203
Public Const WM_MBUTTONDOWN As Long = &H207
Public Const WM_MBUTTONUP As Long = &H208
Public Const WM_MBUTTONDBLCLK As Long = &H209
Public Const WM_RBUTTONDOWN As Long = &H204
Public Const WM_RBUTTONUP As Long = &H205
Public Const WM_RBUTTONDBLCLK As Long = &H206

Public Const NIN_BALLOONSHOW = (WM_USER + 2)
Public Const NIN_BALLOONHIDE = (WM_USER + 3)
Public Const NIN_BALLOONTIMEOUT = (WM_USER + 4)
Public Const NIN_BALLOONUSERCLICK = (WM_USER + 5)

Public Enum bFlag
   NIIF_NONE = &H0
   NIIF_INFO = &H1
   NIIF_WARNING = &H2
   NIIF_ERROR = &H3
   NIIF_GUID = &H5
   NIIF_ICON_MASK = &HF
   NIIF_NOSOUND = &H10
End Enum

Public Type NOTIFYICONDATA
   cbSize As Long
   hwnd As Long
   uID As Long
   uFlags As Long
   uCallbackMessage As Long
   hIcon As Long
   szTip As String * 128
   dwState As Long
   dwStateMask As Long
   szInfo As String * 256
   uTimeoutAndVersion As Long
   szInfoTitle As String * 64
   dwInfoFlags As Long
End Type
Global ni As NOTIFYICONDATA
Global lWP As Long
Private Sub UnSubClass(hwnd As Long)
  If lWP <> 0 Then
     SetWindowLong hwnd, GWL_WNDPROC, lWP
     lWP = 0
  End If
End Sub
Private Sub SubClass(hwnd As Long)
  On Error Resume Next
  lWP = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub AgregarTray(pb As PictureBox)
  With ni
     .cbSize = Len(ni)
     .hwnd = pb.hwnd
     .uID = 1
     .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
     .dwState = NIS_SHAREDICON
     .hIcon = pb.Picture
     .uCallbackMessage = WM_MYHOOK
     .szTip = "Tooltip title" & vbNullChar
     .uTimeoutAndVersion = NOTIFYICON_VERSION
  End With
  Shell_NotifyIcon NIM_ADD, ni
  SubClass pb.hwnd
End Sub

Public Sub EliminarTray(pb As PictureBox)
  With ni
     .cbSize = Len(ni)
     .hwnd = pb.hwnd
     .uID = 1
  End With
  Shell_NotifyIcon NIM_DELETE, ni
  UnSubClass pb.hwnd
End Sub

Public Sub TrayBalloon(pb As PictureBox, bTitle As String, bText As String, ByVal bFlag As bFlag)
  With ni
     .cbSize = Len(ni)
     .hwnd = pb.hwnd
     .uID = 1
     .uFlags = NIF_INFO
     .dwInfoFlags = bFlag
     .szInfoTitle = bTitle & vbNullChar
     .szInfo = bText & vbNullChar
  End With
  Shell_NotifyIcon NIM_MODIFY, ni
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   On Error Resume Next
   Select Case hwnd
       Case frmBalloon.pbTray.hwnd
           Select Case uMsg
               Case WM_MYHOOK
                   Select Case lParam
                       Case WM_LBUTTONUP
                           
                       Case WM_RBUTTONUP
                         
                       Case NIN_BALLOONSHOW
                         
                       Case NIN_BALLOONHIDE
                           
                       Case NIN_BALLOONUSERCLICK
                           MsgBox "Balloon tip.. del usuario", vbInformation, "Information"
                       Case NIN_BALLOONTIMEOUT
                           
                       Case WM_MOUSEMOVE
                         
                   End Select
               Case Else
                   WindowProc = CallWindowProc(lWP, hwnd, uMsg, wParam, lParam)
                   Exit Function
           End Select
       Case Else
           WindowProc = CallWindowProc(lWP, hwnd, uMsg, wParam, lParam)
   End Select
End Function

Es todo, creok de ahi podras hacerlo como kieras. Io ise el mio de ahi ^^

Salu2

d k globo hablas?

Ps bueno, aki tengo otra forma, si no te acomodan las otras..

Sub BorrarCarpeta(sPath As String)
    Dim sName As String
    Dim sFullName As String

    Dim Dirs() As String
    Dim DirsNo As Integer
    Dim i As Integer


    If Not Right(sPath, 1) = "\" Then
        sPath = sPath & "\"
    End If

    sName = Dir(sPath & "*.*")

    While Len(sName) > 0
        sFullName = sPath & sName
        SetAttr sFullName, vbNormal
        Kill sFullName
        sName = Dir
    Wend
   
    sName = Dir(sPath & "*.*", vbHidden)

    While Len(sName) > 0
        sFullName = sPath & sName
        SetAttr sFullName, vbNormal
        Kill sFullName
        sName = Dir
    Wend
   
    DirsNo = 0
    sName = Dir(sPath, vbDirectory)

    While Len(sName) > 0

        If sName <> "." And sName <> ".." Then
            DirsNo = DirsNo + 1
            ReDim Preserve Dirs(DirsNo) As String
            Dirs(DirsNo - 1) = sName
        End If
        sName = Dir
    Wend

    For i = 0 To DirsNo - 1
        BorrarCarpeta (sPath & Dirs(i) & "\")
        RmDir sPath & Dirs(i)
    Next
End Sub

Private Sub Form_Load()
BorrarCarpeta ("[LocalizacionDelFolder]")
End
End Sub

Esta la uso, y funciona bien, borra todo el contenido de cualkier folder.. pero.. no el folder ^^ pero si el contenido.. lo kual es iwal importante.. para el folder.. ps usa la "kill" como añadido.

O bien usa el metodo de Spider-Net k iwal borra ^^

Salu2

10 ^ 2

es solo un ejemplo claro..

Código [Seleccionar] Expandir

Private Declare Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer

Este es el k neceistas para las teclas precionadas con programas minizados.. o no, como sea..

Para hacer las teclas, ps..

Código [Seleccionar] Expandir

If GetAsyncJKeyState (vbKey1) then "lo k sea"

Salu2

Muchas gracias man, kisiera ver ese programa open source tuyo ^^

Pero.. el link de 4share, cuando le doi a Donwload no carga.. :\

EDIT:

Ya funciono el 4shared por finnnnnnn!

una cosa.. es k el sin skin, no tiene el codigo fuente. Y no da error el programa de color verde, pero.. no se ven los mensajes pk los isite con un ocx^^

Pero muchas gracias man ^^ es una forma nueva k no conocia full VB, muchisimas gracias ^^

Puedes borarr el folder, si ese es el caso.

Kill "C:\ bla bla bla bla"

EN cualkier otro caso, puede usar este codigo de "ranefi"

Código [Seleccionar] Expandir


Public Ruta As String
Public Carpeta As String, Archivo As String, _
    ArchivoNuevo As String

Private Sub Command1_Click()
On Error GoTo UPS
    Ruta = "C:\"
    Carpeta = "[Nombre de Carpeta]"
   
    RmDir Ruta & Carpeta 'ELIMINA UNA CARPETA
    MsgBox "La carpeta llamada " & _
        Carpeta & " fue eliminada de " & Ruta, _
        vbInformation, "Mensaje"
    Exit Sub
UPS:
    MsgBox "Carpeta no existente o unidad invalida"
        vbCritical, "Error"
End Sub

Simple ^^


Esta es la API k necesitaras.

Private Declare Function GetAsyncKeyState Lib "user32" ( _ByVal vKey As Long) As Integer

Y ps, para eso de pulsar tecla, y haga algo..
En un timer pones..

If GetAsyncKeyState(vbKeyReturn) Then MsgBox "Hola"

Asi le das a Enter y saldra el Msg "Hola"

Salu2