'<?xml:namespace prefix = n/><n:CX Nom='' ...><INPUT.../></n:CX>
' ==========================================================         D E C L A R A T I O N S          ==========================================

Dim   Tx

Const MaxVue = 10
Const sData  = "CONTENU/ZDATA/xml/rs:data"
Dim   SiRacine, LenCode, DeltaCode, Trace, ChaineDom, PathXml, v_Selection, v_SelTree, Dial, ObjParam

Dim   v_ReferSet, v_Version, VueData, VueForm, ObjXmlCache, cr, crr, VersionDomXml, MsgSel
Dim   SiAffichVue, SiClearBug, SiDebug, DebBug
Dim   AppX, Root, RepPgm, BDBOX, RepHTC, nodSet, Html, Zone, ZoneXml, WinReady, WinMess
Dim   c_Ident, v_Ident, v_Nom, v_CodTree, v_Unite, v_Serv, v_Droit, v_TypUser, v_Fct

MaxVar  = 0:  nbVue=0:  SiClearBug=0:  SiDebug=False:  MaxEnr=0:  Set nodSelTree = Nothing:  cr = VbCr:  crr = VbCr & VbCr
BDBOX   = "/Applis/Pack/" & VPack & "/Eng/BDBox.asp"

Set DivDrag  = Nothing

Set Zone     = Nothing
Set ZoneXml  = Nothing
Set VueOver  = Nothing
Set VueOn    = Nothing
Set Memo     = New ClassMemo
Set WinMess  = Nothing

Class ClassMemo
  Public Obj, Obj2
  Public Ch
  Public NomCle
  Public Proc
  Public TypRech
  Public ChRechValid
  Public ChangeAllChamp

  Private Sub Class_Initialize()
    Set Obj         = Nothing
    Set Obj2        = Nothing
    Set Ch          = Nothing
    ChangeAllChamp  = False
  End Sub
End Class


Class ClassExcel
  Public L, C
End Class


Class ClassHtml
  Public H

  Private Sub Class_Initialize(): End Sub
  Private Sub Class_Terminate():  End Sub

  Public Property Get Code(Tag)
    Code = Tag.InnerHtml
  End Property

  Public Property Let Code(Tag, CodH)
    ' Insérer une info au plus profond d'une balise html
    If TypeName(Tag)="String" Then
      Set O = Document.All(Tag)
    Else
      Set O = Tag
    End If
    Do While O.Children.Length>0
      Set O = O.Children(0)
    Loop
    O.InnerHtml = CodH
  End Property
End Class


Class ClassTx
  Public X
  Private nod

  Private Sub Class_Initialize(): Init:  End Sub
  Private Sub Class_Terminate():  End Sub

  Private Sub Init()
    Set X = AppX.SelectSingleNode("/ROOT")
  End Sub

  Public Property Get Var(NomVar)
    If X Is Nothing Then  Exit Property
    If InStr(NomVar,".") Then
      Var = Val(NomVar, "")
    Else
      Set nod = X.SelectSingleNode("VAR/" & NomVar)
      If noz(nod) Then  Var = nod.Text
    End If
  End Property

  Public Property Let Var(NomVar,V)
    If X Is Nothing Then  Exit Property
    If InStr(NomVar,".")>0 Then
      NomSet = Mot(NomVar,1):  NomChamp = Mot(NomVar,2)
      Set nodSet = DataSet(NomSet)
      If noz(nodSet) Then
        Set nod  = OpXml(nodSet, "VARS/VAR[@Nom='" & NomChamp & "']")
        nod.Text = V & "":  'mhl NomVar & crr & V & crr & nod.xml & crr & nodSet.xml
      End If
    Else
      Set nod  = OpXml(X, "VAR/" & NomVar)
      nod.Text = V
    End If
  End Property

  Public Property Get DataSet(NomSet)
    Set DataSet = X.SelectSingleNode("DATASET[@Nom='" & NomSet & "']")
  End Property

  Public Property Get Table(NomTable)
    Set Table = X.SelectSingleNode("TABLES/TABLE[@Nom='" & NomTable & "']")
  End Property

  Public Property Get DataTable(NomTable)
    Set DataTable = Nothing
    Set nodT = Table(NomTable)
    If noz(nodT) Then  Set DataTable = nodT.SelectSingleNode("DATA")
  End Property

  Public Property Get Data(NomSet)
    Set nodT = DataSet(NomSet)
    If nodT Is Nothing Then
      Set Data = DataTable(NomSet)
    Else
      Set Data = nodT.SelectSingleNode(sData)
    End If
  End Property

  Public Property Get Row(Expr, SqX)
    Set Row = Nothing
    NomSet = Mot(Expr,1):  NomChamp = Mot(Expr,2)
    Set nodSet = DataSet(NomSet)
    Set nodD = Data(NomSet)
    If Not nodD Is Nothing Then
      If SqX="" Then  S=SqX  Else  S="[" & SqX & "]"
      Set Row = nodD.SelectSingleNode("z:row" & S)
    End If
  End Property

  Public Property Get Val(Expr, SqX)
    Val = Null
    NomSet = Mot(Expr,1):  NomChamp = Mot(Expr,2)
    Set nodSet = DataSet(NomSet)
    Set nodD = Data(NomSet)
    If Not nodD Is Nothing Then
      If SqX="" Then  S=SqX  Else  S="[" & SqX & "]"
      N = nodD.SelectNodes("z:row" & S).Length
      Set nod = nodD.SelectSingleNode("z:row" & S):  'mhl Expr & crr & "S=" & S & ", N=" & N & crr & nodD.xml & crr & mobj(nod)
      If N=1 Then
        If Not nod Is Nothing Then  Val = nod.GetAttribute(NomChamp)
      Else
        Set Vu = Document.All(NomSet)
        If noz(Vu) Then
          Val = Vu.Val(NomChamp)  'Set nod = Vu.Enreg:  If noz(nod) Then  Val = nod.GetAttribute(NomChamp)
        Else
          If Not nod Is Nothing Then  Val = nod.GetAttribute(NomChamp)
        End If
      End If
    End If
    If IsNull(Val) And noz(nodSet) Then
      Val = LitXml(nodSet,"VARS/VAR[@Nom='" & NomChamp & "']")
    End If
  End Property

  Public Property Get NbEnr(NomSet)
    Set nodD = Data(NomSet):  If noz(nodD) Then  NbEnr = nodD.SelectNodes("z:row").Length  Else  NbEnr = 0
  End Property

  Public Property Get TreeDef()
    Set TreeDef = X.SelectSingleNode("TREE[@Nom='" & Var("NomApp") & "']")
  End Property

  Public Property Get TreeData()
    Set TreeData = TreeDef.SelectSingleNode("DATA/xml/rs:data")
  End Property

  Public Property Get TreeRow(CodTree)
    Set TreeRow = TreeDef.SelectSingleNode("DATA/xml/rs:data/z:row[@CodTree='" & CodTree & "']"):  'mhl TreeRow.xml
  End Property

  Public Property Get ValChamp(X, NomChamp)   ' Pour lire les var. de LitSql par ex.
    If noz(X) Then
      Set nod = X.SelectSingleNode("/xml/rs:data/z:row")
      If nod Is Nothing Then  Set nod = X.SelectSingleNode("DATA/z:row")
      If noz(nod) Then  ValChamp = nod.GetAttribute(NomChamp)
    End If
  End Property
End Class


Set Html = New ClassHtml


' -----------------------------------      InitAppli       -----------------------------

