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
| <!--
Auteur : papy
Date ; 18/06/2012
site : http://bbil.developpez.com/tutoriel/vbs/interface-hta/
Fonction : recherche dans mesclés
-->
<html>
<HEAD>
<TITLE>Application : MESCLES</TITLE>
<HTA:Application ICON =
"C:\Documents and Settings\Admin\Mes documents\Mes images\Icones\clé.ico"
ID = 'AppBonjour'
SCROLL= 'no'
MAXIMIZEBUTTON= 'no'
>
<script language="VBScript">
dim rs, connstring ,z ,tv(6) ,libs
const table = "Klés"
Sub Window_onLoad
window.moveTo 50,0
window.resizeTo 900,730
Set Ws = CreateObject("WScript.Shell")
mdb = Ws.SpecialFolders("MyDocuments") & _
"\Fichiers Access\mesclés.mdb"
' "\Fichiers Access\Copie de mesclés.mdb"
' "\Fichiers Access\mesclés.mdb"
Set fso = CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(mdb) then msgbox "non trouvé",,mdb : wscript.quit
connstring = "DRIVER={Microsoft Access Driver (*.mdb)};" & _
"User Id=admin;Password=papa;DBQ=" & mdb
Set Rs = CreateObject("ADODB.RecordSet")
call ChargerMyListBox
' msgbox "Bonjour tout le monde",vbExclamation ,"interface-hta"
End Sub
sub options ' liste des services
mysql = "SELECT * from Klés where nauto=" & lstdyn.value
Rs.open mySQL, connstring
for i=0 to 6
tv(i)=rs(i)
if rs(i) is nothing then tv(i)="''"
next
' srv.value= tv(0)
id.value= tv(1)
mp.value= tv(2)
lib.value= tv(3)
div.value= tv(4)
num.value= tv(5)
ad = tv(6)
if ad <>"" then ad=replace(ad,"#","")
adr.value= ad
rs.close
end sub
sub maj
mysql = "UPDATE " & table & " SET"
set fld = rs.fields
q = " " : z = ""
for x=1 to rs.fields.count -1
select case x
case 1 : mysql = mysql & q & fld(x).name & " = '" & xx(id.value) & "'"
case 2 : mysql = mysql & q & fld(x).name & " = '" & xx(mp.value) & "'"
case 3 : mysql = mysql & q & fld(x).name & " = '" & xx(lib.value) & "'"
case 4 : mysql = mysql & q & fld(x).name & " = '" & xx(div.value) & "'"
case 6 : mysql = mysql & q & fld(x).name & " = '" & xx(adr.value) & "'"
end select
q=","
next
if len(z)=0 then exit sub
mysql = mysql & " WHERE nauto = " & lstdyn.value
Rs.open mySQL, connstring
call options
end sub
sub cre
zn= ShowModalDialog("Créclé.hta")
if zn<>0 then
call ChargerMyListBox
lstDyn.value=zn
call options
end if
end sub
sub sup
if (lstdyn.value="") then exit sub
r=msgbox ("confirmer la suppression",vbyesno,tv(0))
if r=vbno then exit sub
mysql= "DELETE FROM " & table & _
" WHERE nauto = " & lstdyn.value
Rs.open mySQL, connstring
call ChargerMyListBox
call effacer
end sub
sub effacer
id.value= ""
mp.value= ""
lib.value= ""
div.value= ""
num.value= ""
end sub
sub adb 'r_onClick
if adr.value="" then exit sub
Set WshShell = CreateObject("WScript.Shell")
' Return = WshShell.Run("chrome.exe " & adr.value , 1, true)
Return = WshShell.Run(adr.value , 1)
end sub
function xx(v)
z=z & v
if v="null" then xx="" else xx=v
if instr(1,v,"'")>0 then xx=replace(v,"'"," ")
end function
Sub ClearMyListBox
While lstDyn.Length > 0
lstDyn.remove(0)
Wend
End sub
Sub ChargerMyListBox
call ClearMyListBox
mysql = "SELECT * from Klés ORDER BY services"
Rs.open mySQL, connstring
if libs="" then libs=rs.fields(0)
do while not Rs.eof
service= rs(0)
nauto = rs(5)
'Liste box dynamique:
Set oOption = Document.createElement("OPTION")
oOption.Text = service
oOption.Value = nauto
lstDyn.Add(oOption)
oOption.style.backgroundcolor = "yellow"
'oOption.style.width = "600px"
if service=zc then zc=nauto
Rs.MoveNext
loop
rs.close
end sub
</script>
</HEAD>
<BODY bgcolor="#FFE4C4">
<input type="button" value="Valider la modification"
onClick="maj">
<SELECT NAME="lstDyn" size=36 onchange="options" >
<input type="button" value=" Quitter "
title="Sortie" onClick="window.close()">
<input type="button" value="Créer"
title="Création d'un article" onClick="cre">
<input type="button" value="Supprimer"
title="Suppression d'un article" onClick="sup">
<input type="button" value="Adresse"
title="Accéder au site" onClick="adb">
<input type="button" value="" name="num" bgcolor="#FFE4C4">
</SELECT>
<INPUT TYPE="text" NAME="adr" SIZE="135" MAXLENGTH="100"
style="background-color :#FFA07A" ><br>
ID : <INPUT TYPE="text" NAME="id" SIZE="20" MAXLENGTH="50"
style="background-color :#FFA07A" >
MP : <INPUT TYPE="text" NAME="mp" SIZE="10" MAXLENGTH="10"
style="background-color :#FFA07A" >
Libellé : <INPUT TYPE="text" NAME="lib" SIZE="40" MAXLENGTH="255"
style="background-color :#FFA07A" ><br>
Divers : <INPUT TYPE="text" NAME="div" SIZE="60" MAXLENGTH="255"
style="background-color :#FFA07A" >
</BODY>
</html> |