Créer un module de date d’expiration d’une application (comme un trial)

Bonjour à tous,

Je reviens avec une nouvelle question concernant la durée d’utilisation d’une application dans le temps.
En effet, j’ai créé une petite application (pour la boite où je travail) qui fonction très bien et un visiteur intéressé nous l’a demandé pour pouvoir aussi le tester chez eux. Mais étant donné que ce ne sera qu’un teste je dois y mettre une date d’expiration qui bloque tout après la date de validité du teste. Après quelques recherche sur le net j’ai vu ce qu’on appelle en anglais «time-bombing as workbook» Mais les codes proposé ne m’ont pas trop convaincu.

Je ne sais pas très bien où commencer pour créer un module d’expiration de l’application. Je signale aussi que je ne domine pas encore les Module Class, seulement les Module normaux. Je ne sais pas grand-chose du tout du tout aux API. Mais pour le reste ça va.

Merci d’avance pour votre aide.

Bonne année, vu que c’est ma première visite cette année dans le forum.

Bonjour,

Je ne connais pas le time bombing .... Une solution simple mais peu robuste serait de passer par les évènement ouverture classeur comme (et de protéger le code VBA)
=> On ferme le classeur sans notification si la date actuelle est supérieure à une date de référence

Code:

---

1 2 3 4

Private Sub Workbook_Open()   If Now() > "01/01/2017" Then Application.DisplayAlerts = False: ThisWorkbook.Close End Sub

---

Bonjour,
Visual studio 6 est passe dans le domaine public , il est accessible en téléchargement, il n'est pas facile à trouver mais je vais regarder pour donner un lien!

Vb6 fonctionne comme VBA moyennant quelques aménagements, il utilise des module de classe que tu enregistre dans un projet DLL! donc tu fourni la DLL à ton client, il ne peut pas voire le code mais ta macro VBA peut l'utiliser.

tu reformate ton code dans un module de classe, tu l'exporte vers un fichier, puis tu ajoute ce fichier ans un projet Vb6 (DLL).

regarde la différence entre entre une sub faisant appel à un code en ligne, avac fonction et un module de classe!

Code:

---

1 2 3 4 5 6 7 8 9

Sub Test() MsgBox "toto" MsgBox message("toto") Dim msg As New Classe1 MsgBox msg.Lemessage("toto") End Sub Function message(txt As String) As String message = txt End Function

---

Code:

---

1 2 3

Public Function Lemessage(txt As String) As String Lemessage = txt End Function

---

Pour l'instant je cherche encore comment interroger l'horloge parlante pour éviter que l'utilisateur change l'heure de l’ordinateur!

Bonjour
Nous sommes ici dans la section VBA/Excel
Dans ces conditions :

Citation:

---

Je reviens avec une nouvelle question concernant la durée d’utilisation d’une application dans le temps.

---