Sub InitAppli()
  Dim ObjXml, nod, nox, ChaineCnx, X, S, D

  wstatus "Initialisation"
  Document.Body.InsertAdjacentHtml "AfterEnd", "<DIV id=ModelSet style='DISPLAY: none'></DIV>"
  If Not IsVar(DivSwap) Then  Document.Body.InsertAdjacentHtml "AfterEnd", "<DIV id=DivSwap style='DISPLAY: none'></DIV>"
  'Set D = Document.CreateElement("DIV"):  D.ID="ModelSet":  D.Style.Display="none":  Document.appendChild D

  VersionDomXml = VersionXml():  'If VersionDomXml=4 Then  VersionDomXml=3
    'MSXML2.FreeThreadedDOMDocument." & VersionDomXml & ".0"
  If VersionDomXml=1 Then  ChaineDom  = "Microsoft.XMLDOM"  Else  ChaineDom  = "MSXML2.DOMDocument." & VersionDomXml & ".0"
  Set ZoneXml = CreateObject(ChaineDom)
 	Document.Scripts(0).Text = LitValSql("PGM", "SELECT Pgm FROM Pgm WHERE CodPgm='1'"): 	InitVars

  Set AppX   = CreateObject(ChaineDom)
  AppX.async = False
  If TypeName(AppliDef)="HTMLGenericElement" Then
    'Set AppX = AppliDef
    AppX.LoadXML AppliDef.xml
    ChargeInfo
  Else
    wstatus "Chargement Application"
    If PathXml="" Then
	    S = LCase(PathInfo)
	    S = Replace(S,"default.asp","website.xml"):  PathXml = Replace(S,".asp",".xml")
	  End If
    S = RepPgm & "/Eng/XmlLoad.asp?NomApp=" & NomApp & "&PathXml=" & PathXml & "&IdTest=" & v_IdTest & "&CodSoc=" & v_CodSoc & "&CodSite=" & v_CodSite & "&NomSitA=" & v_NomSitA
      'Window.Open Root & S & "&PathInfo=" & PathInfo, "WinMess"
    AppX.Load S:    wbug S
  End If
  Set nod = AppX.SelectSingleNode("/ROOT")
  If nod Is Nothing Then
    'mhl NomApp & crr & PathInfo
    AppX.Load NomApp & ".xml"
    ChargeInfo
  Else
    If LitXZ(nod,"@Erreur")="O" Then  mhl AppX.xml:  RMNod nod, ""
  End If
    'WinMsg S & crr & AppX.xml , "T"
  If AppX.SelectSingleNode("/ROOT") Is Nothing Then  MsgBox "Chargement application impossible":  Set AppX = Nothing:  Exit Sub

  If VersionDomXml=4 Then  AppX.SetProperty "NewParser", True
  NameSpace AppX
  wstatus "Fin Chargement Application"

  Set Tx = New ClassTx
  SetTimeout "MenuGeneral()", 0

  Set nod = AppX.SelectSingleNode("/ROOT/INFOS/AGENT/z:row")
  If noz(nod) Then
    v_Nom     = nod.GetAttribute("Nom") & " " & nod.GetAttribute("Prenom"):   'mhl v_Nom
    v_CodTree = nod.GetAttribute("CodTree")
    v_Unite   = nod.GetAttribute("LibUO")
    v_Serv    = nod.GetAttribute("LibDep")
  End If
  Set nod = AppX.SelectSingleNode("/ROOT/INFOS/AGENT/USER/z:row")
  If noz(nod) Then
    If nz(nod.GetAttribute("Admin"))="True"    Then  v_TypUser = BitCode(v_TypUser, "X", 1)
    If nz(nod.GetAttribute("AdminApp"))="True" Then  v_TypUser = BitCode(v_TypUser, "X", 2)
  End If

  If Document.All("DivCache") Is Nothing Then  Document.Body.insertAdjacentHTML "BeforeEnd", "<DIV ID='DivCache' Style='Display:none'></DIV>"

  TraitPrim

  S = rObj("/ROOT/GENERAL/BD/TABLESXML") & ""
  If S<>"" Then
	  Set ObjXml = CreateObject(ChaineDom)
	  ObjXml.async = False
	  ObjXml.Load S

  	Set nodDest = AppX.SelectSingleNode("/ROOT")
  	Set nods = ObjXml.SelectNodes("/ROOT/TABLES/TABLE")
    For Each nod In nods
  	  Set nodn = nod.CloneNode(True)
    	nodDest.AppendChild nodn
    Next
    Set ObjXml = Nothing
  End If

  Window.Name = rObj("/ROOT/GENERAL/TITRE") & ""

  CalcDroits ""

  Set nod = Nothing
  Set nox = AppX.SelectSingleNode("/ROOT/TABLES/TABLE[@Nom='SysDroits']")
  If NOZ(nox) Then
    Set nod = nox.SelectSingleNode("USER")
  End If
  If NOZ(nod) Then  v_Droit = LitXml(nod,"@Droit"):  v_TypUser = LitXml(nod,"@Type")

  Document.Body.AttachEvent "ondragstart",  GetRef("onDragStart")
  Document.Body.AttachEvent "ondragend",    GetRef("onDragEnd")
  Document.Body.AttachEvent "ondrag",       GetRef("onDrag")
  'BDBOX   = "http://www.acorline.com" & BDBOX
End Sub



' -----------------------------------      ExecSet       -----------------------------

Function CreeSet(DataSet)
  Dim DSet, DSetW, nodSet, H, S, I, Div
  Set DSet = Document.All(DataSet):  Set CreeSet = DSet
  If noz(DSet) Then  If DSet.behaviorUrns.length>0 Then  Exit Function
  If Left(ty(DSet),4)="Disp" Then  Exit Function

  Set nodSet = Tx.DataSet(DataSet)
  TypSet = LitXZ(nodSet,"GENERAL/TYPE"):  If TypSet="" Then  TypSet = LitXZ(nodSet,"AUTO/@Typ")
  If TypSet="" Then  TypSet = "Win"
  If DSet Is Nothing And Left(DataSet,3)="Win" And nodSet Is Nothing  Then  Set nodSet = Tx.DataSet(Mid(DataSet,4))

    wbug "|B~CreeSet " & DataSet & "|/B~, TypSet=" & TypSet
  Set DSet = Document.All(DataSet)
  If DSet Is Nothing Then
  	If TypSet="Win" Then
  		S="WIN":  St="Display:none; "
    Else
      S="":  St="Height:100%; ":  Aj="Div='' TypSet='' ssTyp='' EtapMaj='' NomCle='' TypCle='' ValCle='' AppelSet='' Finish='' Evt=ExecVueEvent"
      If OuiAttr(nodSet,"Drop") Then  Aj=Aj & " Drop='O'"
    End If
    If TypSet="Win" Then  Set Div = Document.Body  Else  Set Div = DivSwap
    H = "<FIELDSET id='" & DataSet & "' " & Aj & " Style='" & St & "Border:0;" & LitXZ(nodSet,"STYLE" & S & "/DIV") & "'></FIELDSET>"
      'mhl H & crr & TypSet & crr & S & crr & mobj(nodSet)
    Div.insertAdjacentHTML "BeforeEnd", H
    Set DSet = Document.All(DataSet)
  End If

  If TypSet<>"Win" Then  	Set D = Document.CreateElement("DIV"):  D.ID = "Model_" & DataSet:  ModelSet.appendChild D

  Select Case TypSet
    Case "ListeG":  I = DSet.addBehavior(RepHTC & "/VueList.htc"):  DSet.SetAttribute "noID", I
    Case "Tree": DSet.addBehavior(RepHTC & "/Menu.htc")
    Case "Win":  DSet.addBehavior(RepHTC & "/Cadre.htc")
    Case "Cal":  DSet.addBehavior(RepHTC & "/Calendrier.htc")
    Case Else:   I = DSet.addBehavior(RepHTC & "/VL.htc"):  DSet.SetAttribute "noID", I
  End Select
  Set CreeSet = DSet
End Function


