Creer une balise avec un lien hypertext variable

**papyxy** · 11/01/2019, 10h25

Bonjour
Je souhaiterai avoir un moyen d' accéder directement sur un lien qui aurait l' adresse de destination (HTTP....).
Actuellement je passe par une procédure "exécuter", mais cela ne plait guère.
Je pense qu' on doit pouvoir faire l' équivalent que j' utilise dans un VBA en passant par un objet Label d' un Userform.
Merci pour votre aide.

**hackoofr** · 11/01/2019, 10h48

SVP, postez votre code pour comprendre mieux votre requête !

Edit :
Voici un petit exemple en HTA :

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
<html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Open links with IE, Chrome and Firefox and how to pass command line"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="nslookup.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
<title>Open links with IE, Chrome and Firefox and how to pass command line</title>
<SCRIPT LANGUAGE="VBScript">
 
'************************************************************************************
Sub window_onload()
    CenterWindow 480,250
End Sub
'************************************************************************************
Sub CenterWindow(x,y)
    Dim iLeft,itop
    window.resizeTo x,y
    iLeft = window.screen.availWidth/2 - x/2
    itop = window.screen.availHeight/2 - y/2
    window.moveTo ileft,itop
End Sub
'************************************************************************************
 Function Executer(StrCmd,Console)
    Dim ws,MyCmd,Resultat
    Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
    If Console = 0 Then
        MyCmd = "CMD /C " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,True)
        If Resultat = 0 Then
            'MsgBox "Success"
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
'La valeur 1 pour montrer la console MS-DOS
    If Console = 1 Then
        MyCmd = "CMD /K " & StrCmd & " "
        Resultat = ws.run(MyCmd,Console,False)
        If Resultat = 0 Then
            'MsgBox "Success"
        Else
            MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
        End If
    End If
    Executer = Resultat
End Function
'************************************************************************************
  
</script>
</head>
<BODY text=white bgcolor="DarkOrange" TOPMARGIN="1" LEFTMARGIN="1">
<p>Links List (examples) :</p>
<ol>
<li><a href="#" onClick="Call Executer('Start iexplore.exe www.google.com',0)">Lien Google avec iexplore.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe http://com/',0)">Lien BBAT avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start Firefox.exe www.developpez.net',0)">Lien developpez.net avec Firefox.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.yahoo.fr',0)">Lien Yahoo avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.fr',0)">Lien Autoitscript.fr (Français) avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.com',0)">Lien autoitscript.com (Anglais) avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start www.sfr.fr',0)">Lien SFR avec votre navigateur by default</a></li>
</ol>
</body>
</html>

**papyxy** · 11/01/2019, 11h26

voici le code (lignes 319 a 321)

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
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
<html><head>
<title>le films choisi</title>
<HTA:APPLICATION
                APPLICATION='gestion des vidéos'
                ID="ChildApplication"
                SCROLL='no'>
 </head>
 <SCRIPT LANGUAGE="VBScript">
 ' option explicit
'    Const path = "HKCU\Volatile Environment\MsgResp"
        dim ofso  ,objShell ,z , phot ,no_image, adr
        dim nom, typ, aff, mo, an , desc, duree, adresse
        dim maxa          ' Nb acteurs
        dim raff, ract ,rep_parent, dac
        dim curdir           
        dim googledrive   
      const films       =        "Films.txt"
      const acteurs     =      "Acteurs.txt"
      const filmact     =      "filmact.txt"
      const synopsis    =     "SYNOPSIS.txt"
      const origines    =     "origines.txt"
      const genres      =       "genres.txt"
      const realisateurs= "Réalisateurs.txt"
          Const ForReading  = 1
          Const TristateTrue= -1     ' Unicode
      Set  objShell= CreateObject("Wscript.Shell")
      Set     ofso = CreateObject("Scripting.FileSystemObject")
      Set   dac    = CreateObject("Scripting.Dictionary")
      Google_Drive = _
      objShell.ExpandEnvironmentStrings("%USERPROFILE%") & _
                                "\Google Drive"
        curdir     = objShell.CurrentDirectory
        rep_parent = ofso.getparentfoldername(curdir)
                     raff  = rep_parent  & "\Affiches de films\"
                     ract  = rep_parent  & "\Acteurs\"
 
While Not  ofso.FolderExists(ract) 'then exit do
     ract = Google_Drive & "\Acteurs\"
     if not ofso.FolderExists(ract) then msgbox ract,,"?" : wincow close
     raff = Google_Drive & "\Affiches de films\"
     if not ofso.FolderExists(raff) then msgbox raff,,"?" : wincow close
Wend     
        dim maxl,maxh,top2
        maxl =1120    : maxh = 860
        window.resizeTo maxl -150,window.screen.availHeight
        window.moveTo   0 ,0
'_______________________________________________________________________________
 
sub window_onload
        Dim   arguments 
          arguments = Split(ChildApplication.CommandLine,"!")
