Attribute VB_Name = "Update"
'######################################
'# Coder par Kozengod #
'# Module de mise a jours automatique #
'######################################
'declaration globale qu'on auras besoin
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long
'fonction appelee
Public Sub MaJ(ByVal Verif As String)
'declaration des variables
Dim errcode As Long
Dim url As String
Dim localFileName As String
Dim Version, Version2 As String
'dans la form ou le bouton pour faire la maj il suffit de mettre :
'Call MaJ("Version")
'se qui appelera la fonction et mettra dans la variable Verif le string "Verif"
'donc le if ci-dessous sera excecuter
If Verif = "Version" Then
'donc on demarre la condition et on stock l'url ou se trouve le numero
'de la version genre 1.4.0 (major, minor et revision)
url = "http://www.machin.com/Version.txt"
'on declare l'endroit ou sera stocker le txt de la version
localFileName = App.Path & "\Version.txt"
'stockage d'une eventuel erreur par l'api ou l'url ou autre
errcode = URLDownloadToFile(0, url, localFileName, 0, 0)
's'il n'y a pas d'erreyr alors
If errcode = 0 Then
'on stock le contenu du txt dans une variable
Version = LoadTxt(App.Path & "\Version.txt")
'on copie la premiere variable dans la deuxieme
Version2 = Version
'on remplace dans l'originale les . par rien afin d'obtenir 140 (dans l'exemple)
Version = Replace(Version, ".", "")
'on verifie si le contenu 140 est superieur ou non a la version actuel
If Version > App.Major & App.Minor & App.Revision Then
'c'est le cas, on previend donc l'utilisateur
MsgBox "Une mise a jour est disponnible" & vbCrLf & "Votre version va etre remplacee", vbInformation, "MaJ"
'vu que le prochain if il faut la valeur MaJ pour l'excecuter on l'y met
Verif = "MaJ"
'sinon on ne rempli pas et il saute le prochain if si la version
'actuel est inferieur ou egale a celle ci
ElseIf Version <= App.Major & App.Minor & App.Revision Then
'on previend qu'il n'y a pas de mise à jours disponnible
MsgBox "Aucune mise a jour n'est disponnible", vbInformation, "MaJ"
End If
Else
's'il y a une erreur par contre donc errcode <> 0 alors on previend
MsgBox "Erreur durant le téléchargement du fichier de verification de Version", vbExclamation, "Erreur"
End If
'on supprime le fichier "temporaire" qui contenais la version precedement telecharger
Kill App.Path & "\Version.txt"
'ici un peu long à expliquer, en gros par la precedente api on telecharge
'mais comme il garde en mémoire l'url et le contenu de ce uqi a été telecharger
'alors on lui dis tu vire ca comme si on ne l'avais jamais telecharger ni regarder
'ni rien, car sinon il peux retelecharger x fois le fichier meme s'il a changer
'l'api croira qu'il est toujours identique au premier telecharger, meme si le fichier
'a ete supprimer il reste en memoire, ce qui est assez embetant dans pas mal
'd application, par reflexe quand j utilise cette api je met celle ci avec ^^
Call DeleteUrlCacheEntry(url)
End If
'donc si la version du fichier est supperieur il permet cette condition
If Verif = "MaJ" Then
'donc on met en memoire l'url ou se trouve le mise a jours structurer de la maniere suivante:
'un nom V. contenu de version2 (ici 1.4.0 pour l'exemple).rar
'ce qui pourrais donner disons que la maj est la version 1.5.6 et que votre prog s'appelle machin
'url/machin V.1.5.6.rar
url = "http://www.machin.com/GBB V." & Version2 & ".rar"
'idem on dis on sera stocker le fichier rar
localFileName = App.Path & "\GBB V." & Version2 & ".rar"
'on restock les eventuel erreurs
errcode = URLDownloadToFile(0, url, localFileName, 0, 0)
'si erreur il n'y a alors il avertira et telechargera et fermera le programme
If errcode = 0 Then
MsgBox "La mise a jours a bien pu etre effectué." & vbCrLf & "Il vous suffit d'extraire l'archive de mise a jours et remettre votre" & vbCrLf & "fichier INI de configuration personnel si vous en avez un" & vbCrLf & "a la place de celui extrait et d'executer l'exe" & vbCrLf & "N'oubliez pas de supprimer les anciens fichiers ou de les remplacer par les nouveaux. " & vbCrLf & "Bon Surf." & vbCrLf & "Kozengod", vbInformation, "MaJ"
End
Else
MsgBox "Erreur durant le téléchargement de la mise a jours", vbExclamation, "Erreur"
End If
'idem il deletera de la memoire le fichier telecharger au cas ou ^^
Call DeleteUrlCacheEntry(url)
End If
End Sub
Public Function LoadTxt(ByRef vsFilePath As String) As String
'autre fonction qui permet de lire et stocker le contenu d'un fichier simplement
'limiter mais ici comme c'est un petit fichier cela reste une bonne solution
Dim hFile As Integer
hFile = FreeFile
Open vsFilePath For Input As #hFile
LoadTxt = Input$(LOF(hFile), #hFile)
Close #hFile
End Function