Sub ExecSet(DataSet, Opt, ApSet)
  Dim AppelSet, DSet, DSetW, DivInto
    'wbug "ExecSet(" & DataSet & ")"
     ' ExecSet "ListExped", "FiltreT={CodMsg IN (SELECT Fils FROM MsgLien WHERE Pere=" & ValCle & ")}", ""
  Set nodSet = Tx.DataSet(DataSet):  If nodSet Is Nothing Then  Exit Sub

  DivInto = LitXZ(nodSet,"STYLE/DIV/@Into"):  If DivInto="" Then  DivInto = "Win" & DataSet
  Set DSetW = CreeSet(DivInto)
  If LitXZ(DSetW,"@Finish")<>"O" Then   SetTimeOut "ExecSet """ & DataSet & """, """ & Opt & """, """ & ApSet & """", 10, "VBS":  Exit Sub

  OpXml nodSet,"STYLE/DIV.Into=" & DSetW.ID
  TypSet = LitXZ(nodSet,"GENERAL/TYPE")
  Droits = 0
  Select Case TypSet
    Case "Liste", "ListeG":  Droits = "  X"
    Case "Maj":    Droits = "  X"
    Case Else:     Droits = ""
  End Select
       'wbug "ExecSet DataSet=" & DataSet & ", v_TypUser=" & v_TypUser & ", Bit(XXX)=" & BitCompare(v_TypUser,"XXX") & ", Droits=" & Droits
  'If Droits<>"" Then  If BitCompare(v_TypUser,Droits)=0 Then   ExecSet "MotPaz", "", DataSet:  Exit Sub

  Set DSet = Document.All(DataSet):  If DSet Is Nothing Then  CreeSet DataSet
  If Left(ty(DSet),4)="Disp" Then  Exit Sub
  Set DSet = Document.All(DataSet)

  If DSet.Finish="" Then   SetTimeOut "ExecSet """ & DataSet & """, """ & Opt & """, """ & ApSet & """", 10, "VBS":  Exit Sub

  If ApSet<>"no" Then
    AppelSet = ApSet
    If AppelSet="" Then AppelSet = LitXZ(nodSet,"@Appel"):  'mhl AppelSet
    'If AppelSet="" And noz(VueOver) Then   AppelSet = VueOver.ID
  End If
    wbug "|B~ExecSet|/B~(" & DataSet & ", " & Opt & ", " & ApSet & ")  , AppelSet=" & AppelSet

  S = IsoleOpt(Opt, "FiltreSeul", "}", 0):  If S<>"" Then  DSet.SetAttribute "FiltreSeul", S
  S = IsoleOpt(Opt, "FiltreT", "}", 0):  If S<>"" Then  DSet.SetAttribute "FiltreTemp", S
  S = IsoleOpt(Opt, "Affich", "}", 0):   If S<>"" Then  DSet.SetAttribute "Affich", S
  If DSet.TypSet="Maj" Then
    VueTyp = IsoleOpt(Opt, "VueTyp", ",", 0):   If VueTyp=""  Then  VueTyp="Maj"
    DSet.ssTyp  = VueTyp
  End If
  DSet.AppelSet = AppelSet
  DSet.SetAttribute "Option", Opt
  If DSet.TypSet<>"Win" Then
    If VueOver Is Nothing  Then  Set VueOver  = DSet
    If VueOn Is Nothing Then  Set VueOn = DSet
  End If
  S = IsoleOpt(Opt, "EtapMaj", "}", 0):  If S="" Then  S = "Reaffich"
  DSet.EtapMaj = S
  DSet.Affich
End Sub


Sub GoSet(DataSet)
  If DataSet<>"" Then  ExecSet DataSet, "", VueOn.ID
End Sub


Sub WaitSet(DataSet)
  Set nodSet = Tx.DataSet(DataSet):  If nodSet Is Nothing Then  Exit Sub
  Set DSet = Document.All(DataSet):  If DSet Is Nothing Then  CreeSet DataSet
  Set DSet = Document.All(DataSet)
  If DSet.Finish="" Then
    Window.Status=Window.Status & ">"
    SetTimeOut "WaitSet """ & DataSet & """", 10, "VBS":  Exit Sub
  End If
End Sub


Sub CleanVue(NomDiv)
  Set Vue = Document.All(NomDiv):   'mhl "CleanVue : " & crr & oDiv.outerHtml
  Vue.Quitter
  Set Divs = oDiv.All.Tags("FIELDSET")
  For Each Dv In Divs
      'mhl "CleanVue : dv=" & dv.outerhtml
    Set DSet = Document.All(Dv.DataSet):   'mhl "CleanVue : DSet=" & DSet.outerHtml
    e = DSet.removeBehavior (DSet.noID):  If Not e Then  mhl e & ", " & Dv.DataSet
    DSet.removeNode True
  Next
End Sub


Sub Import()
  S = "<DIV ID='DivTools' DataSet='" & VueOver.ID & "' Action=Import></DIV>"
  Document.Body.InsertAdjacentHtml "BeforeEnd", S:    'mhl DivTools.outerHtml
  DivTools.addBehavior RepHTC & "/Tools.htc"
End Sub


Sub MenuGeneral()
  'Dim ChaineDom
  'ChaineDom  = "Microsoft.XMLDOM"
  If Document.All("DivMenuGen") Is Nothing Then  Exit Sub
  If v_Ident<>"LAMBIHUB" And ServerName<>"hl" Then
  	If DivMenuGen.InnerHtml="" Then  DivMenuGen.InnerHtml = "<P Style='font:bold 10pt verdana; Color:White'>" & v_NomSite & "</P>"
    Exit Sub
  End If
  set ObjXml = CreateObject(ChaineDom)
  set ObjXsl = CreateObject(ChaineDom)
	ObjXsl.async = False

  ObjXsl.Load "/Applis/Sas/TreeHub/Xsl/XmlMenu.xsl"
  Set nod = AppX.SelectSingleNode("/ROOT/TOPICLIST"):  'mhl nod.xml
  If noz(nod) Then
    Set ObjXml = CreateObject(ChaineDom)
    ObjXml.LoadXML nod.xml
    DivMenuGen.InnerHTML = ObjXml.transformNode(ObjXsl.documentElement)
  End If
  Set ObjXml = Nothing:  Set ObjXsl = Nothing
End Sub


Sub MenuSet(Quoi)
  Dim O, CodTree
  Set O = Window.Event.srcElement:  'mhl O.outerHtml
  PosDiv
  If O.TagName="P" Or O.TagName="IMG" Then  VueOn.CalcWhere O
 	Set nodMenus = VueOn.X.SelectSingleNode("MENUS")
  Set nodMenu = nodMenus.SelectSingleNode("MENUSET[@Tag='" & O.TagName & "']")
  If nodMenu Is Nothing Then  Set nodMenu = nodMenus.SelectSingleNode("MENUSET[not(@Tag)]")
  S = nodMenu.xml:    'mhl S
  If VueOn.TypSet="Tree" And O.TagName="P" Then
   	S = Replace (S, "$CodTree", O.CodTree)
  End If
 	ZoneXml.LoadXml S:  'MsgBox S

  S =   "<DIV ID='MenuW'></DIV>"
  Document.Body.InsertAdjacentHtml "BeforeEnd", S
  MenuW.addBehavior RepHTC & "/MenuContext.htc"
End Sub


'                                                          =================================
' =========================================================        Fonctions  S Q L         =========================================
'                                                          =================================   'xsq
Function AddSQL (Sql, Instruct, Chaine)
    'Sql = AddSql ("SELECT * FROM R_Global WHERE CodUO='_01DI2'", "Where, Add", "CodTree='_01'")
  If Chaine="" Then  AddSQL=Sql:  Exit Function
  'Partie = Mot(Instruct,1):  Op = Mot(Instruct,2)
  Partie = Isole(Instruct,",", 1)
  Op     = Isole(Instruct,",", 2)
 	S1  = DecoupeSQL (Sql,"Select")
 	S2  = DecoupeSQL (Sql,"From")
	S3  = DecoupeSQL (Sql,"Where"):    S30=S3:  If S3<>"" Then  S3=" WHERE " & S3
	S4  = DecoupeSQL (Sql,"GroupBy"):  S40=S4:  If S4<>"" Then  S4=" GROUP BY " & S4
	S5  = DecoupeSQL (Sql,"OrderBy"):  S50=S5:  If S5<>"" Then  S5=" ORDER BY " & S5
	Select Case Partie
		Case "Where"
		  If Op<>"Add" Then  S30="":  S3=""
		  If S30="" Then  S3=" WHERE "  Else  S3=S3 & " AND "
		  S3 = S3 & Chaine
		Case "OrderBy"
		  If Op<>"Add" Then  S5=""
		  If S5="" Then  S5=" ORDER BY " & Chaine  Else  S5=" ORDER BY " & Chaine & "," & S50
  End Select
  If InStr(Sql,"TRANSFORM ")>0 Then
    If S2<>"" Then  S2 = " FROM "  & S2
    S = S1 & S2 & S3 & S4 & S5
  Else
    If S1<>"" Then  S1 = "SELECT " & S1
    If S2<>"" Then  S2 = " FROM "  & S2
    S = S1 & S2 & S3 & S4 & S5
  End If
  AddSQL = S
End Function


Function CreeListeIn(NomSet, NomCh, TypCh, FiltreXml)
  Dim List, S, Filtr
  If FiltreXml<>"" Then  Filtr = "[" & FiltreXml & "]"
  Set nods = AppX.SelectNodes("/ROOT/DATASET[@Nom='" & NomSet & "']/" & sData & "/z:row" & Filtr)
  List = ""
  For Each nod In nods
    S = nod.GetAttribute(NomCh):  If S<>"N" Then  S="'" & S & "'"
    List = AddString(List, ",", S)
  Next
  CreeListeIn = List
End Function


Function ExtraitSql(Vue)
  Dim SetV, nodSql, Sql, S
  Sql = ""
  Set SetV = Vue.X:  If SetV.SelectSingleNode("BD") Is Nothing Then  Exit Function
  NomTable = LitXZ(SetV, "BD/TABLE"):  NomTable = EvalDollar(NomTable)
  If NomTable="" And SetV.SelectSingleNode("BD/SQL") Is Nothing Then  Exit Function

  Set nodSql  = QuelNodSql(Vue)
  If Vue.ssTyp="Tree" And LXS(SetV,"BD/TABLE/@Rac",S)<>"" Then
    SqW = "CodTree Like '" & S & "%'"
  Else
    SqW = ExtraitSqW(Vue)
  End If

  If NOZ(nodSql) Then  If noz(nodSql.FirstChild) Then  Sql = nodSql.FirstChild.nodeValue  Else  Exit Function
  If NZ(Sql)="" Then  Sql = "SELECT * FROM " & NomTable

  Sql = AddSql (Sql, "Where, Add", SqW)
  S = LitXZ(nodSql,"@Tri"):  If S<>"" Then  Sql=Sql & " ORDER BY " & S
  Sql = EvalDollar(Sql):    'wbug "ExtraitSql : ID=" & ID & ", ssTyp=" & ssTyp & ", Sql=" & Sql

  If NOZ(nodSql) Then
    Set nods = nodSql.SelectNodes("SQLCOMBINE")
    For Each nod In nods
    	S   = nod.FirstChild.NodeValue
    	S   = EvalDollar(S)
    	Sql = Sql & "~" & Trim(S)
    Next
  End If

  ExtraitSql = Trim(Replace(Sql,VbLf,""))
End Function


Function ExtraitSqW(Vue)
  Dim VueRech, nodSql, Sql, S, Op, FiltreAdd
  SqW = ""
  Set SetV    = Vue.X
  Set nodSql  = QuelNodSql(Vue)
  If noz(nodSql)  Then
    Set nods = nodSql.SelectNodes("FILTREADD")
    For Each nod In nods
      FiltreAdd = AddString(FiltreAdd, " AND ", Trim(nod.Text))
    Next
  End If

  Set VueRech = QuelVueRech(Vue):  'mhl "ExtraitSqW: " &  Vue.AppelSet & crr & VueRech.ID
  SqW = LitXZ(SetV,"BD/FILTRE")
  If SqW=""  Then
    SqW = LitXZ(nodSql,"FILTRE")
    If SqW=""  Then
      If noz(VueRech) Then  SqW = AddString(SqW, " AND ", VueRech.Where):  'mhl "11 :" & VueRech.Where & crr & SqW & crr & VueRech.ID
      SqW = AddString(SqW, " AND ", nz(Vue.GetAttribute("FiltreTemp")))
      SqW = AddString(SqW, " AND ", FiltreAdd)
    End If
  End If
  SqW = AddString(SqW, " AND ", Vue.ExecEvent("VUE/AddWhere", ""))
  If nz(Vue.GetAttribute("FiltreSeul"))<>"" Then  SqW = Vue.GetAttribute("FiltreSeul")

  If LX(nodSql,"@Opt")="TableChaine" And noz(VueRech) Then  SqW = AddString(SqW, " OR ", "Chemin Like '" & VueRech.ValCle & "%'")

  SqW = EvalDollar("!" & SqW)

  ExtraitSqW = SqW
End Function


Function QuelNodSql(Vue)
  Dim VueRech, nodSql, Sql, S, nod, nd
  Set SetV    = Vue.X
  Set VueRech = QuelVueRech(Vue)
  Set nodSql  = Nothing
  Set nod     = SetV.SelectSingleNode("BD")
  If noz(VueRech) Then
      'wbug "QuelNodSql : " & VueRech.ID
    Set nodSql = nod.SelectSingleNode("SQL[@TypVue='" & VueRech.TypSet & "']")
    If nodSql Is Nothing Then  Set nodSql = VueRech.X.SelectSingleNode("BD/SQL[@Vue='" & ID & "']")
  End If
  If nodSql Is Nothing Then  Set nodSql = RechNodSql(nod,VueRech)
  If nodSql Is Nothing Then  Set nodSql = nod.SelectSingleNode("SQL")
  Set QuelNodSql = nodSql
End Function


Function RechNodSql(nsq, Vue)
  ' Rech du bon SQL. La position du nod est importante (+complexe à plus simple)
  Dim nod
  For Each nod In nsq.SelectNodes("SQL")
    If LXS(nod,"@Test",V)<>"" Then
      S = EvalDollar(V)
      If Eval(S) Then  Exit For
    End If
    If noz(Vue) And LXS(nod,"@Vue",V)<>"" Then
    	If V=Vue.ID Then
			  If LXS(nod,"@SelChamps",S)<>"" Then
			  	'mhl Vue.Where & crr & S
			  	If InStr(Vue.Where,S)>0 Then  Exit For
			  Else
			    Exit For
			  End If
		  End If
	  End If
	Next
	If Not IsVar(nod) Then  Set nod = Nothing
  Set RechNodSql = nod
End Function


Function QuelVueRech(Vue)
  Set QuelVueRech = Nothing
  'Set nod = Vue.X.SelectSingleNode("GENERAL/APPEL")
  VAp = Vue.AppelSet
  If VAp<>"" Then  Set QuelVueRech = Document.All(VAp)
End Function


Function ListChampSql(Chaine, Separ, Separ2)
    ' ListChampSql(SqW, " ", "=<>")
  Li=""
  For Each C In Split(Chaine,Separ)
    p = RechPremCar(C,Separ2):
    If p>0 Then  Li=Li & Left(C,p-1) & ";"
  Next
  If Right(Li,1)=";" Then  Li = Left(Li,Len(Li)-1)
  ListChampSql = Li
End Function


'                                                          =================================
' =========================================================        Fonctions   B D          =========================================
'                                                          =================================
Sub CalcDroits (MotPaz)
  S = v_TypUser
  If noz(Tx.DataSet("MotPaz")) Then
    If Tx.Var("PazAcces")="" Then
      S = BitCode(S, "X", 3)
      If Tx.Var("PazMaj")="" Then
        S = BitCode(S, "X", 2):  If Tx.Var("PazAdmin")="" Then  S = BitCode(S, "X", 1)
      End If
    Else
      If Tx.Var("PazMaj")="" Then
        S = BitCode(S, "X", 2):  If Tx.Var("PazAdmin")="" Then  S = BitCode(S, "X", 1)
      End If
    End If
  Else
    S = "XXX"
  End If
    'mhl v_TypUser & crr & S

  If MotPaz<>"" Then
    If LCase(Tx.Var("PazAcces"))=MotPaz Then
      S = BitCode(S, "X", 3)
    ElseIf LCase(Tx.Var("PazMaj"))=MotPaz Then
      S = BitCode(S, "X", 2)
      S = BitCode(S, "X", 3)
    ElseIf LCase(Tx.Var("PazAdmin"))=MotPaz Then
      S = BitCode(S, "X", 1)
      S = BitCode(S, "X", 2)
      S = BitCode(S, "X", 3)
    End If
  End If
  v_TypUser = S:   'mhl S
End Sub


Function SiAutoIdent()
  If Tx.Var("AccessIdent")<>"Debut" And Tx.Var("PazAcces")="" Then  AutoIdent = False:  Exit Function
  AutoIdent = True
End Function


Function DialogMP()
  Dim MP, S, Rep
  If Tx.Var("AccessIdent")="" Then  DialogMP = True:  Exit Function
  DialogMP = False
  Dial = "Ident"
  On Error Resume Next
  Rep = ShowModalDialog(RepPgm & "/Tools/WinMsg.htm", Window, "dialogWidth:320px; dialogHeight:260px; status:No; center:Yes; help:No; resizable:No;")
  If Err<>0 Then  Exit Function
  If Rep="Quit" Then  Window.Close:  Exit Function
  v_Ident = Rep
  DialogMP = True
End Function


Sub ChargeInfo()
  Dim nod, nodSet, nd

  Set nod = AppX.SelectSingleNode("/ROOT/INFOS/AGENT")
  If noz(nod) Then
    Set OX  = LitSql("Societe", "SELECT * FROM Agents WHERE IdAg='" & v_Ident & "'", NbEnr):  'mhl OX.xml
    Set nox = OX.SelectSingleNode("z:row")
    If nox Is Nothing Then  MsgBox "Impossible charger identification. Ident=" & v_Ident:  Exit Sub
    nod.AppendChild TransfoXml4(nox)
  End If
End Sub


Sub ChargeTable(NomTable, Sql)
  Dim nod, nodSet, nd

  Set nod = AppX.SelectSingleNode("/ROOT/TABLES/TABLE[@Nom='" & NomTable & "']")
  If nod Is Nothing Then  mhl "ChargeTable :  " & NomTable & " non trouvée":  Exit Sub
  Set nodSql = OpXml(nod, "SQL"):  If Sql<>"" Then  nodSql.Text = Sql
  RMNod nod, "DATA":  Set nodD = OpXml(nod, "DATA")
  Set nox = LitSql("", nodSql.Text, NbEnr):  'mhl OX.xml
  If noz(nox) Then   MajNodFils nodD, TransfoXml4(nox), ""
End Sub


Sub InverseSel(Dest, TCh1, TCh2)
    ' Place ds Dest les z:row de TCh1 qui ne sont pas dans TCh2
  TDest = Isole(Dest,".",1):  ChDest = Isole(Dest,".",2)
  T1 = Isole(TCh1,".",1):  Ch1 = Isole(TCh1,".",2):  If Ch1="" Then  Ch1 = ChDest
  T2 = Isole(TCh2,".",1):  Ch2 = Isole(TCh2,".",2):  If Ch2="" Then  Ch2 = ChDest
  Set nod  = OpXml(AppX, "/ROOT/TABLES/TABLE[@Nom='" & TDest & "']"):  RMNod nod, "DATA":  Set nodD = OpXml(nod, "DATA")
  Set nod  = OpXml(AppX, "/ROOT/TABLES/TABLE[@Nom='" & T1 & "']/DATA")
  Set nod1 = nod.CloneNode(True):   'mhl nod1.xml
  Set nod2 = OpXml(AppX, "/ROOT/TABLES/TABLE[@Nom='" & T2 & "']/DATA")
  For Each nod In nod2.SelectNodes("z:row")
    V2 = nod.GetAttribute(Ch2)
    If Not IsNull(V2) Then
      Set nd = nod1.SelectSingleNode("z:row[@" & Ch1 & "='" & V2 & "']"):  'mhl "z:row[@" & Ch1 & "='" & V2 & "']" & crr & noz(nd)
      If noz(nd) Then  RMNod nd, ""
    End If
  Next
  MajNodFils nodD, TransfoXml4(nod1), ""
End Sub


Sub TraitPrim()
  Dim nod, nodSet, nd

  Set nod = AppX.SelectSingleNode("/ROOT/USERS")
  If noz(nod) Then
    Set nds = nod.SelectSingleNode("SELECTION")
    If noz(nds) Then
      S = LitXZ(nds,"@Vue"):  Set nodSet = Tx.DataSet(S)
      If noz(nodSet) Then
        Set nod = nds.SelectSingleNode("FILTREADD[@IdAg='']")
        If noz(nod) Then
          Set nd = OpXml(nodSet, "BD/SQL/FILTREADD.Data()")
          nd.Text="":  nd.ChildNodes(0).Data = nod.Text
        End If
        If v_Ident<>"" Then
          Set nod = nds.SelectSingleNode("FILTREADD[@IdAg='" & v_Ident & "']")
          If noz(nod) Then
            Set nd = OpXml(nodSet, "BD/SQL/FILTREADD.Data()")
            S = nd.ChildNodes(0).Data:  nd.Text = ""
            nd.ChildNodes(0).Data = AddString ("(" & S & ")", " OR ", nod.Text)
            'mhl nod.xml & crr & nd.xml
          End If
        End If
      End If
    End If
  End If
End Sub


Function RechAgent(Proc, Cod)
  Dim cnn, R, S
  RechAgent = ""
  If Right(Proc,5)="Agent" And Cod="" Then  MsgBox "L'identifiant n'a pas été indiqué":  Exit Function
  Set nod = AppX.SelectSingleNode("/ROOT/GENERAL/BD")

  Select Case SupprAccent(LCase(Proc))
    Case "nomagent"
     	RechAgent = LitValSql("Annuaire", "SELECT Nom & ' ' & Prenom AS C1 FROM Base WHERE Ident='" & Cod & "'")
    Case "chef", "responsable"
      Set nod = LitSql("Annuaire", "SELECT Fonction, CodTree FROM Annuaire WHERE Ident='" & Cod & "'", NbEnr)
      If noz(nod) Then  Fct = LitXZ(nod,"@Fonction"):  CodTree = LitXZ(nod,"@CodTree")
        'mhl ObjXml.xml & crr & "Fct=" & Fct & crr & "CodTree=" & CodTree
      If Len(CodTree)=3 Then   RechAgent = Cod:  Exit Function
      CodTree = Left(CodTree,Len(CodTree)-3)
      RechAgent = LitValSql("Annuaire", "SELECT Ident FROM Annuaire WHERE CodTree='" & CodTree & "' AND Left(Fonction,1)='R'")
    Case "assistante", "secretaire"
      CodTree = LitValSql("Annuaire", "SELECT CodTree FROM Annuaire WHERE Ident='" & Cod & "'")
      For L=Len(CodTree) To 3 Step - 3
        Cod = Left(CodTree,L)
        S = LitValSql("Annuaire", "SELECT Ident FROM Annuaire WHERE CodTree='" & Cod & "' AND Left(Fonction,1)='A'")
        If S<>"" And S<>"@EOF@" Then  RechAgent = S:  Exit For
      Next
    Case Else
      'Recherche sur fonctions
      CodFct  = LitValSql("Annuaire", "SELECT Code FROM TFonction WHERE Fonction Like '" & Proc & "'")
      CodTree = LitValSql("Annuaire", "SELECT CodTree FROM Annuaire Ident='" & Cod & "'")
      ' Recherche en remontant l'arbre
      For L=Len(CodTree) To 3 Step - 3
        Cod = Left(CodTree,L)
        'S = LitValSql("Annuaire", "SELECT A.IdAg AS R FROM Agents A, l_AgFct L WHERE A.IdAg=L.IdAg And CodFct=" & CodFct & " AND CodTree='" & Cod & "'")
        S = LitValSql("Annuaire", "SELECT Ident FROM Annuaire WHERE Fonction=" & CodFct & " AND CodTree='" & Cod & "'")
        If S<>"" And S<>"@EOF@" Then  RechAgent = S:  Exit Function
      Next
      ' Recherche en descendant l'arbre
      'S = LitValSql("Annuaire", "SELECT A.IdAg AS R FROM Agents A, l_AgFct L WHERE A.IdAg=L.IdAg And CodFct=" & CodFct & " AND CodTree Like '" & CodTree & "%'")
      S = LitValSql("Annuaire", "SELECT Ident FROM Annuaire WHERE Fonction=" & CodFct & " AND CodTree Like '" & CodTree & "%'")
      If S<>"" And S<>"@EOF@" Then  RechAgent = S
  End Select
End Function


'                                                                     ==================================
' ====================================================================          PROGRAMMATION           ==========================================
'                                                                     ==================================
Function CalcVar (NomVar)
  Dim Vue, Nom, S, SS, T
  Nom = NomVar
    'wbug "CalcVar(" & Nom & ")"
  If IsNumeRic(Nom) Then
    Res = Nom
  ElseIf IsDate(Nom) Then
    Res = Nom
  ElseIf Left(Nom,1) = """" Or Left(Nom,1) = "'" Then
    Res = Mid(Nom,2,Len(Nom)-2)
  ElseIf Left(Nom,2) = "v_" Then
    Res = Eval(Nom)
  ElseIf InStr(Nom,VbLf)>0 Then
    S = "Function Exec_Ev(Param)" & cr & Nom & cr & "End Function"
    Execute S
    Res = Exec_Ev(Param)
  ElseIf InStr(Nom,"(")>0 Then
  	If Left(Nom,1)="$" Then  Nom = Mid(Nom,2)
    Res = Eval(Nom)
  ElseIf Left(Nom,1) = "$" Then
    Res = EvalDollar(Nom)
  Else
    S = Tx.Val(Nom,""):  If Not IsNull(S) Then  CalcVar = S:  Exit Function
    SiNo = True
    If noz(VueOver) Then
      Set Vue = VueOver:  T = Split(Nom,"."):  I=0
      If Ubound(T)>0 Then  Set Vu = Document.All(T(I)):  If noz(Vu) Then  Set Vue = Vu:  Nom = Mid(Nom,Len(T(I))+2):  I=I+1
      NomCh = T(I)
      Set Ch = Vue.GetCtrl(NomCh)
      If noz(Ch) Then
      	SiNo=False
      	Res = Ch.Value
      Else
	      Set Ch = Vue.Champ(NomCh):   'wbug NomVar & crr & Vue.ID & crr & noz(Ch)
	      If noz(Ch) Then
	      	SiNo=False
	      	Res = Vue.Ctrl(NomCh)
	      	If IsNull(Res) Then
		        If ty(Ch)="IXMLDOMAttribute" Then
		          Res = Ch.Text
		        Else
		          If Ch.GetAttribute("TypAff") = "CB" And InStr(Nom,".")=0 Then  Nom=Nom & ".Text"
		          Res = Vue.Val(Nom)
		        End If
	        End If
	        Res = Vue.ValI(NomCh,Res)
	      Else
	        Select Case LCase(Nom)
	        Case "adressefiche"
	          Res = Window.Location & "?Fiche=" & VueOver.NomCle & "=" & rObj(VueOver.ID & "." & VueOver.NomCle)
	          SiNo=False
	        End Select
	      End If
      End If
    Else
      If InStr(Nom,".")>0 Then  S = rObj(Nom):  If Not IsNull(S) Then  Res=S:  SiNo=False
    End If
    If SiNo Then
	    On Error Resume Next:  S = Eval(Nom):  If Err=0 Then  Res = S
	    On Error Goto 0
	  End If
  End If
    'wbug "CalcVar(" & Nom & "), Res=" & Res
  CalcVar = Res
