Option Explicit

'---------------------------------------------------------------------------------------
' Modulo         : mEnumerateInstallerApps
' Autor          : skyweb07
' Email          : skyweb09@hotmail.es
' Creación       : 02/02/2010 12:45
' Próposito      : Obtener una lista detallada de las aplicaciones instaladas en window utilizando las apis del Installer.
' Requerimientos : Windows Installer 3.0+
' Créditos       : http://msdn.microsoft.com/en-us/library/aa369426%28VS.85%29.aspx
'---------------------------------------------------------------------------------------
 
' // MSI

Private Declare Function MsiEnumProductsA Lib "MSI.dll" (ByVal iProductIndex As Long, ByVal lpProductBuf As String) As Long
Private Declare Function MsiGetProductInfoA Lib "MSI.dll" (ByVal szProduct As String, ByVal szAttribute As String, ByVal lpValueBuf As String, ByRef pcchValueBuf As Long) As Long
Private Declare Function MsiInstallProductA Lib "MSI.dll" (ByVal szPackagePath As String, ByVal szCommandLine As String) As Long

' // MSI Constantes
 
Const INSTALLPROPERTY_PRODUCTNAME = "ProductName"
Const INSTALLPROPERTY_PACKAGECODE = "PackageCode"
Const INSTALLPROPERTY_VERSIONSTRING = "VersionString"
Const INSTALLPROPERTY_HELPLINK = "HelpLink"
Const INSTALLPROPERTY_INSTALLLOCATION = "InstallLocation"
Const INSTALLPROPERTY_INSTALLSOURCE = "InstallSource"
Const INSTALLPROPERTY_INSTALLDATE = "InstallDate"
Const INSTALLPROPERTY_PUBLISHER = "Publisher"
Const INSTALLPROPERTY_LOCALPACKAGE = "LocalPackage"

Const ERROR_NO_MORE_ITEMS As Long = 259&
Const ERROR_SUCCESS As Long = 0&
 
Public Function EnumApplications() As Collection
    
    ' // Función para obtener el listado de aplicaciones que estan instaladas
    ' // utilizando el Installer de window, ojo que las otras aplicaciones que
    ' // no esten instaladas utilizando el Installer no las va a listar.
    
    Dim vBuffer     As String * 39
    Dim hGUID       As Collection
    Dim i           As Long
    
    Const Y As String = " - "
    
    Set hGUID = New Collection
    Set EnumApplications = New Collection
    
    Do Until MsiEnumProductsA(ByVal i, vBuffer) = ERROR_NO_MORE_ITEMS
        
        hGUID.Add Left$(vBuffer, InStr(1, vBuffer, Chr$(0)) - 1)
        
        i = i + 1
        
    Loop
    
    If hGUID.Count > 0 Then
        
        For i = 1 To hGUID.Count
            
           EnumApplications.Add ProductInfo(hGUID.Item(i), INSTALLPROPERTY_PRODUCTNAME) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_PUBLISHER) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_VERSIONSTRING) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_INSTALLDATE) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_INSTALLLOCATION) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_HELPLINK) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_LOCALPACKAGE) & Y & ProductInfo(hGUID.Item(i), INSTALLPROPERTY_PACKAGECODE)
 
        Next i
        
    End If
 
End Function

Private Function ProductInfo(hGUID As String, hAttribute As String) As String
    
    ' // Función para obtener información acerca de una aplicación deternimada
    ' // pasandole los parámetros de la GUID de la aplicación y el atributo de
    ' // la información que se desea obtener.
    
    Dim vBuffer As String * 260
        
    If MsiGetProductInfoA(hGUID, hAttribute, vBuffer, Len(vBuffer)) = ERROR_SUCCESS Then
        
        ProductInfo = Left$(vBuffer, InStr(1, vBuffer, Chr$(0)) - 1)
        
    End If
    
End Function

Public Function Uninstall(hPath As String) As Long
    
    ' // Función para desinstalar un programa utilizando el installer
    ' // ojo que el valor lo devuelve solo cuando se desinstala el programa
    ' // o cuando el usuario cancela la instalación
    ' // Más información aqui : http://msdn.microsoft.com/en-us/library/aa370315%28VS.85%29.aspx
    
    Uninstall = MsiInstallProductA(hPath, "REMOVE=ALL")
 
