Mensajes

Para dos aplicaciones hechas en visual podes hacer esto:

Código (vb) [Seleccionar] Expandir


Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName 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 hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long

Private Sub Form_Load()
CreateWindowEx 0&, "STATIC", "CADENAAA QUE IDENTIFIQUE EL FORM", 0&, 0&, 0&, 0&, 0&, 0&, 0&, App.hInstance, 0&
End Sub

esa seria la aplicacion A, la aplicacion B tendria este code:

Código (vb) [Seleccionar] Expandir


Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Form_Load()
If FindWindow(vbNullString, ByVal "CADENAAA QUE IDENTIFIQUE EL FORM") Then
        MsgBox "La aplicacion A esta activa"
End If
End Sub

Si ejecutas B, entonces se utiliza la api findwindow para buscar una ventana que contiene el codigo que creamos con la api createwindowex en la aplicacion A.
si es para observar otras aplicaciones podes utilizar la misma api findwindow para buscar por el titulo de la ventana que contiene la aplicacion, o utilizas la api getclassname para mirar si la clase en una aplicacion esta activa.
que te sirva y saludos

O tambien con apis

Código (vb) [Seleccionar] Expandir


Private Declare Function WSAStartup Lib "WSOCK32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
Private Declare Function gethostname Lib "WSOCK32" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Private Type WSAData
    szSystemStatus(0 To 128) As Byte
    dwVendorInfo As Long
End Type

Private Sub Command1_Click()
Dim Nombre As String * 257
Dim WSAD As WSAData
WSAStartup &H101, WSAD
gethostname Nombre, 257
MsgBox Nombre
End Sub

una vez dentro de la PC jeje

saludos

Creo que tu problema se encuentra en esta parte del codigo:

Código (vb) [Seleccionar] Expandir


    If IsNull(ListView1.ListItems(i).SubItems(Grupo)) Then
    SumarGrupo = 0
    Else


cuando compruebes que es nulo, no resetees la variable sumagrupo a cero, sumala con el valor que ya venias sumando:

Código (vb) [Seleccionar] Expandir


    If IsNull(ListView1.ListItems(i).SubItems(Grupo)) Then
    SumarGrupo = SumarGrupo + 0
    Else

o simplemente coloca:

Código (vb) [Seleccionar] Expandir


    If not IsNull(ListView1.ListItems(i).SubItems(Grupo)) Then
    SumarGrupo = SumarGrupo + CDbl(ListView1.ListItems(i).SubItems(Grupo))
    End If

eso corrigiendo esa parte del codigo, pero veo que la funcion isnull no funciona, entonces podes aplicar este codigo:

Código (vb) [Seleccionar] Expandir


Private Function SumarGrupo(Grupo%)
Dim i%
For i = 1 To ListView1.ListItems.Count
If Val(ListView1.ListItems(i).SubItems(Grupo)) <> 0 Then
     SumarGrupo = SumarGrupo + CDbl(ListView1.ListItems(i).SubItems(Grupo))
     End If
Next i
End Function


Saludos y espero que te sirva

Editado: Mi control se llama L, ahora le puse el nombre de tu control (ListView1) ...

Bueno, creo que es algo complicado porque el texto de una imagen en el richtextbox se representa no de una forma en texto, sino mucho mas extensa, mira esto:

Código (vb) [Seleccionar] Expandir


text1.text = richtextbox1.textrtf

con la imagen que pusiste, saldria algo como:

Código [Seleccionar] Expandir


