Forum ViSiBLe

Bem Vindo
Se registrares neste fórum, podes fazer parte da nossa comunidade.Prezamos aqui pela participação ACTIVA de cada membro.


Atençao: Nao precisa Confirma a sua conta no hotmail (Basta Registrar e Começar a participar do forum.)

WWW.FORUMVISIBLE.COM

Temos vagas na STAFF !! Clique Aqui!

Seu programa com Manifest automatico

Compartilhe
avatar
MrViSiBLe
Administrador
Administrador

Número de Mensagens : 3776
Idade : 24
Localização : Cuiaba
Agradecimentos Agradecimentos : 864
Data de inscrição : 10/12/2008

Seu programa com Manifest automatico

Mensagem por MrViSiBLe em 10/6/2010, 01:05

Componentes:
1 × Module
1 × CommandButton

No CommandButton coloque
Private Sub Command1_Click()
'by: PosuiT \/ --------
InitCommonControls
'------------------------
'========\/ by Ruisu/L Souza ==========
On Error Resume Next
XPVB
MsgBox "Manifest escrito. Por favor reinicie o " & App.ProductName & " para ver os efeitos.", vbInformation
End Sub
'===========/\ by Ruisu/L Souza ========

Ou coloque no form_load

Private Sub Form_Load()
'by: PosuiT \/ --------
InitCommonControls
'------------------------
On Error Resume Next
XPVB
End Sub

E no module:

Public JustMade As Boolean

Public Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
'by: PosuiT \/ ----------------------------------------------------
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()
'---------------------------------------------------------------------
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Const ICC_USEREX_CLASSES = &H200

Public Function XPVB() As Boolean
On Error Resume Next
If Dir(MyManifestFile) <> "" Then GoTo Written
Dim XPStr As String
Dim FF As Integer
XPStr = "" & vbCrLf & _
"" & vbCrLf & _
"" & vbCrLf & _
"" & App.ProductName & " manifest file" & vbCrLf & "" & vbCrLf & _
"" & vbCrLf & "" & vbCrLf & _
"
" & vbCrLf & "
" & vbCrLf & "
"
FF = FreeFile
Open MyManifestFile For Output As #FF
Print #FF, XPStr
Close #FF
JustMade = True
Written:
Dim iccex As tagInitCommonControlsEx
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControlsEx iccex
XPVB = (Err.Number = 0)
On Error GoTo 0
End Function

Public Function MyManifestFile() As String
On Error Resume Next
MyManifestFile = FindPath(App.Path, App.EXEName & ".exe.manifest")
End Function

Public Function FindPath(Parent As String, Optional Child As String, Optional Divider As String = "") As String
On Error Resume Next
If Right$(Parent, 1) = Divider Then Parent = Left$(Parent, Len(Parent) - 1)
If Left$(Child, 1) = Divider Then Child = Mid$(Child, 2)
FindPath = Parent & Divider & Child
End Function

    Data/hora atual: 8/22/2017, 09:02