[dot]EXE – All About IT & Electro Engineering

Tutorial VB6 – AutoCreate Manifest File

Posted by: kulinet on: 9 Mei 2008

Panahbiru membagi code buat kami, untuk membuat Manifest file otomatis bagi software yang kita compile dengan VB6. Dengan demikian software kita akan bekerja sebagaimana mestinya.

'**************************************
'Windows API/Global Declarations for :_
' Automatically Create Manifest File _
'**************************************
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
On Error Resume Next
Dim EXEPath As String
'Get The EXE Path
EXEPath = App.Path & IIf(Right(App.Path, 1) = "\", vbNullString, "\")
EXEPath = EXEPath & App.EXEName & IIf(LCase(Right(App.EXEName, 4)) = ".exe", ".manifest", ".exe.manifest")
'Checks if the manifest has already been
' created
If Dir(EXEPath, vbReadOnly Or vbSystem Or vbHidden) vbNullString Then Goto ErrorHandler
'Makes sure you are using windows xp
If WinVersion = "Windows XP" Then
Dim iFileNumber As Integer
iFileNumber = FreeFile
'Save the .manifest file
Open EXEPath For Output As #iFileNumber
Print #iFileNumber, FormatManifest
CreateManifest = True
Else
Kill EXEPath
End If
'set the file to be hidden
Close #iFileNumber
SetAttr EXEPath, vbHidden Or vbSystem Or vbReadOnly Or vbArchive
ErrorHandler:
Call InitCommonControls
End Function
'get windows version (from Microsoft.com' )
Private Function WinVersion() As String
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
With osinfo
Select Case .dwPlatformId
Case 1
If .dwMinorVersion = 0 Then
WinVersion = "Windows 95"
ElseIf .dwMinorVersion = 10 Then
WinVersion = "Windows 98"
End If
Case 2
If .dwMajorVersion = 3 Then
WinVersion = "Windows NT 3.51"
ElseIf .dwMajorVersion = 4 Then
WinVersion = "Windows NT 4.0"
ElseIf .dwMajorVersion >= 5 Then
WinVersion = "Windows XP"
End If
Case Else
WinVersion = "Failed"
End Select
End With
End Function
'Create the string for the manifest file
'
Private Function FormatManifest() As String
Dim Header As String
Header = ""
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & "Microsoft Visual Basic 6 IDE"
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & ""
Header = Header & vbCrLf & ""
FormatManifest = Header
End Function

source code ini dapat dilihat dari sini, dan sudah teruji.

Tinggalkan Balasan

Blog Stats

  • 369,331 hits

Posisi


Target Bulan November, Posisi

50

besar Blog Indonesia.
Selangkah lagi melampau target Target Hit stats bulan ini

380.000

.

Download Free

 

Teratas

Tweetme

Yang Sedang Baca:

counter

counter

Langganan Blog ini

Radio Gan !

KasKusRadio - Indonesian Radio

Iklan

Pesan/Konfirmasi: 085225733685 - dotexenator[at]gmail.com



Ubuntu 9.10 LiveUSB Versi terbaru Ubuntu, edisi 9.10 (Karmic Koala) dalam versi LiveUSB, cocok untuk Netbook ataupun Notebook. Instalasi Ubuntu linux tanpa perlu CDROM. Spek: USB FD Kingston 2GB, 2 Partisi (System & Data), Box, Mini How To Use LiveUSB. Mulai Rp 150.000,-

Ubuntu 9.10 CD Versi terbaru Ubuntu 9.10 Karmic Koala, versi CD Desktop Edition i386 & amd, x86_74 dan amd64. Diskon 10% untuk 10 order pertama di bulan November. Per CD Rp 10.000,- + Ongkos kirim, Tersedia paket 10, 20, 50 dan 100 CD.

Ubuntu 9.10 Repository Repository Ubuntu 9.10 Karmic Koala untuk i386, dalam DVD. Mulai Rp 20.000,- per DVD + Ongkos kirim, tersedia paket 10, 20,50 DVD.

Flag Counter

free counters