Demo bib vbscript AVEC queries.vbs

Voici l'exemple du 27 octobre corrigé avec queries.vbs:
* la mega-concatenation d'une chaine a disparu
* la requete se trouve dans les commentaires => plus de guillemets à doubler !
* les pseudo-param facilitent la vie
* j'aurais peut-être du mettre toutes les constantes en pseudo-parametre :-)
... c'est vrai que j'ai pas tester mais à la prochaine extraction, c'est ce script qui sera lancé

Here is the demo script from october 27th, using queries.vbs:
* the mega-concat of a string is wiped
* the query is written in comments => no more double '"' to name columns
* Pseudo parameters make writing and understanding easier
* perhaps I should convert any constant to pseudo-parameter :-)
... but I did not test this script ; for next query, this script will be run in place of older one



' ----- Activite Ateliers
'
dim fso: set fso = CreateObject("Scripting.FileSystemObject")
dim f: set f = fso.OpenTextFile("c:\lib\include.vbs", 1): ExecuteGlobal f.ReadAll: f.Close: set f = nothing

include "c:\lib\database.vbs"
include "c:\lib\texte.vbs"
include "c:\lib\html.vbs"
include "c:\lib\display.vbs"
include "c:\lib\excel.vbs"
include "c:\lib\log.vbs"
include "c:\lib\queries.vbs"

'[main]
'select fsnumdoc1||fsnumdoc2 "N°FS"
', fspn "P/N"
', fssn "S/N"
', fsouvdat "Ouverture"
', case when year(fsferdat)=1 then null else fsferdat end "Fermeture"
', sum(fptemps) "Tps passé"
'from amsf.frfs fs, amsf.frfp fp
'where fsnumdoc1 = fpnumdoc1 and fsnumdoc2 = fpnumdoc2
'and ((fsouvdat between ':dtDEB-10-01' and ':dtFIN-09-30')
'or (fsferdat between ':dtDEB-10-01' and ':dtFIN-09-30')
'or (fsouvdat < ':dtDEB-10-01' and fsferdat > ':dtFIN-09-30')
'or fsferdat is null
'or year(fsferdat) = 1
')
'and fs.fscodmag in ('WH1', 'WHA')
'and fstype = '1'
'and fspn in ('9543809-1', '5003706', '9550504', 'AHA1291', 'AHA1349', 'AHA1802')
'group by fsnumdoc1||fsnumdoc2, fspn, fssn, fsouvdat, case when year(fsferdat)=1 then null else fsferdat end
'order by 2, 3, 4
'

'^ leave an empty line to end SQL area / laisser une ligne vide pour terminer la zone SQL
'
' pls, Modifier les paramètres
'
dim ParamAnneeDeb: ParamAnneeDeb = "2008"
dim ParamAnneeFin: ParamAnneeFin = "2009"

dim maSession, monCurseur
dim fout
dim R ' texte de la requête
dim fname: fname = "c:\temp\ActiviteAteliers " & ParamAnneeDeb & "-" & ParamAnneeFin & ".xls"

LogTo "ActiviteAteliers"
LogMe False
Log "AnneeDeb=" & ParamAnneeDeb
Log "AnneeFin=" & ParamAnneeFin
Log "fname=" & fname

LoadQuery "c:\scripting\demo.vbs", "main", R
SubstParm "dtDEB", ParamAnneeDeb, R
SubstParm "dtFIN", ParamAnneeFin, R
Log "requete=" & r

OuvrirSession "maSource", "monCompte", "monPass", maSession
Log "OuvrirSession() => LEC=" & LEC & ", LED=" & LED
OuvrirQuery maSession, R, monCurseur
Log "OuvrirQuery() => LEC=" & LEC & ", LED=" & LED
xlCursorToFile monCurseur, fname
FermerQuery monCurseur
FermerSession maSession

if instr(ucase(fname), ".XLS") > 0 then fso.CopyFile fname, "\\webserver\webshare\", True
set fso = nothing
Log "Done!"

VBScript lib / manip chaines requetes

' option explicit ' <== uncomment to debug
'
' QUERIES.VBS
' loadQuery filename, queryname, var texte
' SubstParm paramname, value, var texte
'

' explore aFilename à la recherche de '[<aQueryname>] puis charge les lignes non vides dans gTexte
sub LoadQuery(aFilename, aQueryName, gTexte)
dim lFSO, lFin, s, done
err.clear: on error resume next
set lFSO = createObject("Scripting.FileSystemObject")
if err.Number = 0 then
  set  lFin = lFSO.OpenTextFile(aFileName, 1)
if err.Number = 0 then
    on error goto 0
    done = lFin.AtEndOfStream
    gTexte = ""
    while not done
      s = lFin.ReadLine
      if s <> "" then
        if left(s, 2) = "'[" then ' s'il s'agit d'un commentaire
        s = trim(mid(s, 3, len(s) - 2)) ' => keyw]
        s = trim(left(s, len(s) - 1)) ' => keyw
        if ucase(s) = ucase(aQueryName) then ' on a trouvé notre requête => la charger
            while not done
              s = lFin.readLine
              if s = "" or s = "'" or left(s, 2) = "'[" then
                done = true
              else
              if gTexte <> "" then gTexte = gTexte & " "
                gTexte = gTexte & right(s, len(s) - 1)
                done = lFin.AtEndOfStream
              end if
            wend ' not done
        end if ' s = <keyw>
        end if ' = '[
      end if ' s <> ''
      done = done or lFin.AtEndOfStream
    wend ' not done
    lFin.Close
    Set lFin = Nothing
  end if ' lFin disponible
  Set lFSO = Nothing
end if ' lFSO disponible
if err.number <> 0 then err.raise
end sub

' substitue <aValue> à :<aParamName> dans <gTexte>
sub SubstParm(aParamName, aValue, gTexte)
if trim(gTexte) <> "" and trim(aParamName) <> "" then
gTexte = replace(gTexte, ":" & aParamName, aValue)
end if
end sub

'
'[QRY1]
'select * from amsf.frps
'where pspn like 'A%'
'[MegaUpdate]
'[QRY2]
'update amsf.frst
'set stcodrav = (select count(1) from frsta
'where stapn=stpn and stcodmag=:MAG)
'
' ----- area to uncomment to test this lib
'dim srcFile: srcFile="c:\lib\queries.vbs"
'dim texte: texte = "rien n'a été trouvé"
'LoadQuery srcfile, "", texte
'wscript.echo "(vide) => " & texte
'LoadQuery srcfile, "Introuvable", texte
'wscript.echo "Introuvable => " & texte
'LoadQuery srcfile, "mEGAuPDATE", texte
'wscript.echo "MegaUpdatE => " & texte
'LoadQuery srcfile, "qry1", texte
'wscript.echo "QRY1 => " & texte
'LoadQuery srcfile, "qry2", texte
'wscript.echo "QRY2 => " & texte
'SubstParm "MAG", "'ONE'", texte
'wscript.echo texte