Discussion :

[RastaBomboclat]

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.

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

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 module standard :

Sélectionner tout - Visualiser dans une fenêtre à part

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 module de classe :

Sélectionner tout - Visualiser dans une fenêtre à part

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!

[unparia]

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

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 ...

[RastaBomboclat]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

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).
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.

[RastaBomboclat]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

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"!

Code DLL Module de classe1 VB6 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 DLL Classe ADODBRD VB6 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 Module standard dans Excel :

Sélectionner tout - Visualiser dans une fenêtre à part

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