End Function


Function Evalue(Chaine,Opt)
	On Error Resume Next
 	Evalue = Eval(Chaine)
 	If Err<>0 Then
 		If Opt=">" Then  Opt = Err.Description  Else  MsgBox Err.Description
  End If
 	On Error Goto 0
End Function


Sub Evaluation()
  Chaine = InputBox("Entrez une variable")
  S = CalcVar(Chaine)
  MsgBox "Résultat :" & crr & S
End Sub


Function EvalDollar(Chaine)   'xEval
  Dim S, Typ, DataSet, Res, NomVar, Nom, T
  EvalDollar="":  If nz(Chaine)="" Then  Exit Function
    'wbug "EvalDollar Chaine=" & Chaine
  S   = Chaine:  If Left(S,1)="!" Then  S=Mid(S,2):  SiQuote = True  Else  SiQuote = False
  Deb = InStr(S,"$")
  Do While Deb>0
    If Mid(S, Deb+1 ,1)="(" Then
      Nom = IsoleInter(Mid(S, Deb+1))
      Fin = Len(Nom) + 3:  'mhl Nom & crr & Mid(S,Fin)
    Else
      Fin = RechPremCar(Mid(S,Deb+1)," ,;&@#$%'""=<>)" & VbLf & VbCr)   '$Date() ==> $(Date)(), $(Maj.Val("CodCli"))
      If Fin=0 Then  Fin=Len(S)
      Nom = Mid(S, Deb+1, Fin-1)
    End If
    NomVar = Mid(S, Deb, Fin)
    If Nom<>"" Then
      If InStr(Nom,"(")=0 Then  Set nod = AppX.SelectSingleNode("/ROOT/VAR/" & Nom)  Else  Set nod = Nothing
      If noz(nod) Then  Res = LitXZ(nod,"")  Else  Res = CalcVar(Nom)
        'wbug "EvalDollar : Nom=" & Nom & ", NomVar=" & NomVar & ", Res=" & Res
      If SiQuote Then
        nb = CompteCar(Nom,".")
        If nb=1 Or nb=2 Then
          T   = Split(Nom,".")
          Typ = NZ(LitCh(T(0), T(nb), "type")):   'wbug "EvalDollar : Res=" & Res & ", Typ=" & Typ
          Select Case Typ
            Case "T":  Res="""" & Res & """"
            Case "N":  If Res="" Then  Res=0
          End Select
        End If
      End If
    Else
      Res = ""
    End If
    S = Remplace(S, NomVar, Res)
    Deb = InStr(S,"$")
  Loop
  EvalDollar = S
