Optimisation VBscript HTA

Invité · 10/04/2019, 16h07

Bonjour
J'ai quelques aprioris sur la mise en œuvre de mon script.
Il fonctionne mais, je pense qu'il est possible de simplifier les choses
Comme par exemple le fait que j’établis plusieurs connexions à mon serveur et que je rappelle aussi plusieurs fois certain paramètres.
Avis aux plus perfectionnistes

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
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
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
<!-- 'Informations de connexion:
'URL du serveur phpMyAdmin:
'IP_SERVEUR/localhost/locationposte/location

'Requête SQL:
'SELECT *
'FROM location
'WHERE ( `DefaultPrinter` LIKE '%Printer_Name%')
'OR ( `2ndPrinter` LIKE '%Printer_Name%')
'OR ( `3rdPrinter` LIKE '%Printer_Name%')
'OR ( `4thPrinter` LIKE '%Printer_Name%')
'OR ( `5thPrinter` LIKE '%Printer_Name%')


'SELECT *  FROM `location` WHERE `ClientName` LIKE 'non-du-pc' ORDER BY `ClientName` ASC

'Prérequis:
'mysql-connector-odbc-8.0.14-win32.msi

'Configuration sous OS 64 bits:
'Depuis l’application "odbcad32" disponible en C:\Windows\SysWOW64.
'Sous l’onglet : Sources de données système => Ajouter.
'Sélectionner le bon pilote dans la liste et le configurer. -->

<HTML>
        <HEAD>
        <TITLE> SQL BBD Printers Request </TITLE>
                <HTA:APPLICATION
         ApplicationName = "SQL BBD Printers Request"
         Id="SQL BBD Printers Request"
         BORDER="dialog"
         BORDERSTYLE="complex"
         MAXIMIZEBUTTON="no"
         SCROLL="no"
         ICON="PHP_icon.ico"
                >
   </HEAD>
<SCRIPT language="VBScript" type="text/VBScript" >
'------------------------------------------------------------------------------------------------------------------
 
OPTION Explicit
 
        Dim StrDataSource
        Dim StrInitialCatalog
        Dim StrTableName
        Dim StrUserId
        Dim StrPassword
        Dim StrPort
        Dim ObjConnection
        Dim ObjRecordset
        Dim StrConnectionString
        Dim ObjMySQL
        Dim ErrMsg
        Dim StrColumnDefaultPrinter, StrColumn2ndPrinter, StrColumn3rdPrinter, StrColumn4thPrinter, StrColumn5thPrinter
        Dim PrinterName
        Dim strSelectedValues
        Dim i
        Dim StrColumnClientName
        Dim MsG
 
        StrDataSource = "IP_SERVEUR"
        StrInitialCatalog = "locationposte" 'BDD
        StrTableName = "location" 'Table
        StrUserId = "read" 
        StrPassword = "read"
        StrPort = "3306" 
        StrColumnClientName = "ClientName"
        StrColumnDefaultPrinter = "DefaultPrinter"
        StrColumn2ndPrinter = "2ndPrinter"
        StrColumn3rdPrinter = "3rdPrinter"
        StrColumn4thPrinter = "4thPrinter"
        StrColumn5thPrinter = "5thPrinter"      
 
Sub Window_Onload()
 
    self.ResizeTo 550,550      
 
End Sub
 
sub checkEnter
        If document.parentWindow.event.KeyCode = 13 Then Call run
End sub
 
Sub run
 
        PrinterName = TxtPrinterName.value
 
        If PrinterName = "" Then
                MsgBox "Attention: ce champ ne peut étre vide!"
                Exit Sub
        End If
 
        StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver}; SERVER=" & StrDataSource & _
                                                                                                                                ";PORT=" & StrPort & _
                                                                                                                                ";DATABASE=" & StrInitialCatalog & _
                                                                                                                                ";UID=" & StrUserId & _
                                                                                                                                ";PASSWORD=" & StrPassword &_
                                                                                                                                ";OPTION=3"
 
        ObjMySQL = "SELECT * FROM " & StrTableName & " WHERE (`" & _
                                                                        StrColumnDefaultPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn2ndPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn3rdPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn4thPrinter & "` LIKE '%" & PrinterName & "%') OR (`" & _
                                                                        StrColumn5thPrinter & "` LIKE '%" & PrinterName & "%')" 
 
        Set ObjConnection = CreateObject("ADODB.Connection")
        Set ObjRecordset = CreateObject("ADODB.Recordset")
 
        On Error Resume Next
        ObjConnection.Open StrConnectionString
 
        If err.number = -2147467259 Then
                If instr(1,Err.Description,"server") <> 0 Then
                        ObjConnection.Close
                        ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                & "Hôte de serveur MySQL inconnu!" & vbCrLf _
                        & "Vérifier votre connexion réseau, la nom ou l'adresse IP du serveur." & vbCrLf _
                        & "Vérifier aussi que vous possédez les droits nécessaire."
                        MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                End If
 
                If instr(1,Err.Description,"database") <> 0 Then
                        ObjConnection.Close
                        ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                        & "Accès refusé pour l'utilisateur (" & StrUserId & ") Sur la BDD (" & StrInitialCatalog & ") !" & vbCrLf _
                        & "Vérifier son nom et que vous possédez les droits nécessaire."
                        MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                End If                  
        Else
                ObjRecordset.Open ObjMySQL,ObjConnection
                If err.number = -2147217865 Then
                        If instr(1,Err.Description,"Table") <> 0 Then
                                ObjConnection.Close
                                ErrMsg = "Erreur N°" & Err.Number & vbCrLf _
                                & "La table " & StrTableName & " n'existe pas ou est injoignable !" & vbCrLf _
                                & "Vérifier son nom et que vous possédez les droits nécessaire."
                                MsgBox ErrMsg, vbCritical, "Erreur MySQL"
                        End If
        Else
        Dim oOption, V 
        'vide la liste
        For V = LstClient.length To 0 Step -1: LstClient.Remove (V): Next
        V=0
                While Not ObjRecordset.EOF
                        'ajoute les noms à la liste 
                        Set oOption = document.createElement("OPTION")
                        oOption.Text = ObjRecordset.fields("ClientName")
                        oOption.Value = "Option " & V
                        LstClient.Add (oOption)
                V = V + 1               
                        ObjRecordset.MoveNext
        Wend
 
                ObjRecordset.Close: Set ObjRecordset = Nothing
                ObjConnection.Close: Set ObjConnection = Nothing
 
        If V = 0 Then
                Set oOption = document.createElement("OPTION")
                oOption.Text = "Aucun enregistrement disponible pour cette requête"
                oOption.Value = V
                LstClient.Add (oOption)
                LstClient.disabled = "disabled"
        Else
                LstClient.disabled = ""
                        'MsgBox V & " Client(s) trouvée(s)"
                        document.getElementById("txtNbClient").Value = V & " Client(s) trouvée(s)"
                End If
        End If