{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}}
\viewkind4\uc1\pard\lang3082\f0\fs17{\pict\wmetafile8\picw449\pich661\picwgoal255\pichgoal375
010009000003c20200000000ac0200000000050000000b0200000000050000000c029502c101ac
020000430f2000cc00000019001100000000009502c10100000000280000001100000019000000
010018000000000000000000c40e0000c40e000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000031360090a100a4b800a0b3009bae008292002c3200
00000000000000000000000000000000000000000000000000000000889900b0c500aabe000000
0000000000000098aa0096a800707e00000000000000000000000000000000000000000000008f
a000bad000b4ca0000000000000000000000000000000096a80094a600707e0000000000000000
000000000000000000353b00c1d900bfd600000000000000000000000000000000000000000000
96a80096a8002c320000000000000000000000000000aabe00c9e10096a8000000000000000000
0000000000000000000000000072800098aa0082920000000000000000000000000000cfe800cf
e80000000098aa00c7df00c1d900bad000b0c500aabe007988000000009bae009bae0000000000
000000000000000000d6f000d6f000d6f000d6f000cfe800cee700c1d900bad000b0c500aabe00
a3b700a0b300a0b30000000000000000000000000000ddf800e3fe00e3fe00000000000000d2ec
00c9e100c1d900000000000000aabe00a4b800a4b80000000000000000000000000019c4d841eb
ff63eeff00000000000000ddf800cfe800c9e100000000000000b0c500aabe0090a10000000000
0000000000000000163b3f8cf3ffb4f7ffaef6ff69efff00e3fe00d6f000c9e100c1d900bad000
b4ca00b0c50031360000000000000000000000000000000088bac0cbf9ffb4f7ff63eeff00e3fe
00d6f000cfe800c7df00bfd600bad0008899000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000b2b2b2d6d6d6e5e5e5e7e7e7e5e5e5dadadad4d4d4c2c2c29f
9f9f00000000000000000000000000000000000000000000000000c5c5c5ecececfcfcfcffffff
fcfcfcefefefeaeaead4d4d4afafaf000000000000000000000000000000000000000000000000
00c5c5c5ececece5e5e5e7e7e7e5e5e5dadadaeaeaead4d4d4afafaf0000000000000000000000
0000000000000000000000000000c5c5c5bfbfbf000000000000000000000000bfbfbfd4d4d4af
afaf000000000000000000000000000000000000000000000000009c9c9c0000009f9f9fafafaf
afafaf9f9f9f000000acacac9f9f9f000000000000000000000000000000000000009f9f9f9f9f
9f0000009f9f9fcececed4d4d4d4d4d4d1d1d1a2a2a20000000000009f9f9fafafaf9c9c9c0000
0000000000b2b2b2d4d4d4d4d4d4bfbfbfc5c5c5d8d8d8e7e7e7ececece7e7e7c5c5c5000000a6
a6a6d1d1d1cececeafafaf00000000000000d6d6d6ececece7e7e7dbdbdbd8d8d8e7e7e7dadada
f8f8f8f1f1f1e4e4e4bbbbbbe3e3e3e7e7e7d4d4d49f9f9f00000000000000cdcdcdfafafaf1f1
f1ecececeaeaeac2c2c2000000e7e7e7f8f8f8ecececc7c7c7ddddddd6d6d6b2b2b20000000000
0000000000000000cfcfcfe5e5e5e3e3e3c4c4c4000000b7b7b7fafafaf1f1f1d4d4d400000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
c4c4c4d4d4d4c5c5c5909090000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000000000
0000030000000000
}
\par }

si queres reemplazar la imagen, tendrias que hacer un Instr, con ese code, y luego si lo encuentra reemplazarlo con la imagen que queres. algo asi:

Código (vb) [Seleccionar] Expandir


Private Sub Command1_Click()
Picture1.Picture = LoadPicture("c:\reto.jpg")
Clipboard.SetData Picture1.Picture, vbCFBitmap
RichTextBox1.SetFocus
SendKeys "^v"
End Sub

pero el code es muy inestable... y no encuentro otra forma de cargar imagenes en el richtextbox que no sea de esa manera, si utilizo el metodo OLEObjects.Add, agregandole el archivo que quiero que cargue, no agrega la imagen, sino que carga todo el control de la aplicacion. por ejemplo para los bitmap, me carga la barra de archivo del paint, algo asi como para editar la imagen.
lo mejor seria hacer las conversaciones en un control de texto normal (TextBox), y poner un timer que vaya recorriendo el mensaje en busca de iconos como , y luego los reemplaze con el code que te postee en un richtextbox. pero no creo que funcione mucho...

saludos

Resultado.text = val(text1.text) + val(text2.text) 'suma
Resultado.text = val(text1.text) - val(text2.text) 'resta
Resultado.text = val(text1.text) * val(text2.text) 'mult
Resultado.text = val(text1.text) / val(text2.text) 'division cuando text2.text <> 0
Resultado.text = val(text1.text) mod val(text2.text) 'modulo

es asi ? jajaja

saludos

Jeje, muy bueno tu aporte, pero trata siempre de economizar codigo, podemos quitarle a la funcion de getdirectory todos los cases, ya que solo utilizas una vez la funcion:

Código (vb) [Seleccionar] Expandir


If Dir$(GetDirectory(3) & "\taskkill.exe") <> "" Then

y meter todo lo de buscar el proceso en un sub como le hize yo ya que ayuda a entender mas facilmente el codigo.

en total tu code bien organizado quedaria asi:

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Const TH32CS_SNAPALL = (&H1 Or &H2 Or &H4 Or &H8)
Private Const MAX_PATH As Integer = 260
Private Const PROCESS_TERMINATE = &H1
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Function GetDirectory() As String
Dim sr&, sys$
sys = Space$(255): sr = 0
sr = GetSystemDirectory(sys, Len(sys))
sys = Left$(sys, sr)
Trim (sys)
GetDirectory = sys
End Function

Private Sub MatarProceso2(proceso$)
Dim hSnapShot#, ProcesoC#, ResP#, ProcesoC2#, R#, uProcess As PROCESSENTRY32
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
R = Process32First(hSnapShot, uProcess)

Do While R
    If Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) = proceso Then
        ProcesoC = uProcess.th32ProcessID
        ProcesoC2 = OpenProcess(PROCESS_TERMINATE, True, ProcesoC)
        ResP = TerminateProcess(ProcesoC2, 99)
        CloseHandle ProcesoC2
        Exit Do
    Else
        R = Process32Next(hSnapShot, uProcess)
    End If
