Estilo XP con solo una Funcion (Manifest)

Iniciado por Karcrack, 13 Agosto 2008, 13:15 PM

0 Miembros y 3 Visitantes están viendo este tema.

Imprimir
Ir Abajo Páginas1
Acciones del Usuario

Karcrack

13 Agosto 2008, 13:15 PM Ultima modificación: 15 Agosto 2008, 14:08 PM por Karcrack
Bueno, pues eso, es una funcion que he desarrollado para habilitar el estilo XP en nuestros proyectos de Visual Basic 6.0 sin tener que recurrir a OCX ni Controles de Usuario...

Código (vb) [Seleccionar]
Option Explicit

Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public Function CreateManifest() As Boolean
    'Si hay algun error sigue a la siguiente accion
    On Error Resume Next
    Dim sPath As String
    'Obtenemos la ruta de nuestro ejecutables
    sPath = String$(260, Chr$(0)) 'Gracias Cobein
    sPath = Left$(sPath, GetModuleFileName(App.hInstance, sPath, Len(sPath)))
    'Comprobamos qu eno existe ningun fichero .Manifest _
    'y que no estamos ejecutando la aplicacion desde el Visual Studio
    If App.LogMode = 0 Then Exit Function
    If Dir(sPath & ".manifest", vbReadOnly Or vbSystem Or vbHidden) = vbNullString Then
        'Obtenemos la version del Window$
        If Win2Version = "XP" Then
            'Si es XP significa que es compatible con el metodo Manifest _
            ', por lo tanto crea el fichero
            Open sPath & ".manifest" For Output As #1
                'Le introduce los datos...
                Print #1, FormatManifest
                'Todo ha ido bien...
                CreateManifest = True
            Close #1
            'Estable el fichero como: Oculto/System/SoloLectura/Archivo
            SetAttr sPath & ".manifest", vbHidden Or vbSystem Or vbReadOnly Or vbArchive
            'Y lo vuelve a ejecutar, para que los cambios tengan efecto
            Shell sPath, vbNormalFocus
            End
        End If
    End If
    'LLamamos al API....
    Call InitCommonControls
End Function

Private Function Win2Version() As String
    'Declaramos las variables para esta funcion
    Dim OSInf As OSVERSIONINFO, iRet As Integer
    OSInf.dwOSVersionInfoSize = 148
    OSInf.szCSDVersion = Space$(128)
    'Obtenemos la informacion del Window$
    iRet = GetVersionExA(OSInf)
    'Si no se ha podido obtener correctamente devuelve 'Unknown'
    If iRet = 0 Then Win2Version = "Unk": Exit Function
    With OSInf
        Select Case .dwPlatformId
            Case 1
                Select Case .dwMinorVersion
                    Case 0
                        'En caso de que sea Win95
                        Win2Version = "95"
                    Case 10
                        'En caso de que sea Win98
                        Win2Version = "98"
                    Case 90
                        'En caso de que sea Win Millenium
                        Win2Version = "Mi"
                End Select
            Case 2
                Select Case .dwMajorVersion
                    Case 3 Or 4
                        'En caso de que sea NT (Aqui no he distinguido entre las dos versiones...)
                        Win2Version = "NT"
                    Case 5
                        Select Case .dwMinorVersion
                            Case 0
                                'En caso de que sea Win2000
                                Win2Version = "2000"
                            Case 1
                                'En caso de que sea XP
                                Win2Version = "XP"
                            Case 2
                                'En caso de que sea Win2003 (SERVER)
                                Win2Version = "2003"
                        End Select
                    Case 6
                        'En caso de que sea Win Vista
                        Win2Version = "Vista"
                End Select
            Case Else
                'En caso de que sea que sea desconocido...
                Win2Version = "Unk"
        End Select
    End With
End Function

Private Function FormatManifest() As String
    Dim Header As String
    'Carga el .manifest en una variable
    Header = "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & " standalone=" & Chr(34) & "yes" & Chr(34) & "?>" _
                & vbCrLf & "<assembly xmlns=" & Chr(34) & "urn:schemas-microsoft-com:asm.v1" & Chr(34) & " manifestVersion=" & Chr(34) & "1.0" & Chr(34) & ">" _
                & vbCrLf & "<assemblyIdentity" _
                & vbCrLf & "version=" & Chr(34) & "1.0.0.0" & Chr(34) _
                & vbCrLf & "processorArchitecture=" & Chr(34) & "X86" & Chr(34) _
                & vbCrLf & "name=" & Chr(34) & App.EXEName & ".exe" & Chr(34) _
                & vbCrLf & "type=" & Chr(34) & "win32" & Chr(34) _
                & vbCrLf & "/>" _
                & vbCrLf & "<description>" & App.Comments & "</description>" _
                & vbCrLf & "<dependency>" _
                & vbCrLf & "<dependentAssembly>" _
                & vbCrLf & "<assemblyIdentity" _
                & vbCrLf & "type=" & Chr(34) & "win32" & Chr(34) _
                & vbCrLf & "name=" & Chr(34) & "Microsoft.Windows.Common-Controls" & Chr(34) _
                & vbCrLf & "version=" & Chr(34) & "6.0.0.0" & Chr(34) _
                & vbCrLf & "processorArchitecture=" & Chr(34) & "X86" & Chr(34) _
                & vbCrLf & "publicKeyToken=" & Chr(34) & "6595b64144ccf1df" & Chr(34) _
                & vbCrLf & "language=" & Chr(34) & "*" & Chr(34) _
                & vbCrLf & "/>" _
                & vbCrLf & "</dependentAssembly>" _
                & vbCrLf & "</dependency>" _
                & vbCrLf & "</assembly>"
    FormatManifest = Header