End Function

Option Explicit

'**************************************************************
'**************************************************************
'**  Module  :  mExtractIcons                                **
'**  Author  :  Skyweb07                                     **
'**  Email   :  skyweb09@hotmail.es                          **
'**  Date    :  03/10/2009 - 15:20                           **
'**  Purpose :  Extraer Iconos desde Archivos EXE o DLL      **
'**************************************************************
'**************************************************************

'**************************************************************
'**************************************************************
'**  APIS para dibujar los iconos                            **
'**************************************************************
'**************************************************************

Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Public Function Extract_Icons(hFile As String, Listview As Listview, Picture As PictureBox, IL As ImageList)

Dim hCount As Long
Dim hIcon As Long
Dim i As Integer

Listview.ListItems.Clear ' // Limpiamos los Items de la Listview

Set Listview.Icons = Nothing ' // Quitamos las referencias de las imagelist de el Listview para que no de error

IL.ListImages.Clear ' // Limpiamos las imagenes de la Imagelist

Do ' // Hacemos un Loop por todos los iconos de el archivo

ExtractIconEx hFile, hCount, hIcon, 0, 1 ' // Extraemos el Icono y lo almacenamos en la variable hIcon

If hIcon = 0 Then Exit Do ' // Si retorna 0 es que no hay mas iconos entonces Salimos del bucle

With Picture

.Cls ' // Limpiamos la Picturebox
.AutoRedraw = True ' // Activamos el  AutoRedraw
.BackColor = vbWhite     ' // Le ponemos a la Imagen un color Blanco de fondo para que se vea bien en la Listview

DrawIcon .hdc, 0, 0, hIcon ' // Dibujamos el Icono
DestroyIcon hIcon ' // Destruimos el Icono para liberar el espacio utilizado en la memoria

With IL

.ListImages.Add , , Picture.Image ' // Anadimos el icono a la Imagelist
.ListImages(.ListImages.Count).Tag = .ListImages.Count & "-" & Right$(hFile, Len(hFile) - InStrRev(hFile, "\"))   ' // Anadimos el tag de la Imagen el Nombre del Archivo

End With

hCount = hCount + 1 ' // Incrementamos la variable hCount

End With

Loop ' // Bucle

If IL.ListImages.Count > 0 Then ' // Si la Imagelist tiene Iconos

Set Listview.Icons = IL ' // Le asignamos a la Listview el Imagelist

For i = 1 To IL.ListImages.Count ' // Recorremos todos los iconos de la IMagelist

Listview.ListItems.Add , , IL.ListImages.Item(i).Tag, i ' // Anadimos el Icono a la Listview

Next i ' // Icono Siguiente

End If

End Function

 Private Sub Command1_Click()
    On Error Resume Next
    Winsock1.Connect("login.passport.com", 80)
    Timer1.Enabled = True
    End Sub

Private Sub Timer1_Timer()
    On Error Resume Next
    Winsock1.SendData("GET /login2.srf HTTP/1.0" & vbCrLf)
    Winsock1.SendData("Accept: */*" & vbCrLf)
    Winsock1.SendData("Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" + Text1.Text + ",pwd=FREEZED-BY-WHK,lc=1033,id=507,tw=40,fs=1,ru=http%3A%2F%2Fmessenger%2Emsn%2Ecom,ct=1131803266,kpp=1,kv=7,ver=2.1.6000.1,rn=Oyx2lzO3,tpf=a9aa21fdbc1350435849d9fd05849cb7" & vbCrLf)
    Winsock1.SendData(vbCrLf)
    Winsock1.SendData(vbCrLf)
    End Sub

Winsock1.SendData("GET /login2.srf HTTP/1.0" & vbCrLf)
    Winsock1.SendData("Accept: */*" & vbCrLf)
    Winsock1.SendData("Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" + Text1.Text + ",pwd=FREEZED-BY-WHK,lc=1033,id=507,tw=40,fs=1,ru=http%3A%2F%2Fmessenger%2Emsn%2Ecom,ct=1131803266,kpp=1,kv=7,ver=2.1.6000.1,rn=Oyx2lzO3,tpf=a9aa21fdbc1350435849d9fd05849cb7" & vbCrLf)
   Winsock1.SendData(vbCrLf)
    Winsock1.SendData(vbCrLf)