End Function


'                                                                     =================================
' ====================================================================           EVENEMENTS            ==========================================
'                                                                     =================================
Function ExecEvent(NomEv)
    wbug "ExecEvent : VueOn=" & VueOn.ID & ", NomEv=" & NomEv
  Set nodEv = AppX.SelectSingleNode("/ROOT/DATASET[@Nom='" & VueOn.ID & "']/EVENT/" & NomEv):  If nodEv Is Nothing Then  Exit Function
  S = "Function Exec_Ev()" & cr & nodEv.Text & cr & "End Function":    'mhl S
  Execute S
  ExecEvent = Exec_Ev():  'mhl ExecEvent
End Function


Function ExecVueEvent()
  Set e = Window.Event:  'wbug "ExecVueEvent : DataSet=" & e.DataSet & ", TypEv=" & e.TypEv
  PosDiv
  Select Case e.TypEv
    Case "OnFinAffich":
      mhl "OnFinAffich dans U.asp"
      'VueOn.ExecEvent "VUE/OnFinAffich", ""
      VueOn.OnFinAffich
    Case Else:           VueOn.ExecEvent "VUE/" & e.TypEv, ""
  End Select
End Function


Sub onFinForm()
  Set O = Window.Event.srcElement:  'mhl "onFinForm: O=" & O.OuterHtml
  Set Vue = Document.All(O.DataSet)
  Vue.OnPret