ne saurait concerner (sinon relevant d'une autre section de VB) qu'un classeur Excel. Et dans ce cas :
Ne perds pas ton temps. Toute tentative de protection de ce genre serait "cassée" en quelques secondes par n'importe quel "casseur" quelque peu averti, voire seulement "débrouillard"..
Bien évidemment, maintenant : il ne "casserait" que ce qui vaut d'être "cassé". Et si "ne vaut pas d'être cassé", aucun véritable intérêt à protéger ... ;)

Citation:

---

Envoyé par vinc_bilb

Bonjour,

Je ne connais pas le time bombing .... Une solution simple mais peu robuste serait de passer par les évènement ouverture classeur comme (et de protéger le code VBA)
=> On ferme le classeur sans notification si la date actuelle est supérieure à une date de référence

Code:

---

1 2 3 4

Private Sub Workbook_Open()   If Now() > "01/01/2017" Then Application.DisplayAlerts = False: ThisWorkbook.Close End Sub

---

---

Merci pour le code. Il est simple et cours et facilement utilisable. Je pourrais l'utiliser dans d'autre appli.
Concernant la situation dans laquelle je me trouve, il me faudrait quelque chose de plus costaud mais simple d'utilisation pour mois qui ne suis ni expert ni confirmé ou éclairé en VBA_Excel. Au fait je pense au cas où un petit malin changerai la date de l'ordi. J'ai vue un code qui où on a mis que le comptage se fasse a partir de la date de la premiere utilisation du fichier. Non pas en comptant par la date de l'ordinateur mais à partir de la date d'utilisation du fichier compter le nombre de jour ecoulé sans tenir compte de la date de l'ordinateur afficher.

Je continue aussi a chercher de mon coté. Merci pour ton code, je le garde précieusement.

Citation:

---

Envoyé par unparia

Bonjour
Nous sommes ici dans la section VBA/Excel
Dans ces conditions :

ne saurait concerner (sinon relevant d'une autre section de VB) qu'un classeur Excel. Et dans ce cas :
Ne perds pas ton temps. Toute tentative de protection de ce genre serait "cassée" en quelques secondes par n'importe quel "casseur" quelque peu averti, voire seulement "débrouillard"..
Bien évidemment, maintenant : il ne "casserait" que ce qui vaut d'être "cassé". Et si "ne vaut pas d'être cassé", aucun véritable intérêt à protéger ... ;)

---

Oui j'ai vu ça quelque part, où on recommendais d'ailleurs d'utiliser Add-In Express. Mais VB c'est pas mon fort. J'ai commencer a l'ecole avec Access et je suis passé a VBA_Excell dans la vie professionnelle oubliant tout ce que j'avais appris a l'ecole en Access(aujourd'hui les relations et sql me:arf:).
Mais je vais voir avec la réponse de "dysorthographie" si je pourrais m'ensortir. Sinon, j'ai l'impression que c'est un beau cadeau de nouvel an que je ferai à notre visiteur chanceux.

Bonjour,

J’ai trouvé quelques solutions ICI. Mais je ne vais pas encore les utiliser. J’attends les réponse de dysorthographie avec la méthode via DLL qui est plus protéger que les codes VBA.

un exemple de code du lien.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40

Option Explicit Private Const C_NUM_DAYS_UNTIL_EXPIRATION = 30   Sub TimeBombWithDefinedName() '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' TimeBombWithDefinedName ' This procedure uses a defined name to store this workbook's ' expiration date. If the expiration date has passed, a ' MsgBox is displayed and this workbook is closed. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim ExpirationDate As String Dim NameExists As Boolean   On Error Resume Next ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2) If Err.Number <> 0 Then ''''''''''''''''''''''''''''''''''''''''''' ' Name doesn't exist. Create it. ''''''''''''''''''''''''''''''''''''''''''' NameExists = False ExpirationDate = CStr(DateSerial(Year(Now), _ Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION)) ThisWorkbook.Names.Add Name:="ExpirationDate", _ RefersTo:=Format(ExpirationDate, "short date"), _ Visible:=False Else NameExists = True End If   '''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If the today is past the expiration date, close the ' workbook. If the defined name didn't exist, we need ' to Save the workbook to save the newly created name. '''''''''''''''''''''''''''''''''''''''''''''''''''''' If CDate(Now) > CDate(ExpirationDate) Then MsgBox "This workbook trial period has expired.", vbOKOnly ThisWorkbook.Close savechanges:=False End If   End Sub

---

tu trouvera ICI le lien pour télécharger visuel studio 6

Pièce jointe 238894

Pièce jointe 238953



Pièce jointe 238946


Pièce jointe 238926
Pièce jointe 238931Pièce jointe 238933Pièce jointe 238939

Comme tu peux le voir, avec p.Message("toto") le code est inaccessible!

Pour ceux qui pensent qu'il est possible de faire des applications professionnel avec VBA; je leurs répond qu'il est possible de s'approcher, mais professionnel non...


Quand on voit les possibilités de Visual studio en natifs, avec VBA on est loin du compte, sur tout que maintenant il est gratuit!en soit VBA n'est pas professionnel donc tout ce qui en émane ne l'est pas!

Bonjour dysorthographie,
Merci pour tout ces lien et details. Je m'y mets tout de suite. j'ai en effet jusqu'à lundi prochain pour presenter mon travail. je pense que j'y arriverai.

En cas de besion, je reviendrai :D

:plusser::king::merci:

bonjour RastaBomboclat,
pas de souci, si tu as besoin d'un coach! dans la mesure de mes disponibilités, pas de problème (peut-être as tu toujours mon mail rdurupt) .

le code pour la licence c'est que des 000 (zéro)

Code:

---

1 2 3 4 5 6 7

Private Sub Class_Initialize() If Date > "28/02/2017" Then Err.Raise 1664, "Microsoft Excel", "Bonjour vas donc boire une bière à ma santé!" End Sub Public Function Message(t As String) As String Message = t End Function

---

Merci beaucoup du soutient.
On est bel est bien dans Developpez.net. J'adore ce site:D:P:ccool:

Bonjour,

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Private Sub UserForm_Initialize() Me.Label1 = NavigateDate("http://ntp.alapetite.fr/date.txt.php") End Sub     Private Function NavigateDate(ByVal address As String) As String If Trim("" & address) = "" Then Exit Function If address = "about:blank" Then Exit Function   On Error Resume Next WebBrowser1.Navigate address NavigateDate = WebBrowser1.Document.GetElementsByTagName("html").Item(0).Document.body.innertext End Function

---

Je suis encore coincé au niveau de l'installation de VB6.
J’avais pu télécharger les fichiers via le site que tu m’avais envoyé mais je n’arrive toujours pas à installer l’application parce que la décompression du fichier télécharger ce fait avec 2 erreurs (fichier .ini et un autre dont je ne me rappelle pus l’extension). Et quand je tente d’installer ça ne marche pas.
Quelqu’un m’a promis un disque d’installation (qu’il doit chercher dans ces archives…) et peut être que demain je pourrais l’avoir et commencer le travail. Je travaillerai le weekend apparemment:?:(

Bonjour
Il faut créer un répertoire sur c:\ et ensuite copier le fichiers dedans et un click droit sur le setup.exe et en tant qu'admin,

Citation:

---

Envoyé par dysorthographie

Bonjour
Il faut créer un répertoire sur c:\ et ensuite copier le fichiers dedans et un click droit sur le setup.exe et en tant qu'admin,

---

Merci, ça marche bien:merci:.
J’ai déjà fait les principaux formulaires mais je suis bien coincé. Eh oui, sur VBA, je fesais référence à l'objet worksheet pour mes données sur la feuille Excel. Mais là, il n’y a pas de worksheet. Et jusque là, j’arrive a bien m’en sortir :| avec mes lignes de codes VBA qui sont bien accepter dans VB6.

Afin de manipuler mes donnée, j’ai créé, en me débrouillant, une petite base de données sur Access. Avec 5 petites Tables (Tbl_Supplier ;Tbl_Invoices ; Tbl_Projects ; Tbl_Payment et Tbl_Bank qui est vraiment facultatif). Les relations et quelques requêtes sélections que j'ai fait semblent fonctionner correctement. Le problème maintenant c’est de connecter la base aux formulairex, et bien référencer les tables et les colonnes à prendre.

J’ai vu, çà et là sur le Net, quelques codes VBA pour la connexion Excel vs Access, mais ça m’a l’air d’astuces pour avancés et chevronnés. C’est du nouveau pour moi le VBA-SQL:calim2:

Bonjour RastaBomboclat,

oui Vb6 c'est comme vba quand tu veux utiliser Word, il faut déclarer le références; mais je te conseil d'utiliser des objet "Object"!

Pièce jointe 241139

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Public Enum ConstXls xlWhole = 1 xlPart = 2 End Enum Public cn As New ADODBRD Public Function NewExcel() As Object Set NewExcel = CreateObject("Excel.Application") End Function Public Function NewClasseur(XlApp As Object) As Object Set NewClasseur = XlApp.Workbooks.Add End Function Public Function NewFeuille(Claseur As Object) As Object Set NewFeuille = Claseur.Sheets.Add End Function     Public Function SerchXls(Myrange As Object, MyCellule As Object, strRecherche, EntierCell As ConstXls, EnBoucle As Boolean) As Long ' On Error Resume Next SerchXls = 0 SerchXls = Myrange.Cells.Find(What:=strRecherche, After:=MyCellule, LookIn:=-4123, LookAt _ :=EntierCell, SearchOrder:=1, SearchDirection:=1, MatchCase:= _ False, SearchFormat:=False).Row If SerchXls <= MyCellule.Row And EnBoucle = False Then SerchXls = 0 End Function

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237

Private Connexion Public TYPEBASE As MyAdo Public BASE Public Server Public Fichier Public User Public PassWord Enum MyAdo ACCESS97 = 1 ACCESS2000 = 2 ACCESS2012 = 3 ODBC = 4 ORACLE = 5 SQLSERVER2005 = 6 SQLServer2008R2 = 7 SQLite = 8 SQLite3 = 9 CSV = 10 ExcelSensTire = 11 ExcelAvecTire = 12 End Enum     Private Function GenereCSTRING() 'Permet de générer le Cornec String '1 - ACCESS 97 '2 - ACCESS 2000 '3 - ACCESS 2012 '4 - ODBC '5 - ORACLE '6 - SQL SERVER 2005 '7 - SQL Server 2008 R2 '8 - SQLite '9 - SQLite3 If Trim("" & Fichier) = "" Then Fichier = BASE     Select Case TYPEBASE Case ExcelAvecTire GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";Extended Properties=""Excel 12.0;HDR=YES;""" Case ExcelSensTire GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BASE & ";Extended Properties=""Excel 12.0;HDR=no;""" Case ACCESS97 GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & Fichier Case ACCESS2000 GenereCSTRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Persist Security Info=False" Case ACCESS2012 GenereCSTRING = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";"   Case ODBC GenereCSTRING = "Provider=MSDASQL.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & BASE Case ORACLE GenereCSTRING = "Provider=OraOLEDB.Oracle.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Data Source=" & BASE Case SQLSERVER2005 GenereCSTRING = "Provider=SQLOLEDB.1;Password=" & PassWord & ";Persist Security Info=True;User ID=" & User & ";Initial Catalog=" & BASE & ";Data Source=" & Server Case SQLServer2008R2 GenereCSTRING = "Provider=SQLNCLI;Server=" & Server & ";Database=" & BASE & ";UID=" & User & ";PWD=" & PassWord & ";" Case SQLite GenereCSTRING = "Provider=OleSQLite.SQLiteSource.3; Data Source=" & Fichier GenereCSTRING = "Driver={SQLite ODBC (UTF-8) Driver};Database=" & Fichier & ";StepAPI=;Timeout=" Case SQLite3 GenereCSTRING = "Driver={SQLite3 ODBC Driver};Database=" & Fichier & ";LongNames=0;Timeout=4000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;" Case CSV GenereCSTRING = "ODBC;DBQ=" & Fichier & ";Driver={Microsoft Text Driver (*.txt; *.csv)}; " & "DriverId=27;Extensions=txt,csv,tab,asc;FIL=text;MaxBufferS" Connex.Open Case Else GenereCSTRING = "PAS ASSEZ DE PARAMETRES RENSEIGNES !!!"         End Select ''MsgBox GenereCSTRING 'Response.End End Function Public Function OpenConnetion() 'Ouvre une connexion à la base de données. 'Dim Fso As New Scripting.FileSystemObject OpenConnetion = False On Error Resume Next Dim ConnecString     Dim NbErr     Set Connexion = CreateObject("ADODB.Connection") Connexion.Open GenereCSTRING 'ConnecString     If Err = 0 Then     OpenConnetion = True Connexion.CommandTimeout = 14400 Else ' MsgBox Err.Description     End If ' Debug.Print Err.Description Err.Clear On Error GoTo 0 End Function         Public Function CloseConnection() 'Referme la connexion CloseConnection = False On Error Resume Next Connexion.Close Set Connexion = Nothing If Err = 0 Then CloseConnection = True End If Err.Clear On Error GoTo 0 End Function         Public Function OpenRecordSet(Sql) 'Retourne un RecordeSet On Error Resume Next Dim Rs Dim NbErr     Err.Clear If Connexion.State = 0 Then OpenConnetion End If 'Debug.Print Sql 'Replace(Sql, "%", "*") Set OpenRecordSet = CreateObject("ADODB.Recordset")     ' OpenRecordSet.LockType = adLockOptimistic ''MsgBox adLockOptimistic & vbcrlf & Err.Description OpenRecordSet.Open Sql, Connexion, 1, 3     If Err Then ' MsgBox Err.Description     NbErr = NbErr + 1 If NbErr < 11 Then     Set OpenRecordSet = Nothing         End If     End If Err.Clear     End Function Public Function RetournConnection() Set RetournConnection = Connexion End Function Public Function OpenRecordSetParametre(Sql, Param) Dim Commande Dim Params Set Commande = CreateObject("ADODB.Command") Dim MyParameter Set MyParameter = CreateObject("ADODB.Parameter") Set Commande.ActiveConnection = Connexion Commande.CommandText = "select Requête2.* from Requête2;" Commande.CommandType = adCmdText     Set MyParameter = Commande.CreateParameter("[NumJob]", adNumeric) MyParameter.Value = 10 Commande.Parameters.Append MyParameter             'aa.Parameters.Append("MyRef") = "243410M660" Set Rs2 = Commande.Execute     End Function Public Function CloseRecordSet(Rs) On Error Resume Next Rs.Close Set CloseRecordSet = Nothing End Function Public Function Execute(Sql) Execute = False On Error Resume Next Dim NbErr Reprise: If Connexion.State = 0 Then OpenConnetion End If Debug.Print Sql Connexion.Execute Sql If Err = 0 Then Execute = True                 ' Else ' 'MsgBox Err.Description ' Err.Clear ' NbErr = NbErr + 1 ' If NbErr < 11 Then ' ' GoTo Reprise ' End If Else MsgBox Err.Description End If     Err.Clear     End Function

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub test() Dim p As New Project1.Classe1, xl As Excel.Application, wb As Workbook, sh As Worksheet Set xl = p.NewExcel: xl.Visible = True Set wb = p.NewClasseur(xl) Set sh = p.NewFeuille(wb) sh.Range("D3") = "toto" If CBool(p.SerchXls(sh.Columns("D:D"), sh.Range("D1"), "toto", xlWhole, False)) Then MsgBox "Le numéro de commande est déja utilisé." End If p.cn.TYPEBASE = ACCESS2012: p.cn.BASE = "C:\Users\rdurupt\Desktop\AccessBd\Test.accdb" p.cn.OpenConnetion Set Rs = p.cn.OpenRecordSet("select * from [table]") sh.Range("D3").CopyFromRecordset Rs End Sub

---