If ubound(arguments)=0 Then  Exit Sub
'               depuis le Film.hta
'alert arguments(1)
     nf   =  Replace(arguments(1),Chr(34),"") 
     affichage  nf  
end sub
'_______________________________________________________________________________
 
sub fin_OnClick
        window.close()
End sub
sub window_onunload
        Set objShell  = nothing
        Set oFSO      = nothing
        window.close()
end sub
 
'_______________________________________________________________________________
 
sub charge_acteurs(nf)  
        Dim lig, nfx, na, f
    Dim txa(2000)       ' presences acteur
    maxa=0               
                        Set f = open(filmact)
 do while Not     f.AtEndOfStream
     lig  =     f.readline
     nfx  = split(lig,";")(0)
     na   = split(lig,";")(1)+0
     If nf=nfx Then
             maxa = maxa+1
             txa(na)=True       ' presence      acteurs du film
         Else
             txa(na)=False
                If maxa>0 Then  :Exit do
         End If
  Loop
     f.Close    
'end sub
'sub charge_dac
'        - Num acteur
 '       - nom acteur
  '      - photo (jpg)
   '     - web   (adresse internet)
    '    - present dans au moins 1 film (vrai/faux)
 
  Dim num 
          i=0
                        Set f    = open(acteurs)
  Do While Not     f.AtEndOfStream
        lig  =  f.readline
     if lig<>""  then
        num  = split(lig,";")(0)  +0
        If txa(num) Then
                i=i+1
                dac.Add lig,""
        End If
        if i = maxa  then   :Exit do 
     end if
  Loop     
   f.Close  
end sub
'_______________________________________________________________________________
 
sub affichage(nf)
    Dim rs,lig ,i ,l  ,n,v,f,nr,ng,no, zr
 
                        lig = lili(nf,films,    ";")     
        rs                       = split(lig,";")
 
          nof.value  = rs(0)     
     document.title  = rs(1)
         typf.value  = rs(2)
         affi.value  = rs(3) 
         nbmo.value  = rs(4)
         durf.value  = rs(5)
           hm.value  = dur(rs(5))
                  ng = rs(6)+0
                  no = rs(7)+0
         anne.value  = rs(8)
                        adr  = rs(9)
                 zr  = rs(11)
       If zr="" Then nr=9 Else nr=zr +0
                        lig = lili(no,origines,    ";")  
  origine.value = Split(lig,    ";")(1)  
                        lig = lili(ng,genres,      ";")
        genre.value = Split(lig,    ";")(1)
                    lig = lili(nr,realisateurs,";")
      rea.value = Split(lig,    ";")(1)
                    lig = lili(nf,synopsis,    "|")               
     resu.value = Split(lig,    "|")(1)  
'        id("SaveRes").innerhtml = adr
 
web.value=adr
        Call  affiche (affi.value)
                Call  charge_acteurs(nf)         
          nba.value = maxa & " acteurs"
 
                Call prep_photos              
End sub
'_______________________________________________________________________________
 
Function open(f)
         set open = oFso.OpenTextFile(f,ForReading, TristateTrue)
End function 
'_______________________________________________________________________________
 
Function lili(n,fic,sep)
                          Dim t,num,f 
                            Set f = open(fic)
          While Not         f.AtEndOfStream
                   lili =               f.readline
                 t  = split(lili,sep)
                num = t(0)  +0  
             If num = n+0 Then
                f.Close :               Exit function 
         End If   
          Wend   
End function 
'_______________________________________________________________________________
 
function xx(v)
         xx = chr(34) & trim(v) & chr(34)
end function
'_______________________________________________________________________________
 
sub affiche(jpg)
        dim zaff, shp
            zaff = raff &  jpg
       if not ofso.FileExists(zaff) then
                 imaf.src="Affiche non trouvée.bmp"
       else
         shp         = oFSO.GetFile(zaff).shortpath
         imaf.src    = shp
       end if
end sub
'_______________________________________________________________________________
 
function dur (mn)
        dim h,m
        if mn<>"" then
               h    = int(mn/60)
               m    = mn mod 60
                dur = h & "h" & right(m+100,2)
        end if
end function
'_______________________________________________________________________________
 
function nom_propre(z)
        dim np,x,mot,i,s
         x= split(lcase(z)," ")
         for i=0 to ubound(x)
              mot=x(i) : np=np & s & ucase(left(mot,1)) :  s=" "
               if len(mot)>1 then np=np  & mid(mot,2)
         next
         nom_propre = np
end function
'_______________________________________________________________________________
 
Function id(o)
        Set id = document.getElementById(o)
End Function
'_______________________________________________________________________________
 
Function nom_propre(v)
         nom_propre =   Ucase(Left(v,1)) & Mid(v,2)
End Function
'_______________________________________________________________________________
 