End Sub


'                                                                   =================================
' ==================================================================            Drag & Drop          ==========================================
'                                                                   =================================

Sub onMouseDown(e)
  Set O  = e.srcElement:  If NZ(O.GetAttribute("Drag"))="" Then  Exit Sub
End Sub

Sub onMouseUp(e)
End Sub

Sub DragInit(e)
  Set O  = e.srcElement:  If Not OuiAttr(O,"Drag") Then  Exit Sub
    'mhl TypeName(O) & crr & O.OuterHtml
  Set Ox = O:  Set TR = O
	Do Until TR.TagName="TR"
		Set TR = TR.parentElement
  Loop
	Set DivDrag = Document.CreateElement("DIV")
	DivDrag.innerHTML		     = "<TABLE>" & TR.outerHTML & "</TABLE>"
	DivDrag.style.height	   = TR.currentStyle.Height
	DivDrag.style.width 	   = TR.currentStyle.Width:    'mhl TR.Style.PosWidth & ", " & TR.Style.PosHeight
	DivDrag.style.background = "FFFFFF"  'TR.currentStyle.backgroundColor
	'DivDrag.style.fontColor	 = TR.currentStyle.fontColor
	DivDrag.style.position 	 = "absolute"
	Do Until Ox.OffsetParent Is Nothing
		DivDrag.style.PosLeft = DivDrag.style.PosLeft + Ox.offsetLeft
		DivDrag.style.PosTop  = DivDrag.style.PosTop  + Ox.offsetTop:    'mhl Ox.offsetTop & crr & Ox.TagName & crr & Ox.OuterHtml
		Set Ox = Ox.offsetParent
	Loop
    'mhl DivDrag.style.PosTop
 	DivDrag.Style.borderStyle	= "outset"
	DivDrag.Style.display	    = "none"
	DivDrag.Style.zIndex      = 2

	Window.Document.Body.insertBefore DivDrag:   'mhl DivDrag.OuterHtml
End Sub


Sub onDragStart(e)
  Dim Msg, S
  Set O  = e.srcElement:  If nz(O.GetAttribute("Drag"))="" Then  Exit Sub
    wstatus O.OuterHtml
  PosDiv:                 'mhl VueOn.outerHtml

  Msg = VueOn.ID & ";" & O.uniqueID
  e.dataTransfer.setData   "Text", Msg
  e.dataTransfer.clearData "HTML"
  e.dataTransfer.clearData "Image"

  ExecEvent "VUE/onDragStart"
End Sub


Sub onDrag(e)
	If DivDrag Is Nothing Then  Exit Sub
	'midWObj = DivDrag.Style.posWidth / 2
	midHObj = 12
  intTop  = e.clientY + Document.body.scrollTop
  intLeft = e.clientX + Document.body.scrollLeft
    'wstatus "x=" & intTop & ", y=" & intLeft
	cx=0:  cy=0
	'Set elCurrent = DivDrag.offsetParent
  'Do Until elCurrent.offsetParent Is Nothing
  '  cx = cx + elCurrent.offsetTop
  '  cy = cy + elCurrent.offsetLeft
  '  Set elCurrent = elCurrent.offsetParent
  'Loop

  DivDrag.Style.PosTop  = intTop - midHObj
  DivDrag.style.pixelLeft = intLeft '- 20 'midWObj

	If DivDrag.Style.Display = "none" Then  DivDrag.Style.Display = "block"
End Sub


Sub onDragOver(e)
  Set O = e.srcElement:  If Not OuiAttr(O,"Drop") Then  Exit Sub
    'wstatus O.OuterHtml
  e.returnValue = False
  If (e.dataTransfer.getData("Text") <> "") Then
    e.dataTransfer.dropEffect = "copy"
    'wstatus e.dataTransfer.dropEffect
  End If
End Sub


Sub onDrop(e)
  Dim S, T
  Set O = e.srcElement:     'wbuf "onDrop : dataTransfer=" & e.dataTransfer.getData("Text") & cr & Left(O.OuterHtml,200)
	If DivDrag Is Nothing Then  Exit Sub
  PosDiv

  VueOn.ExecEvent "VUE/onDrop", ""

  T = Split(e.dataTransfer.getData("Text"),";")
  Set eOrigin = Document.All(T(1)):  'mhl eOrigin.outerHtml
  onDragEnd2 eOrigin
	e.cancelBubble = False
	e.returnValue  = False
End Sub


Sub onDragEnd(e)
  Set O = e.srcElement:  onDragEnd2 O
End Sub


Sub onDragEnd2(O)
	If DivDrag Is Nothing Then  Exit Sub
  PosDiv2 O:     'mhl O.outerHtml & crr & VueOn.outerHtml
  ExecEvent "VUE/onDragEnd"
  DivDrag.OuterHtml = "":  Set DivDrag = Nothing
End Sub



'                                                          =================================
' =========================================================              XML                ==========================================
'                                                          =================================
Function LitCh(NomVue, oChamp, Attrib)
  Set Vue  = Document.All(NomVue)
  If Vue Is Nothing Then
  	S = LitAttrCh(NomVue, oChamp, Attrib)
  Else
  	V = LitAttrCh(NomVue, oChamp, Attrib & Vue.TypSet)
  	If IsNull(V) Then  V = LitAttrCh(NomVue, oChamp, Attrib)
  End If
  LitCh = V
End Function


Function LitAttrCh (NomVue, oChamp, Attrib)
  Dim nod, S, NomT, NomCh, Vue
  Set Vue  = Document.All(NomVue)
  If Vue Is Nothing Then
    NomT = NomVue
    Set SetV = AppX.SelectSingleNode("/ROOT/TABLES/TABLE[@Nom='" & NomT & "']")
  Else
    Set SetV = Vue.X
    Set nodTable = Vue.X.SelectSingleNode("BD/TABLE")
    If noz(nodTable) Then  NomT = nodTable.Text
  End If
  If SetV Is Nothing Then  Exit Function

    'mhl "Lit" & crr & mobj(oChamp) & crr & "Attrib=" & Attrib
  If TypeName(oChamp)="String" Then
    NomCh = oChamp
    Set nodChV = SetV.SelectSingleNode("VUE//CX[@Nom='" & NomCh & "']")
  Else
    Set nodChV = oChamp:  NomCh = nodChV.GetAttribute("Nom")
  End If
    'wbug "LitCh NomCh=" & NomCh & ", Vue=" & NomVue & ", NomT=" & NomT

  Set nod  = Nothing
  Res      = Null
  Set nodSh  = SetV.SelectSingleNode("CONTENU/ZDATA/xml/s:Schema/s:ElementType/s:AttributeType[@name='" & NomCh & "']/s:datatype")
  If Not nodSh Is Nothing Then
    Set nod = nodSh.SelectSingleNode("@dt:" & Attrib):  If Not nod Is Nothing Then  Res = nod.Text
  End If
  If IsNull(Res) Then
    If Not nodChV Is Nothing Then  Res = nodChV.GetAttribute(Attrib)
  Else
    If Attrib="type" Then
      Res = TypChampWC(Res)
      If Res="T" Then
        S = LitXml(nodSh,"@rs:long")
        If S="true" Then  Res = "M"  Else  Res = "T"
      End If
    End If
  End If
  If IsNull(Res) Then
    Set nod = AppX.SelectSingleNode("/ROOT/TABLES/TABLE[@Nom='" & NomT & "']/CX[@Nom='" & NomCh & "']")
    If Not nod Is Nothing Then  Res = nod.GetAttribute(Attrib)
  End If
  If IsNull(Res) Then
    Set nod = AppX.SelectSingleNode("/ROOT/TABLES//CX[@Nom='" & NomCh & "']")
    If Not nod Is Nothing Then  Res = nod.GetAttribute(Attrib)
  End If

  If IsNull(Res) Then
    Select Case Attrib
      Case "Lib":     Res = NomCh
      Case "type":    Res = "T"
      Case "TypAff":  Res = LitAttrCh (NomVue, oChamp, "type"):  If Res="COMPTEUR" Then  Res = "N"
    End Select
  End If
  LitAttrCh = Res
End Function