End If
 
End Sub 
 
Sub showchange()
 
        Set ObjConnection = CreateObject("ADODB.Connection")
        Set ObjRecordset = CreateObject("ADODB.Recordset")
 
        StrConnectionString = "DRIVER={MySQL ODBC 8.0 Unicode Driver}; SERVER=" & StrDataSource & _
                                                                                                                                ";PORT=" & StrPort & _
                                                                                                                                ";DATABASE=" & StrInitialCatalog & _
                                                                                                                                ";UID=" & StrUserId & _
                                                                                                                                ";PASSWORD=" & StrPassword &_
                                                                                                                                ";OPTION=3"
 
        ObjConnection.ConnectionString = StrConnectionString
        ObjConnection.Open      
 
        For i = 0 to (LstClient.Options.Length - 1)
                If (LstClient.Options(i).Selected) Then
                        strSelectedValues = LstClient.Options(i).Text
        Exit For 
                End If
        Next
 
        ObjMySQL = "SELECT *  FROM " & StrTableName & " WHERE (`" & StrColumnClientName & "`  LIKE '%" & strSelectedValues & "%')"
 
        ObjRecordset.Open ObjMySQL, ObjConnection
 
        'MsgBox strSelectedValues
        'MsgBox ObjMySQL
 
        MsG = "Client: " &  ObjRecordset.Fields("ClientName") & vbNewLine & "ID: " & ObjRecordset.Fields("id")
 
        If Not IsNull(ObjRecordset.Fields(StrColumnDefaultPrinter)) Then
                MsG = MsG & vbNewLine & "DefaultPrinter: " & ObjRecordset.Fields(StrColumnDefaultPrinter)
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn2ndPrinter)) Then
                MsG = MsG & vbNewLine & "2ndPrinter: " & ObjRecordset.Fields(StrColumn2ndPrinter)
        Else
                MsG = MsG & vbNewLine & "2ndPrinter: Null"
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn3rdPrinter)) Then
                MsG = MsG & vbNewLine & "3rdPrinter: " & ObjRecordset.Fields(StrColumn3rdPrinter)
        Else
                MsG = MsG & vbNewLine & "3rdPrinter: Null"              
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn4thPrinter)) Then
                MsG = MsG & vbNewLine & "4thPrinter: " & ObjRecordset.Fields(StrColumn4thPrinter)
        Else
                MsG = MsG & vbNewLine & "4thPrinter: Null"      
        End If
 
        If Not IsNull(ObjRecordset.Fields(StrColumn5thPrinter)) Then
                MsG = MsG & vbNewLine & "5thPrinter: " & ObjRecordset.Fields(StrColumn5thPrinter)
        Else
                MsG = MsG & vbNewLine & "5thPrinter: Null"                      
        End If
 
        'MsgBox MsG, vbInformation, "Rapport"
 
        document.getElementById("txtAffiche").Value = MsG
 
        ObjRecordset.Close: Set ObjRecordset = Nothing
        ObjConnection.Close: Set ObjConnection = Nothing    
 
End Sub  
 
'------------------------------------------------------------------------------------------------------------------
  </SCRIPT>
        <Body>
                <b>Saisir le nom de l’imprimante :</b><br></p>
                <input type="text" name="TxtPrinterName" value="" onkeydown="checkEnter"></p>
                <input id=runbutton  class="button" type="button" value="GO" onClick="run"><p>
                <input type="text" name="txtNbClient" ID="txtNbClient" value="" disabled="disabled"><p>
                <b>Sélectionner un PC dans la liste :</b><br></p>
                <select name="LstClient" id="LstClient" disabled="disabled" size=5 onclick="showchange"><p>
                <option value="LstClient">Client Name </option>
                </select><p>
                <TEXTAREA name="txtAffiche" id="txtAffiche" value="" Rows="7"; Cols="55"></TEXTAREA>
                <img src="Jura_Sud_Logo_Couleur.jpg" style="position: absolute; Left:250px; Top:30px; height:170px; width:240px">
   </Body>
</HTML>

Optimisation VBscript HTA

VBScript

Mode arborescent

Discussions similaires

Partager

Partager