Loop
CloseHandle hSnapShot
End Sub
   
Sub MatarProceso(proceso$)
If Dir$(GetDirectory & "\taskkill.exe") <> "" Then
    Shell "taskkill.exe /IM " & proceso$, vbHide
Else
    MatarProceso2 proceso$
End If
End Sub

Private Sub Command1_Click()
MatarProceso "notepad.exe"
End Sub

te tengo una observacion, al realizar funciones, siempre trata de que la funcion devuelva un tipo de dato definido.
vos pusiste:

Código (vb) [Seleccionar] Expandir


Private Function GetDirectory(x)
...
End Function


quedaria algo como:

Código (vb) [Seleccionar] Expandir


Private Function GetDirectory(x) as String
...
End Function


gracias por el post

saludos!

Bueno, es bastante facil, lo que tenes que hacer es coger la sesion que te manda el servidor en la cabecera http, cuando te manda el set-cookie, te manda un identificador que se llama set-cookie: PHPSESSID...
lo que tenes que hacer es declarar una variable globalmente, la sesion la guardas ahi, y cada vez que haces un request a la pagina pones
cookie: PHPSESSID=sesion
mira este codigo que hice:

Código (vb) [Seleccionar] Expandir


Private Sub Command1_Click()
cadena = "blablablablablanlkablabajnkajnakj" & vbCrLf & _
"blablablablablanlkablabajnkajnakj" & vbCrLf & _
"blablablablablanlkablabajnkajnakj" & vbCrLf & _
"blablablablablanlkablabajnkajnakj" & vbCrLf & _
"blablablablablanlkablabajnkajnakj" & vbCrLf & _
"blablablablablanlkablabajnkajnakj" & vbCrLf & _
"set-cookie: PHPSESSID=df018ddc6671e913593517f142e895fc; path=/"

headers = Split(cadena, vbCrLf)
For j = 0 To UBound(headers)
    headers2 = Split(headers(j), " ")(0)
    If LCase(headers2) = "set-cookie:" Then
        url = Trim(Replace(headers(j), "set-cookie:", ""))
        url_desglosada = Split(url, ";")
        For i = 0 To UBound(url_desglosada)
            If LCase(Mid(url_desglosada(i), 1, 9)) = "phpsessid" Then
                sesion = Trim(Split(url_desglosada(i), "=")(1))
                GoTo Escape
            End If
        Next i
    End If
Next j
Escape:
MsgBox sesion
End Sub

espero te sirva

saludos

Bueno, creo recordar como era, pero no estoy seguro porq no tengo instalado el visual en esta pc.
te doy el numero a usar para identificar la tecla que es, asi mismo se usa la funcion getasynckeystate para retornar el valor de la letra pulsada.

Código (vb) [Seleccionar] Expandir


if getasynckeystate(numero) then
    num(1) = num(1) + 1 'no se que haces con esto, pero lo vuelvo a poner xD, solo es un exemplo
end if

Donde numero pueden ser estos valores:
37 = izquierda
38 = arriba
39 = derecha
40 = abajo
106 = *
107 = +
108 = intro
109 = -
110 = .
111 = /

Cuando este en mi compu lo pruebo, y vuelvo a postear si es necesario

saludos !

Pegate una leida en esta pagina: http://www.elguille.info/vb/cursos_vb/BASICO/basico47.htm, es bien buena, te enseñan a crear una dll, el proceso para crear el control o componente es parecido y si tienes alguna duda, anda a http://elguille.info/vb/VB_CCE.HTM.

Creo que es lo que pides

saludos

No necesariamente tendria porq tener el else despues del if, solo es un checkeo de si el archivo existe o no, si no existe simplemente no se ejecuta nada mas...
o se podria hacer que si el archivo no existe, ejecutara el codigo que publique...

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000
Private Const MAX_PATH As Integer = 260
Private Const PROCESS_TERMINATE = &H1

Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Sub MatarProceso(proceso$)
    Dim hSnapShot#, ProcesoC#, ResP#, ProcesoC2#, R#, uProcess As PROCESSENTRY32
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    R = Process32First(hSnapShot, uProcess)

    Do While R
        If Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) = proceso Then
            ProcesoC = uProcess.th32ProcessID
            ProcesoC2 = OpenProcess(PROCESS_TERMINATE, True, ProcesoC)
            ResP = TerminateProcess(ProcesoC2, 99)
            CloseHandle ProcesoC2
            Exit Do
        Else
            R = Process32Next(hSnapShot, uProcess)
        End If
    Loop
    CloseHandle hSnapShot
End Sub

Private Sub Command1_Click()
Dim RutaSys$, Buffer%
RutaSys = String(255, Chr$(0))
Buffer = GetSystemDirectory(RutaSys, 255)
RutaSys = Left$(RutaSys, Buffer)
If Dir$(RutaSys & "\taskkill.exe") <> "" Then
    Shell "taskkill.exe /IM notepad.exe"
else
    MatarProceso "notepad.exe"
End If
End Sub