Option Explicit

'ce script calcul la date d'échéance d'une ordonnance valable pendant plusieurs mois

'objects
Dim Wshso : Set Wshso = WScript.CreateObject("WScript.Shell")
Public oIE, oDoc, oDiv, oBtn, oList, oOpt
Set oIE = WScript.CreateObject("InternetExplorer.Application","IE_")

'arrays, variables, counters & flags
Public arMon  'month names
Dim i  'counter
Public flagExe : flagExe = True  'false if script should terminate
Public logMD : logMD = 0  '1 if short date format has month before day 
                          '2 if short date format has day before month 
 
oIE.Navigate "about:blank"
Do Until oIE.ReadyState = 4 : Wscript.Sleep 100 : Loop

Set oDoc = oIE.Document
oDoc.Title = "Echéance Ordonnance Sécu"  ' & String(25,chr(160))
With oDoc.Body
 .Style.FontFamily = "Arial" : .Style.TextAlign = "Center" : .Style.FontWeight = "Bold"
 .Style.FontSize = "12" : .Style.BackgroundColor = "DeepSkyBlue"  'MediumSeaGreen, Bisque
End With 

oDoc.Body.AppendChild oDoc.CreateTextNode("Date de l'ordonnance :")
oDoc.Body.AppendChild oDoc.CreateElement("br")

'scrollable day-of-month list
CreateList 40,1,"Jour",1,31,"i","i" 

oList.Options(Day(Date)-1).Selected = True
oDoc.Body.AppendChild oList
Set oList=Nothing

arMon = Array ("janvier","février","mars","avril","mai","juin", _
 "juillet","août","septembre","octobre","novembre","décembre")

'scrollable month-of-year list
CreateList 85,1,"Mois",0,UBound(arMon),"i + 1","arMon(i)" 

oList.Options(Month(Date)-1).Selected = True
oDoc.Body.AppendChild oList
Set oList=Nothing

'scrollable year list
CreateList 50,1,"Annee",0,4,"Year(Date) - 1 + i","Year(Date) - 1 + i" 

oList.Options(1).Selected = True
oDoc.Body.AppendChild oList
Set oList=Nothing

oDoc.Body.AppendChild oDoc.CreateElement("br")
oDoc.Body.AppendChild oDoc.CreateElement("br")

oDoc.Body.AppendChild oDoc.CreateTextNode("Nombre de mois de renouvellement :")

'renewal month radio boxes
CreateRadio 4,4
CreateRadio 6,6

'scrollable renewal months
CreateList 40,1,"NoMoList",0,12,"i","i" 
With oList : .OnClick = GetRef("oNoMo_click") : .Options(0).Text = ""
 .Options(0).Selected = True
End With 

oDoc.Body.AppendChild oList
oList.insertAdjacentHTML "beforeBegin","   "  'increase space from last radio box 
Set oList=Nothing

oDoc.Body.AppendChild oDoc.CreateElement("br")
oDoc.Body.AppendChild oDoc.CreateElement("br")

'create OK button
CreateButton "ok_click",50,25,"OK"

oDoc.Body.AppendChild oDoc.CreateTextNode(Space(2))

'create Exit button
CreateButton "exit_click",50,25,"Exit"

oDoc.Body.AppendChild oDoc.CreateElement("br")
oDoc.Body.AppendChild oDoc.CreateElement("br")

oDoc.Body.AppendChild oDoc.CreateElement("hr")

oDoc.Body.AppendChild oDoc.CreateElement("br")

oDoc.Body.AppendChild oDoc.CreateTextNode("Date d'Echéance :")
oDoc.Body.AppendChild oDoc.CreateElement("br")

'div for results display
Set oDiv=oDoc.CreateElement("div")
With oDiv : .ID = "Result" : .innerText = " " : .Style.Color = "Blue" 
 .innerHTML = "… apparaîtra ici !" 
End With
oDoc.Body.AppendChild oDiv
Set oDiv=Nothing

oDoc.ParentWindow.ResizeTo 270, 285  'width, height
oDoc.ParentWindow.MoveTo 400, 200  'from left, from top

'initialize IE window
oDoc.Body.Scroll = "no"
With oIE : .Toolbar = 0 : .Statusbar = 0 : .Resizable = 0 : .Visible = 1 : End With 

WScript.Sleep 100
Wshso.AppActivate "Echéance Ordonnance Sécu"

'keep script running until flagExe set to False
Do While flagExe : WScript.Sleep 500 : Loop

If IsObject(oIE) Then oIE.Quit

If logMD = 0 Then
  MsgBox "Le format de la date n'a pas pu être déterminé." &_
   vbCRLF & vbCRLF & "Ce script doit s'arrêter !",vbOKOnly + vbCritical + vbSystemModal, _
   "Format de date non déterminé !"
End If

'clean up & exit
Set oIE=Nothing
Set oDoc=Nothing
Set Wshso=Nothing


Sub ok_click()
Dim intJour, intMois, intAnnee, strShtDatFmt, strShtDatChr, strDate
Dim i, intMoRenouv, logRChk, intNoDays, datEnd, strLDate 

intJour = oDoc.All.Jour.Options(oDoc.All.Jour.SelectedIndex).Value
intMois = oDoc.All.Mois.Options(oDoc.All.Mois.SelectedIndex).Value
intAnnee = oDoc.All.Annee.Options(oDoc.All.Annee.SelectedIndex).Value

'read short date format
strShtDatFmt = Trim(Wshso.RegRead("HKEY_CURRENT_USER\Control Panel\International\sShortDate")) 