sub prep_photos
        if dac.Count =0 Then Exit Sub
        dim z,i, z1,z2,z3 ,top, Left, jpg, npho, zon,taw
        const larg=90
        const nbc =9     ' nb colonnes
          nph =maxa      ' nb photos
        const top1=440     : top=top1
        taw = dac.Keys 
        for i=1 to nph
                           zon = taw(i-1)       ': alert zon
                        If zon<>"" then
                      jpg  = xx( ract    &  Split(zon,";")(2) )
                      npho = xx( nom_propre(Split(zon,";")(1)))
            if i=nbc+1 then top=top+145
            if i=1 or i=nbc+1 then left=20 else left=left+larg+10
         z1="<div style='position: absolute;  left: " & _
            left & "px; top: " & top & "px ;'>"  & vbcr
 
         z2="<img  src=" & jpg   &  _
         " style='border:none; width:" &   larg & "px;'" & _
         "  OnClick='aff_acteur " & i & "'><br>"  & vbcr
 
         z3="<input type='text' "  & _
         " style='background-color :transparent; border:none;" & _
         " text-align:center; width:" & _
                   larg & "px;    font-size:11px; '" & _
         " value=" & npho  & "></div>"   & vbcr
         z=z & z1 & z2 & z3   & vbCr
         End If
        next                 ' : alert z
        id("SaveRes").innerhtml = z
end sub
'_______________________________________________________________________________
 
sub aff_acteur(i)
        Dim num ,pgm,cmdline
'        If i>nactf.length then exit sub
 '       num = nactf(i-1).value
Const   hta = "maj Acteurs.hta"
        pgm = oFSO.GetFile(hta).shortpath
        cmdline = "mshta.exe " &  xx(pgm)   & " !" & xx(num)  
            objShell.Run cmdline,0,True
End sub
'_______________________________________________________________________________
 
sub Executer()
        Dim MyCmd 
                MyCmd = "CMD /C Start " &  replace(adr,"#","")  ': alert mycmd
            objShell.run MyCmd,0,False
End sub
 
 
Function id(o)
        Set id = document.getElementById(o)
End Function
  </script>
 <body>
 
<div  style='position: absolute; left: 715px; top: 10px;'>
<img name='imaf' style='width:230px;text-align: center;' >
<br><br>
<input type='text'   name='nba'
                                 style='text-align: center;
                background-color :transparent; border:none; '>
</div> 
 
 
<div  style='position: absolute; left: 6px; top: 0px;
                border:none;'>
<table cellspacing='2px' cellpadding='2px;' rules='all'
             style='border:solid 1px black;'>
   <caption>Caractéristiques du film N°
   <input type='text'  ID='nof'    
     style='background-color :transparent; border:none;text-align:left;'>
   </caption>
<tr><td>Type   <td><input type='text'   name='typf'
                 style='border:none;'
         size='3'         maxsize='3'>
<tr><td>Affiche<td><input type='text'   name='affi'
                 style='border:none;'
         size='80'        maxsize='100'>
<tr><td>Genre  <td><input type='text'   name='genre' 
                 style='border:none;'>
<tr><td>origine<td><input type='text'   name='origine'
                 style='border:none;'>
<tr><td>Taille <td><input type='text'   name='nbmo'  size='4'
                 style='border:none;'     >(Mo)
<tr><td>Durée  <td>   <input type='text'  
                name='durf'  size='3'
                                 style='border:none;'       >(mn)
         <input type='text'  name='hm'  disabled size='8'
        style='background-color :transparent; border:none; text-align:center;'>
<tr><td>Année <td>    <input type='text'  name='anne'  size='4' 
                 style='border:none;'       >
<tr><td>Réalisateur<td><input type='text'   name='rea' 
         style='border:none;'>
 
<tr><td>Web 
        <td><input type='text'   name='web' size='60'
        style='border:none;' readonly>  
        <td><a href='#' onClick='Executer'>Lien vers le web   </a>
</table>
 
<TEXTAREA   NAME="SYNOPSIS" ID='resu'
       ROWS='8' style='width: 710px;'        >
       </TEXTAREA> <br><br>
       </div>
 
<div    style='position: absolute; left:650px; top: 0px;'>
<input type="button" value='Quitter'  style='cursor:pointer'  ID='fin'>
</div>
 
<span id='SaveRes'></span>
</body>

**hackoofr** · 11/01/2019, 12h27

Voici un code complet en pièce-jointe qui peut télécharger une liste de type m3u et lire son contenu de façon dynamique afin de regarder quelques films pour enfants

Remarque : Il faut qu'au préalable avoir la version 32 bits de l'application VLC même si l'architecture de votre système de windows installé est de type 64 bits !!!

**papyxy** · 11/01/2019, 14h30

Merci, mais cela ne correspond pas a ce que je veux faire.

Creer une balise avec un lien hypertext variable

VBScript

Discussions similaires

Partager

Partager