Function InfoTableLien (nodCh, TableLiee, CodLie, LibLie, nodT, nodData)
  If TypeName(nodCh)="String" Then
  	Lien  = nodCh
  Else
	  NomCh = nodCh.GetAttribute("Nom")
	  Lien  = nodCh.GetAttribute("Lien")
	End If
  TLiee  = Isole(Lien,"(",1):  TableLiee = EvalDollar(TLiee)
  CodLie = IsoleParam(Lien, TLiee, 1)
  Set nodData = Nothing
    'If InStr(CodLie,"(")>0 Then  CodLie = Calc1Key(NomCh, CodLie)  Else  CodLie = "@" & CodLie
  LibLie = IsoleParam(Lien, TLiee, 2)
  Set nodData = Tx.Data(TableLiee)
  'If NomCh = "CodTree" Then
  '  Set nodT  = AppX.SelectSingleNode("/ROOT/TREE[@Nom='" & TableLiee & "']")
  '  If noz(nodT) Then  Set nodData = nodT.SelectSingleNode("DATA/xml/rs:data")
  'Else
  '  Set nodT  = AppX.SelectSingleNode("/ROOT/TABLES/TABLE[@Nom='" & TableLiee & "']")
  '  If noz(nodT) Then  Set nodData = nodT.SelectSingleNode("DATA")
  'End If
End Function


Function LookUpXml (oSet, Sel, NomCh)
  Dim SetV, Filtr
  Set nodD = Nothing
  If Sel<>"" Then  Filtr = "[" & Sel & "]"
  Select Case TypeName(oSet)
    Case "String"
      Set SetV = AppX.SelectSingleNode("/ROOT/TABLES/TABLE[@Nom='" & oSet & "']")
      If SetV Is Nothing Then
        Set SetV = Tx.DataSet(oSet)
        Set nodD = SetV.SelectSingleNode(sData & "/z:row" & Filtr)
      Else
        Set nodD = SetV.SelectSingleNode("DATA/z:row" & Filtr)
      End If
  End Select
  If nodD Is Nothing Then  LookUpXml = Null  Else  LookUpXml = nodD.GetAttribute(NomCh)
End Function