'determine if month precedes day or vice versa by looking for
'1st "m" or "d" character in short date format
For i = 1 To Len(strShtDatFmt)

 strShtDatChr = Lcase(Mid(strShtDatFmt,i,1))

 If strShtDatChr = "m" Then
  logMD = 1 : Exit For
 ElseIf strShtDatChr = "d" Then
  logMD = 2 : Exit For
 End If

Next

'exit sub if short date fmt not determined
If logMD = 0 Then 
 flagExe = False : Exit Sub
End If

'assemble prescription date
If logMD = 1 Then
 strDate = CStr(intMois) & "/" & CStr(intJour) & "/" & CStr(intAnnee)
Else
 strDate = CStr(intJour) & "/" & CStr(intMois) & "/" & CStr(intAnnee)
End If

'determine if one of the radio boxes was checked
logRChk = False
For i = 1 To oDoc.All.RNoMo.Length
 If oDoc.All.RNoMo(i-1).Checked Then
  logRChk = True : intMoRenouv = oDoc.All.RNoMo(i-1).Value
 End If
Next

'test for valid prescription date
If Not IsDate(strDate) Then

 MsgBox "La date de l'ordonnance, le " & strDate & ", n'est pas une date valide." &_
  vbCRLF & vbCRLF & "Rechoisis la date.",48,"Date invalide !" 

'test for selection of renewal months
ElseIf Not logRChk And oDoc.GetElementByID("NoMoList").Value = 0 Then 

 MsgBox "Le nombre de mois de renouvellement n'a pas été choisi." &_
  vbCRLF & vbCRLF & "Choisis " & Chr(34) & "4" & Chr(34) & " ou " & Chr(34) & "6" & Chr(34) &_
  " ou un nombre entre 1 et 12.",48,"Période de renouvellement manquant !" 

'assemble end date
Else

 'use scrollable renewal months if radio button not used
 If Not logRChk Then intMoRenouv = oDoc.GetElementByID("NoMoList").Value

 'calculate prescription days from prescription months
 intNoDays = ((intMoRenouv + 1) * 28) - 1
 'add those days to prescription start date
 datEnd = DateAdd ("d",intNoDays,strDate)

 'assemble prescription end date
 strLDate = Day(datEnd) & Space(1)
 strLDate = strLDate & arMon(Month(datEnd)-1) & Space(1)
 strLDate = strLDate & Year(datEnd)

 'let me know result is ready (and don't abort if it fails)
 On Error Resume Next
  Wshso.Run Wshso.ExpandEnvironmentStrings("%WINDIR%") &_
   "\system32\sndrec32.exe /play /close " &_
   Wshso.ExpandEnvironmentStrings("%WINDIR%") & "\Media\Ding.wav",0,False
 On Error Goto 0

 'display end date
 oDoc.All.Result.innerText = strLDate

End If

End Sub


'close IE window & terminate if Exit button pushed
Sub exit_click()
 flagExe = False
End Sub


'terminate if IE window closed
Sub IE_onQuit()
 flagExe = False
 Set oIE=Nothing
 oIE=""  'redefine oIE to remove object class
End Sub


Sub CreateList (intWidth, intSize, strID, ctrStart, ctrEnd, intValue, intText) 

Set oList = oDoc.CreateElement("Select")
With oList : .Style.Width = intWidth : .Size = intSize : .ID = strID : End With 
For i = ctrStart To ctrEnd
 Set oOpt = oDoc.CreateElement("Option")
 With oOpt : .Value = Eval(intValue) : .Text = Eval(intText) : End With 
 oList.Options.Add oOpt
 Set oOpt=Nothing
Next

End Sub


Sub CreateRadio (strValue,intValue)
Dim strHTML
Dim oChoice : Set oChoice = oDoc.CreateElement("<Input Name='RNoMo'>")
 With oChoice
  .Type = "Radio" : .Value = intValue : .OnClick = GetRef("radio_click") : .ID = "RNoMo" 
 End With
 oDoc.Body.AppendChild oChoice
 oChoice.insertAdjacentHTML "afterEnd","<span style='font-weight:normal'>&nbsp;" &_ 
  strValue & "&nbsp;&nbsp;&nbsp;&nbsp;</span>"
 Set oChoice=Nothing
End Sub


'select 0 months from scrollable list if radio button clicked
Sub Radio_Click()
 oDoc.All.NoMoList(0).Selected = True
End Sub


'unselect radio months if scrollable months selected
Sub oNoMo_click()

For i = 1 To oDoc.All.RNoMo.Length
 oDoc.All.RNoMo(i-1).Checked = False
Next

End Sub


Sub CreateButton (strRef, intWidth, intHt, strInnerText)

Set oBtn = oDoc.CreateElement("button")
With oBtn 
 .OnClick = GetRef(strRef) : .Style.Width = intWidth : .Style.Height = intHt 
 .InnerText = strInnerText 
End With 
oDoc.Body.AppendChild oBtn
Set oBtn=Nothing

End Sub


'R01
'created 29 Apr 2003

'R02
'moved style attributes to document body; simplified object use; added
'default Results text; added comments

'R03
'used insertAdjacentHTML to add unbolded radio button text; changed
'first renewal month to empty string; added CreateList sub

'R04
'replaced Cancel button with Exit button and eliminated 5-sec. results
'display

'R05
'changed listbox selected value method to
'oDoc.All.ListName.Options(oDoc.All.ListName.SelectedIndex).Value
'and radio box poll method upper limit to use of .Length property

'R06
'after install of IE6 SP1, added body fontsize = 12
'added background color

'R07
'replacement of BING.WAV by DING.WAV, which is universally available,

'R08
'added detection of short date format before performing DatAdd arithmetic