End Function





Aqui esta el codigo, quien quiera descargarlo que lo haga de aqui:
CitarDescarga



Uso:
Simplemente llamando a la funcion CreateManifest se cambia solo el estilo, pero solo funciona cuando esta compilado...



Ah!! Os doy un pequeño aviso:

Por lo visto los chicos de Microsoft tuvieron algunos problemas :xD, porque resulta, que al poner un optionbutton dentro de un frame se queda de color de fondo negro, asi que, os doy la solucion al problema: Meter los controles con los que os pase eso dentro de un Picture... eso lo soluciona ;D

(PGP ID)

cobein

#1
13 Agosto 2008, 19:49 PM Ultima modificación: 13 Agosto 2008, 19:51 PM por cobein
Un poco de feedback

1)

If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function

podrias cambiarlo por If  App.LogMode=0 then exit function <- Edite aca

2)

el buffer de GetModuleFileName de 128 me parece chico tendria que ser
Private Const MAX_PATH As Long = 260 o ver que la funcion no retorne ERROR_INSUFFICIENT_BUFFER en cuyo caso tendras que aumentar el tamaño buffer

3)

Agregar nombre y descripcion en el manifest

4)

Soporte para Vista y sus diferentes manifest

5)
Hay una error grande en el codigo, fijate que si no existe el manifest intenta crear uno si es xp, sino pasa de largo y reinicia la aplicacion de igual manera... y lo vuelve a hacer infinitamente
http://www.advancevb.com.ar
Más Argentino que el morcipan
Aguante el Uvita tinto, Tigre, Ford y seba123neo
Karcrack es un capo.

Freeze.

#2
13 Agosto 2008, 20:01 PM
Yo quite esa linea:

If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function

y ahora tengo un IDE más moderno :xD Como ya te dije en el foro, excelente ;)

Karcrack

#3
13 Agosto 2008, 21:11 PM
Cita de: cobein en 13 Agosto 2008, 19:49 PM
Un poco de feedback

1)

If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function

podrias cambiarlo por If  App.LogMode=0 then exit function <- Edite aca

2)

el buffer de GetModuleFileName de 128 me parece chico tendria que ser
Private Const MAX_PATH As Long = 260 o ver que la funcion no retorne ERROR_INSUFFICIENT_BUFFER en cuyo caso tendras que aumentar el tamaño buffer

3)

Agregar nombre y descripcion en el manifest

4)

Soporte para Vista y sus diferentes manifest

5)
Hay una error grande en el codigo, fijate que si no existe el manifest intenta crear uno si es xp, sino pasa de largo y reinicia la aplicacion de igual manera... y lo vuelve a hacer infinitamente

Muchas gracias por el post, cuando tenga tiempo lo reviso y optimizo el codigo ;)

Pero lo del manifest para vista? da estilo XP? :laugh:

Bueno, lo hago y creo que lo pondre :P



Cita de: Freeze. en 13 Agosto 2008, 20:01 PM
Yo quite esa linea:

If UCase$(Right$(sPath, Len("VB6.EXE"))) = "VB6.EXE" Then Exit Function

y ahora tengo un IDE más moderno :xD Como ya te dije en el foro, excelente ;)

De que IDE estamos hablando? No nos estaras ocultando algo :¬¬ :xD?



Saludos! :D

(PGP ID)

‭‭‭‭jackl007

#4
13 Agosto 2008, 21:34 PM
yo los agregaba con un editor de recursos

Freeze.

#5
13 Agosto 2008, 23:44 PM
CitarDe que IDE estamos hablando? No nos estaras ocultando algo :¬¬ :xD?
Bueno lo que pasa es que quite esa linea pusiste y asi no se comprueba que el codigo no se esta ejecutando en VB osea en el IDE en modo debug. Entonces el codigo crea un archivo llamado VB6.manifest. Resultado:

Karcrack

#6
14 Agosto 2008, 11:38 AM
Cita de: Freeze. en 13 Agosto 2008, 23:44 PM
CitarDe que IDE estamos hablando? No nos estaras ocultando algo :¬¬ :xD?
Bueno lo que pasa es que quite esa linea pusiste y asi no se comprueba que el codigo no se esta ejecutando en VB osea en el IDE en modo debug. Entonces el codigo crea un archivo llamado VB6.manifest. Resultado:



:laugh: :laugh:,menuda IDE mas nueva :xD, la pena es que lo ves diferente a lo que se vera cuando compiles...

(PGP ID)

Karcrack

#7
15 Agosto 2008, 14:07 PM
Version actualizada para solucionar varios problemas, Gracias Cobein :D

(PGP ID)
Imprimir
Ir Arriba Páginas1
Acciones del Usuario