Function RechChamp (sVue, NomChamp, V)
  Dim nod, nCh, S
  Set nod  = Nothing
  NomVue   = sVue:  If sVue="" Then  NomVue = VueOn.ID
  Set SetV = Tx.DataSet(NomVue)
  Set nCh  = SetV.SelectSingleNode(".//n:CX[@" & NomChamp & "=""" & V & """]")
  If nCh Is Nothing Then  Set nCh  = AppX.SelectSingleNode("/ROOT/TABLES//CX[@" & NomChamp & "=""" & V & """]")
  If nCh Is Nothing Then  Set nCh  = SetV.SelectSingleNode("CONTENU/ZDATA/xml/s:Schema/s:ElementType/s:AttributeType[@name='" & NomChamp & "']/s:datatype")
  Set RechChamp = nCh
End Function


  Function TransfoVarXML (Chaine)
      ' Transforme une variable en sa correspondance XSL
    Dim S, Ch, V
    S   = Chaine
    Deb = InStr(S,"$")
    Do While Deb > 0
      Deb = Deb + 1
      Fin = RechPremCar(Droite(S,Deb)," ,;&?@#$""'=<>" & vbcr)
      If Fin=0 Then  Fin=Len(S)  Else  Fin=Fin + Deb - 1
        'wbug "TransfoVarXML Chaine=" & Chaine & ", Deb=" & Deb & ", Fin=" & Fin
      Ch=Mid(S,Deb,Fin-Deb+1)
      If Ch<>"" Then
        V = "<xsl:value-of select='@" & Ch & "'/>"
        S = Remplace(S, "$" & Ch, V)
          'wbug "__S=" & S & ")"
      End If
      Deb=InStr(S,"$")
    Loop
    TransfoVarXML = S
  End Function


Function CalcCheminCle(Cle, nodSet)
  Select Case Cle
    Case "BD":        S = "/ROOT/GENERAL/BD/EMPLACEMENT":  Set nodSet = AppX
    Case "BASE":      S = "BD/BASE"
    Case "DataSet":   S = "@Nom"
    Case "Type":      S = "GENERAL/TYPE"
    Case "NomTable":  S = "BD/TABLE"
    Case "NomCle":    S = "BD/TABLE/@Cle"
    Case "TypCle":    S = "BD/TABLE/@TypCle"
    Case "Where":     S = "BD/WHERE"
    Case "Data":      S = sData
    Case "SqlSov":    S = "BD/SQLSOV"
    Case Else:        S = ""
       'set nod = nodSet.SelectSingleNode(S):  mhl S & crr & nod.xml
  End Select
  CalcCheminCle = S
End Function


Function FonctionXml(nodD, sSel, Fonction, NomChampCalc)
  Dim objXML, objXSL, oXML, nod, nods
  Sel = sSel:  If Sel<>"" Then  Sel = "[" & Sel & "]"
  Fon = LCase(Fonction):  If Fon="avg" Then  Fon = "sum":  Av = "round(":  Ap = " div count(.//z:row" & Sel & "/@" & NomChampCalc & "))"
  Op  = Av & Fon & "(.//z:row" & Sel & "/@" & NomChampCalc & ")" & Ap

  XS=XS & "<?xml version='1.0'?>" & cr
  XS=XS & "<xsl:stylesheet xmlns:xsl='http://www.w3.org/1999/XSL/Transform'  xmlns:rs='urn:schemas-microsoft-com:rowset' xmlns:z='#RowsetSchema' version='1.0'>" & cr
  XS=XS & "<xsl:template match='/'>" & cr
  XS=XS & "  <ROOT>" & cr
  XS=XS & "    <xsl:value-of select=""" & Op & """/>" & cr
  XS=XS & "  </ROOT>" & cr
  XS=XS & "</xsl:template>" & cr
  XS=XS & "</xsl:stylesheet>"
  'sum(.//units) div count(.//units)"/

  Set objXML = CreateObject(ChaineDom)
  Select Case TypeName(nodD)
    Case "IXMLDOMElement"
      If nodD Is Nothing Then  Exit Function
      objXML.loadXML nodD.Xml
    Case "IXMLDOMSelection"
      If nodD.Length=0 Then  Exit Function
      objXML.loadXML nodD.Context.Xml
    Case Else
      Exit Function
  End Select
  Set objXSL = CreateObject(ChaineDom):  objXSL.loadXML XS
  Set oXML   = CreateObject(ChaineDom)
  oXml.LoadXml objXML.transformNode(objXSL):  S = oXml.SelectSingleNode("/ROOT").Text
  If S="NaN" Then  S=""
    'wbuf nod.xml
    'wbug "FonctionXml(nod, " & Sel & ", " & Fonction & ", " & NomChampCalc & ") = " & S
    'winmsg objXML.xml, "T"
    'winmsg objXSL.xml, "T"
    'winmsg S, "T"
  FonctionXml = S
End Function


Function NettoieXml4(Chemin)
  Dim S
NettoieXml4 = Chemin:  Exit Function
  S = Chemin
  If InStr(S,":")>0 Then
    S = Replace(S, "z:", ""):  S = Replace(S, "rs:", ""):  S = Replace(S, "s:", ""):  S = Replace(S, "dt:", ""):  'S = Replace(S, "n:", "")
  End If
  NettoieXml4 = S
End Function


Function TransfoXml4(objXml)
  'Set TransfoXml4 = objXml:  Exit Function
  If objXml Is Nothing Then  Set TransfoXml4 = Nothing:  Exit Function

  If VersionDomXml=4 Then
    S = objXml.xml:   'WinMsg S, "T"
    Set O = CreateObject(ChaineDom)
    O.LoadXML S:      'WinMsg O.xml, "T"
    Set TransfoXml4 = O.documentElement
  Else
    Set TransfoXml4 = objXml
  End If
End Function


Sub TransfoXmlRecorset (objXml)
    wstatus "Transformation du Xml RecordSet"
    'wbug "TransfoXmlRecorset : "
  If objXml Is Nothing Then  Exit Sub

  Set nods = objXml.SelectNodes("//xml/rs:data/z:row"):  'mhl nods.length
  For Each nod In nods
    Set Ats = nod.Attributes
    For Each At In Ats
      'Set noda = objXml.SelectSingleNode(NettoieXml4("/xml/s:Schema/s:ElementType/s:AttributeType[@name='" & At.nodeName & "']"))
      Set noda = objXml.SelectSingleNode("//xml/s:Schema/s:ElementType/s:AttributeType[@name='" & At.nodeName & "']")
      If Not noda Is Nothing Then
        Set nodTyp = noda.SelectSingleNode("s:datatype/@dt:type")
        If nodTyp.Text = "dateTime" Then  At.Text = ConvDateXML (At.Text,0):      'wbug At.nodeName & "=" & At.Text & ", nodTyp.Text=" & nodTyp.Text
      End If
    Next
    If SiFormule Then
    	Tbl  = Split(ListCh,"~")
    	For i=0 To Ubound(Tbl)-1 Step 2
    	    'wbug "Eval(" & Tbl(i+1) & ")"
     	  V = Eval(Tbl(i+1))
     	  AdNod nod, "", "@" & Tbl(i) & "=" & V
      Next
    End If
  Next
End Sub


Function XmlSel(nodP, TriCh, Sel, Op)
  Dim objXML, objXSL, oXML, nod, nods, T

  XS=XS & "<?xml version='1.0'?>" & cr
  XS=XS & "<xsl:stylesheet xmlns:xsl='http://www.w3.org/1999/XSL/Transform'  xmlns:rs='urn:schemas-microsoft-com:rowset' xmlns:z='#RowsetSchema' version='1.0'>" & cr
  XS=XS & "<xsl:template match='/'>" & cr
  XS=XS & "  <rs:data>" & cr
  XS=XS & "    <xsl:apply-templates select=""//z:row" & Sel & """>" & cr
  T = Split(TriCh,",")
  For Each C In T
    If Isole(C,":",2)="N" Then  Aj=" data-type='number'"  Else  Aj=""
    XS=XS & "      <xsl:sort select='@" & Isole(C,":",1) & "'" & Aj & "/>" & cr
  Next
  XS=XS & "    </xsl:apply-templates>" & cr
  XS=XS & "  </rs:data>" & cr
  XS=XS & "</xsl:template>" & cr

  XS=XS & "<xsl:template match='z:row'>" & cr
  XS=XS & "  <xsl:copy-of select='.'/>" & cr
  'XS=XS & "  <xsl:copy>" & cr
  'XS=XS & "    <xsl:apply-templates select='@* | node()'/>" & cr
  'XS=XS & "    <xsl:apply-templates select='@*'/>" & cr
  'XS=XS & "  </xsl:copy>" & cr
  XS=XS & "</xsl:template>" & cr

  XS=XS & "</xsl:stylesheet>":    'mhl XS

  Set objXML = CreateObject(ChaineDom)
  objXML.loadXML nodP.Xml
  Set objXSL = CreateObject(ChaineDom):  objXSL.loadXML XS

  Set oXML   = CreateObject(ChaineDom)
  oXml.LoadXml objXML.transformNode(objXSL)
    'winmsg objXML.xml, "T"
    'winmsg oXml.xml, "T"
    'winmsg objXSL.xml, "T"
  Set objXML = Nothing:  Set objXSL = Nothing
  If InStr(Op,"R")>0 Then  nodP.ParentNode.ReplaceChild  oXml.DocumentElement, nodP
  If InStr(Op,"S")>0 Then  Set XmlSel = oXML  Else  Set oXML = Nothing
End Function


'                                                          =================================
' =========================================================               Divers            ==========================================
'                                                          =================================

Sub EnvoiMessage(Chemin)
  Dim nod
  Set nod = AppX.SelectSingleNode("/ROOT/PGMDATA" & Chemin):  If Not noz(nod) Then  Exit Sub
  Set ObjXml = CreateObject(ChaineDom)
  ObjXml.LoadXml nod.xml
  Set nod = ObjXml.ChildNodes(0).SelectSingleNode("MSGS/MSG")
  For Each nd In nod.ChildNodes
    S = EvalDollar(nd.Text)
    nd.ChildNodes(0).Data = S
  Next

  If InStr(ServerName,"acor")>0 Then
    Set Post = CreateObject("MSXML2.XMLHTTP." & VersionDomXml & ".0")
    Post.Open "POST", RepPgm & "/Tools/Msg.asp", False
  	ObjXml.async = False
    Post.Send ObjXml:  S = Post.responseText

    If InStr(S,"Transfert")=0 Then
      Set D = Document.CreateElement("DIV"):  D.InnerHtml = LitXZ(nod, "Msg")
      MsgBox S & crr & LitXZ(nod, "Objet") & crr & "Destinataire : " & LitXZ(nod, "AdDest") & crr & "Texte : " & crr & D.InnerText,, "Transfert message impossible"
    End If
  Else
    WinMsg LitXZ(nod, "AdDest") & "<BR>" & S, ""
  End If
End Sub


'                                                          =================================
' =========================================================              Fenêtres           ==========================================
'                                                          =================================

Sub AffichDiv(DivActu)
  ' Toutes des Divs en fond
 	DivActu.Style.Display="block":   'mhl DivActu.Style.Position & crr & DivActu.OuterHtml
  If DivActu.Style.Position="" Then  Exit Sub
 	Set Divs=Document.All.Tags("DIV")
 	For Each Div In Divs
 	  If Not IsNull(Div.GetAttribute("TypSet")) And Div.Style.Position="absolute" Then  Div.Style.zIndex=0
 	Next
 	Set Divs=Document.All.Tags("FIELDSET")
 	For Each Div In Divs
 	  If Not IsNull(Div.GetAttribute("TypSet")) And Div.Style.Position="absolute" Then  Div.Style.zIndex=0:  'mhl nz(Div.Style.Position) & crr & Div.OuterHtml
 	Next
 	' Recherche de la Div Principale qui contient DivActu pour la placer en avant plan
 	Set Div = DivActu:  Set O = DivActu.parentElement
  Do Until O Is Nothing
    If O.TagName="DIV" Or O.TagName="FIELDSET" Then  Set Div = O
	  Set O = O.parentElement
  Loop
 	Div.Style.zIndex=1:  'mhl Div.OuterHtml
End Sub


Sub AffDivMsg()
  If IsVar(DivMsg) Then  Set St=DivMsg.Style:  If St.Display="none" Then  St.Display="block"  Else  St.Display="none"
End Sub


Sub AvantAffMenu()
  S = rObj("/ROOT/TOPICLIST/@DivDessous") & "":  If S<>"" Then  HideChSelect S
End Sub


Sub ApresAffMenu()
  S = rObj("/ROOT/TOPICLIST/@DivDessous") & "":  If S<>"" Then  AffChSelect S
End Sub


Sub AffChSelect(NomDivs)
  Dim Div, T
  T = Split(NomDivs,";")
  For Each NomDiv In T
    Set Div = Document.All(NomDiv):  If Div Is Nothing Then Exit Sub

    For Each O In Div.All.Tags("SELECT")
      If O.GetAttribute("HideChSelect") = "Ok" Then
        O.RemoveAttribute "HideChSelect"
        O.Style.Visibility = "visible"
      End If
    Next
  Next
End Sub

Sub HideChSelect(NomDivs)
  Dim Div, T
  T = Split(NomDivs,";")
  For Each NomDiv In T
    Set Div = Document.All(NomDiv):  If Div Is Nothing Then Exit Sub
      'mhl NomDiv & crr & Div.outerHtml
    For Each O In Div.All.Tags("SELECT")
        'mhl O.outerHtml
      If O.Style.Visibility <> "hidden" Then
        O.SetAttribute "HideChSelect", "Ok"
        O.Style.visibility = "hidden"
      End If
    Next
  Next
End Sub


Sub Imprime(Vue)
  Dim Vu
  If v_Ident="LAMBIHUB" Then  WinMsg Vue.OuterHtml, "T":  Exit Sub

  Set O = VueOn.All("DivUrl")
  If noz(O) Then
    Window.Open DivUrl.Location:  Exit Sub
  End If

  Set WinMess = Window.Open(Root & RepPgm & "/Tools/WinMsg.htm", "WinMess", "toolbar=yes,menubar=yes,scrollbars=yes,resizable=yes")
  Do:  Loop Until WinMess.Document.ReadyState="complete"
  WinMess.Corps.InnerHtml = ""
  WinMess.Focus

  Set Z = WinMess.Corps
  Z.insertAdjacentHtml "BeforeEnd", VueOn.InnerHtml

  Set nods = Z.All.Tags("DIV")
  For Each nod In nods
    S = nod.GetAttribute("Imp"):  If S="No" Then nod.OuterHtml = ""
  Next
  Set nods = Z.All.Tags("TABLE")
  For Each nod In nods
    S = nod.GetAttribute("Imp"):  If S="No" Then nod.OuterHtml = ""
  Next

  Set nods = Z.All.Tags("INPUT")
  For Each nod In nods
    V = nod.Value:  If V="" Then  V="&nbsp;"
    Select Case nod.Type
      Case "button":  nod.RemoveNode True
      Case "text":    nod.OuterHtml = "<SPAN Class='Input' Style='Width:" & nod.OffsetWidth & "px'>" & V & "<SPAN>"
    End Select
  Next

  'Set nods = Z.All.Tags("SELECT")
  'For Each nod In nods
  '  nod.OuterHtml = "<SPAN Class='Input' Style='Width:" & nod.OffsetWidth & "px'>" & LitSelect(nod) & "<SPAN>"
  'Next

  Set nods = Z.All.Tags("TEXTAREA")
  For Each nod In nods
    nod.OuterHtml = "<SPAN Style='Width:" & nod.Cols*5 & "px'>" & nod.Value & "<SPAN>"
  Next

  For Each nod In Z.All.Tags("BUTTON"):  nod.RemoveNode True:  Next
  'WinMess.Print
End Sub


Sub PosDiv()
  Dim S, E, Div
  Set E   = Window.Event.srcElement:  If E Is Nothing Then  Exit Sub
    'wbuf "PosDiv : " & Left(E.OuterHtml,200)
	Set Div = GetParent(E,"DivVue"):    If Div Is Nothing Then  Exit Sub
	Set VueOver = Div:  Set VueOn = Div
    'wbug "PosDiv: VueOver=" & VueOver.ID
End Sub


Sub PosDiv2(Quoi)
  If Quoi Is Nothing Then  Exit Sub
  Select Case TypeName(Quoi)
    Case "String":    Set VueOver = Document.All(Quoi)
    Case Else:        Set VueOver = GetParent(Quoi, "DivVue"):    'wbug "PosDiv2(" & TypeName(Quoi) & "), Trouvé =" & VueOver.ID
  End Select
  Set VueOn = VueOver
End Sub