Select dans un historique

Pour éviter de tout le temps réinventer la roue, voici la requête pour extraire des événements consécutifs dans un historique.
On désire les evt A qui précèdent les evt B (sans forcément être juxtaposés) dans la table historique genre...
+---+---+--------+
|cle|evt| chrono |
+---+---+--------+
| X | A |     81 | <- lui
| X | C |    212 |
| X | B |    215 | <- lui
| X | A |    426 |
| X | A |    575 | <- lui
| X | B |   1257 | <- lui
| X | B |   2301 |
+---+---+--------+

select a.cle, max(a.chrono) "evtA", b.chrono "evtB"
from historique a
, (select bb.cle, aa.chrono ref, min(bb.chrono) chrono
from historique bb, historique aa
where aa.cle = bb.cle
and aa.chrono < bb.chrono
and aa.evt = 'evtA' -- mettre ici code evt pour evtA
and bb.evt = 'evtB' -- mettre ici code evt pour evtB
group by bb.cle, aa.chrono) b
where a.cle = b.cle
and a.chrono < b.chrono
and a.evt = 'evtA'
group by a.cle, b.chrono

La sous-requête renvoie les plus proches événements A postérieurs aux événements B.
Le requête retrouve les plus proches événements B antérieurs à ceux de la sous-requête.

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

Exemple d'utilisation des bib vbscript

' ----- 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"

'
' 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


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

'
' OuvrirSession(SOURCE, USERNAME, PASSWORD, var session)
' FermerSession(var session)
' ExecuterCommande(session, REQUETE)
' OuvrirQuery(Session, REQUETE, var curseur)
' FermerQuery(var curseur)
' DataFromSQL(Session, REQUETE)
'

dim LEC ' last err.number
dim LED ' last err.description

function OuvrirSession(aSource, aUsername, aPassword, gSession)
on error resume next
err.clear
set gSession = CreateObject("ADODB.Connection")
LEC = Err.Number: LED = Err.Description
if LEC = 0 then
gSession.Open "DSN=" & aSource & ";UID=" & aUsername & ";PWD=" & aPassword & ";"
LEC = Err.Number: LED = Err.Description
end if
OuvrirSession = LEC
end function

function FermerSession(gSession)
on error resume next
err.clear
gSession.Close
set gSession = nothing
FermerSession = LEC
end function

function ExecuterCommande(aSession, aRequete)
dim lCommande
on error resume next
Err.Clear
Set lCommande = CreateObject("ADODB.Command")
LEC = err.number: LED = err.description
if LEC = 0 then
lCommande.ActiveConnection = aSession
LEC = err.number: LED = err.description
if LEC = 0 then
lCommande.CommandText = aRequete
LEC = err.number: LED = err.description
if LEC = 0 then
lCommande.Execute
LEC = err.number: LED = err.description
end if
end if
set lCommande = Nothing
end if
ExecuterCommande = LEC
end function

function OuvrirQuery(aSession, aRequete, gCurseur)
on error resume next
err.clear
set gCurseur = CreateObject("ADODB.Recordset")
LEC = err.number: LED = err.description
if LEC = 0 then
gCurseur.Open aRequete, aSession
LEC = err.number: LED = err.description
end if
OuvrirQuery = LEC
end function

function DataFromSQL(aSession, aRequete)
dim lCurseur
OuvrirQuery aSession, aRequete, lCurseur
DataFromSQL = lCurseur.Fields(0)
FermerQuery lCurseur
end function

function FermerQuery(gCurseur)
on error resume next
err.clear
gCurseur.Close
LEC = err.number: LED = err.description
if LEC = 0 then
set gCurseur = Nothing
LEC = err.number: LED = err.description
end if
FermerQuery = LEC
end function

vbscript html library

' cvt en html sauf ligatures e
function cvhtml(a)
dim s
s = a
s = replace(s, "&", "&amp;")
s = replace(replace(s, ">", "&gt;"), "<", "&lt;")
s = replace(replace(replace(s, "Ä", "&Auml;"), "Â", "&Acirc;"), "À", "&Agrave;")
s = replace(replace(replace(s, "ä", "&auml;"), "â", "&acirc;"), "à", "&agrave;")
s = replace(replace(replace(replace(s, "Ë", "&Euml;"), "Ê", "&Ecirc;"), "È", "&Egrave;"), "É", "&Eacute;")
s = replace(replace(replace(replace(s, "ë", "&euml;"), "ê", "&ecirc;"), "è", "&egrave;"), "é", "&eacute;")
s = replace(replace(replace(replace(s, "ï", "&iuml;"), "î", "&icirc;"), "Ï", "&Iuml;"), "Î", "&Icirc;")
s = replace(replace(replace(s, "Ö", "&Ouml;"), "Ô", "&Ocirc;"), "Ó", "&Oacute;")
s = replace(replace(replace(s, "ö", "&ouml;"), "ô", "&ocirc;"), "ó", "&oacute;")
s = replace(replace(replace(replace(s, "Ü", "&Uuml;"), "Û", "&Ucirc;"), "Ú", "&Uacute;"), "Ù", "&Ugrave;")
s = replace(replace(replace(replace(s, "ü", "&uuml;"), "û", "&ucirc;"), "ú", "&uacute;"), "ù", "&ugrave;")
s = replace(replace(s, "ç", "&ccedil;"), "Ç", "&Ccedil;")
cvhtml = s
end function

function htmlHead(aTitre)
dim s
s = "<html><head>"
if trim(aTitre) <> "" then s = s & "<Title>" & cvhtml(aTitre) & "</Title>"
HtmlHead = s & vbCRLF & "<style type=""text/css"" media=""screen"">td, th {font-size:75%;}</style>" & vbCRLF
end function

function HtmlHeadToBody(aAttribs)
if trim(aAttribs) = "" then
htmlHeadToBody = "</head><body>" & vbCRLF
else
htmlHeadToBody = "</head><body " & aAttribs & ">" & vbCRLF
end if
end function

function HtmlFoot
HtmlFoot = "<br><font size=""-1"">" & cvhtml("Page générée le " & date & " à " & time) & "</font><br></body></html>" & vbCRLF
end function

function HtmlTableHeader(aRecordSet)
dim s, i
s = "<tr>"
for i = 0 to aRecordset.Fields.count - 1
s = s & tagTH(cvhtml(aRecordset.fields(i).Name) & "<!-- type:" & aRecordset.fields(i).Type & " -->")
next
HtmlTableHeader = s & "</tr>" & vbCRLF
end function

function HtmlTableLine(aRecordSet)
dim s, i, t
s = "<tr>"
for i = 0 to aRecordSet.Fields.Count - 1
t = aRecordSet.fields(i).Type
if (t = 3) or (t = 131) then
s = s & gTag("td", "align=""right""", nbspifnull(cvhtml(trim(aRecordSet.fields(i) & " "))))
else
s = s & tagTD(cvhtml(trim(aRecordSet.fields(i) & " ")))
end if
next
HtmlTableLine = s & "</tr>" & vbCRLF
end function

function nbspIfNull(s)
if s = "" then nbspIfNull = "&nbsp;" else nbspIfNull = s
end function

function gTag(tag, attribs, s)
if trim(attribs) = "" then gTag = "<" & tag & ">" & s & "</" & tag & ">" else gTag = "<" & tag & " " & attribs & ">" & s & "</" & tag & ">"
end function

function TagTH(s)
if s = "" then TagTH = "<th>&nbsp;</th>" else tagTH = "<th>" & s & "</th>"
end function

function TagTD(s)
if s = "" then TagTD = "<td>&nbsp;</td>" else tagTD = "<td>" & s & "</td>"
end function

function TagTR(s)
tagTR = gTag("tr", "", s)
end function

function tagH3(s)
tagH3 = gTag("h3", "", s)
end function

sub htmlCursorToFile(aRecordset, aFilename, aTitle)
dim lFSO
dim fout
set lFSO = CreateObject("Scripting.FileSystemObject")
set fout = lFSO.OpenTextFile(aFilename, 2, true)
fout.WriteLine htmlHead(aTitle)
fout.WriteLine htmlHeadToBody("")
fout.WriteLine "<table border>"
fout.WriteLine htmlTableHeader(aRecordset)
do while not aRecordset.EOF
fout.WriteLine htmlTableLine(aRecordset)
aRecordset.Movenext
loop
fout.WriteLine "</table>" & htmlFoot
fout.Close
set fout = nothing
set lFSO = nothing
end sub

vbscript excel library

'
' XL = OuvrirExcel(fichier)
' FermerExcel hXL => Enregistre & ferme Excel
' genXLHeader aRS, hXL
' genXLBody aRS, hXL
' genXLDataLine aRS, Line#, hXL
'
function OuvrirExcel(aFilename)
dim lFSO
dim lFile
dim lExcel
dim s
s = aFileName
if ucase(right(aFilename, 4)) <> ".XLS" then s = s & ".xls"
set lFSO = CreateObject("Scripting.FileSystemObject")
set lFile = lFSO.CreateTextFile(s, true)
lFile.Close
set lFile = Nothing
lFSO.DeleteFile(s)
Set lExcel = CreateObject("Excel.Application") ' instancier un Excel
lExcel.workbooks.Add ' ajouter un classeur
lExcel.Activeworkbook.SaveAs s
set OuvrirExcel = lExcel
Set lExcel = nothing
end function

sub FermerExcel(gExcel)
gExcel.ActiveWorkbook.Save
gExcel.ActiveWorkbook.Close
gExcel.Quit
set gExcel = nothing
end sub


Sub GenXLHeader(aRecordset, aExcel)
dim i
dim lColName
dim gWS
set gWS = aExcel.ActiveWorkBook.ActiveSheet
for i = 0 to aRecordset.Fields.Count - 1
if i < 26 then
lColName = chr(i + 65)
else
lColName = chr(int(i/26)+65) & chr((i mod 26)+65)
end if
gWS.Cells(1, i + 1).Value = aRecordset.Fields(i).Name
if aRecordset.Fields(i).type = 129 then
gWS.Columns(lColName & ":" & lColName).NumberFormat = "@"
elseif aRecordset.Fields(i).type = 133 then
gWS.Columns(lColName & ":" & lColName).NumberFormat = "dd/mm/yyyy"
end if
next
gWS.Rows("1:1").Font.Bold = True
set gWS = Nothing
end sub

Sub GenXLDataLine(aRecordSet, aLinNum, aExcel)
dim i
dim gWS
set gWS = aExcel.ActiveWorkBook.ActiveSheet
for i = 0 to aRecordSet.Fields.Count - 1
if aRecordSet.Fields(i).type = 129 then
gWS.Cells(aLinNum, i + 1).Value = trim(aRecordSet.Fields(i))
else
gWS.Cells(aLinNum, i + 1).Value = aRecordSet.Fields(i)
end if
next
set gWS = nothing
end sub

Sub GenXLBody(aRecordSet, aExcel)
dim l
l = 2
do while not aRecordSet.EOF
GenXLDataLine aRecordSet, l, aExcel
l = l + 1
aRecordSet.MoveNext
Loop
end sub

sub xlCursorToFile(aRecordset, aFilename)
dim lExcel
set lExcel = OuvrirExcel(aFilename)
GenXLHeader aRecordset, lExcel
GenXLBody aRecordset, lExcel
FermerExcel lExcel
end sub

vbscript display library

' gestion d'affichage
' print sert à accumuler les lignes à afficher
' EOP les affiche en une fois sur la console ou dans un dialogue

dim output: output = ""
dim nl: nl = ""

sub print(s)
output = output & nl
output = output & s
nl = vbLF
end sub

sub EOP
wscript.echo output
output = ""
nl = ""
end sub

vbscript text library

function txtHeader(aRecordset)
dim s, i
s = ""
for i = 0 to aRecordset.Fields.count - 1
if s <> "" then s = s & vbTab
s = s & aRecordset.fields(i).Name
next
txtHeader = s
end function

function txtDataLine(aRecordSet)
dim s, i, t
s = ""
for i = 0 to aRecordSet.Fields.Count - 1
if s <> "" then s = s & vbTab
s = s & trim(aRecordSet.fields(i) & " ")
next
txtDataLine = s
end function

sub txtCursorToFile(aRecordset, aFilename)
dim fout, lFSO
set lFSO = CreateObject("Scripting.FileSystemObject")
set fout = lFSO.OpenTextFile(aFilename, 2, true)
fout.Writeline txtHeader(aRecordset)
do while not aRecordset.EOF
fout.WriteLine txtDataLine(aRecordset)
aRecordset.Movenext
loop
fout.Close
set fout = nothing
set lFSO = Nothing
end sub

vbscript log library

' LogTo Filename | ""
' LogMe True | False
' Log message

dim logFSO ' un FSO pour moi tout seul
dim logF ' le fichier log
dim logfilename ' nom du log dans c:\log
dim logstatus ' true si log actif

set logFSO = CreateObject("Scripting.FileSystemObject")

sub LogMe(newStatus) ' true or false
logStatus = newStatus
end sub

sub LogTo(aFilename)
if aFileName = "" then
LogFileName = aFileName
LogMe False
else
if ucase(right(aFilename, 4)) = ".LOG" then
LogFileName = "c:\log\" & aFileName
else
LogFilename = "c:\log\" & aFileName & ".log"
end if
end if
end sub

Sub Log(s)
if logStatus then
set logF = logFSO.OpenTextFile(LogFilename, 8, -1) ' ForAppend, Unicode
logF.WriteLine date & " @ " & time & ": " & s
logF.Close
end if
end sub

vbscript include library

sub Include(fname)
dim finclude
set finclude = fso.OpenTextFile(fname, 1)
ExecuteGlobal fInclude.ReadAll
fInclude.Close
set fInclude = nothing
end sub

Remontée d'exception en CL

Je voulais notifier au pgm appelant la survenue d'une erreur dans le pgm appelé.
Voici comment faire :
1. Créer un fichier de messages: CRTMSGF mabib/messages text('Mes messages d''erreur')
2. Gérer les messages de ce fichier avec WRKMSGD *first mabib/messages
3. Créer un ou plusieurs messages avec <F6> et:
3a. MSGID := un identifiant de message (genre MOInnnn) ;
3b. MSG := un texte succint ;
3c. GRAVITY := une gravité.
... à répéter autant que nécessaire
4. aller ensuite dans le source du pgm appelé
5. à l'emplacement où l'on désire déclencher l'exception, glisser SNDPGMMSG MSGID(MOInnnn) MSGF(mabib/messages) msgtype(*escape)
6. dans le pgm appelant, glisser juste après l'appel du pgm appelé MONMSG MOInnnn EXEC(GOTO label)

rmq: le nnnn représente évidemment un nombre. dans le msgf, nnnn prend des valeurs significatives ; dans le monmsg, ce peut être un message en particulier ou un message générique (ie MOI0000)
nota: dans le pgm appelé, l'exécution s'arrête avec le sndpgmmsg grace au *ESCAPE. Je n'ai pas testé d'autres valeurs que *INFO et *DIAG (mais mon monmsg dans l'appelant n'était pas déclenché)

Shortcuts

go.cmd:
@echo off
if .==.%1 goto aide
if /i %1==-e start e c:\bin\go.cmd & goto fin
if /i %1==bureau cd /d "%userprofile%\Bureau" & goto fin
if /i %1==appdata cd /d "%userprofile%\Application Data" & goto fin
if /i %1==settings cd /d "%userprofile%\Local settings" & goto fin
if /i %1==dl cd /d c:\Downloads & goto fin
if /i %1==pub cd /d c:\ftproot & goto fin
if /i %1==incoming cd /d c:\ftproot\incoming & goto fin
echo Token inconnu
goto fin
:aide
echo go emplacement
echo avec emplacement parmi bureau appdata settings dl pub incoming
:fin

zip / unzip en une touche

z.cmd:

@zip -m9 %1.zip %1

u.cmd:

@unzip -o %1
@if not errorlevel 2 del %1

nota:
. le errorlevel est 1 si TZ n'est pas fixée
. évidemment, les jokers ne sont pas gérés

z foo.txt
produit foo.txt.zip & supprime foo.txt

u foo.txt.zip
produit foo.txt & supprime foo.txt.zip

Retrouver vite fait son système opérationnel

J'en suis à ma quatrième installation d'ubuntu 8.04 et pour optimiser la remise en prod, voici les manip et le petit script qui devrait fonctionner nickel
A. Système->Préférences->Apparence : passer toutes les polices en 8 pts et choisir le lissage sous-pixel (LCD)
B. Système->Administration->Réseau : modif la cfg réseau, quitte à abandonner le mode itinérant.
C. Le gestionnaire de mises à jour a trouvé à manger !
* Décocher Evolution s'il est proposé (il sera désinstallé plus tard) ainsi que F-Spot Photo Manager
* Appliquer les mises à jour, même s'il y en a pour bcp
D. Le gestionnaire de mises à jour a trouvé encore des màj :-)
* Re-décocher Evolution s'il est proposé (il sera désinstallé plus tard) ainsi que F-Spot Photo Manager
E. Copie de MailData et .mozilla-thunderbird dans ~
+ Modif du lanceur laissé par Evolution pour tb : /usr/bin/thunderbird
F. Système->Administration->Pilotes de périphérique
> Cocher [] Activer & Confirmer
...Reboot...

exécuter:
sudo apt-get install thunderbird gsynaptics gweled \
gthumb gftp grip vlc clamav clamtk ipod ntp sleuthkit \
lame unrar language-support-fr flashplugin-nonfree \
evolution- evolution-common- f-spot-
aptitude show '~n'|grep Paquet|grep -o gstreamer[0-9\.]*-plugins-ugly$|xargs sudo apt-get -y install
aptitude show '~n'|grep Paquet|grep -o gstreamer[0-9\.]*-ffmpeg$|xargs sudo apt-get -y install
sudo freshclam

(upd: rajout de ntp puis sleuthkit)

Conversion vers HTML

' cvt en html sauf ligatures e
function cvhtml(a)
dim s
s = a
s = replace(s, "&", "&amp;")
s = replace(s, "é", "&eacute;")
s = replace(s, "ó", "&oacute;")
s = replace(s, "ú", "&uacute;")
s = replace(s, "à", "&agrave;")
s = replace(s, "è", "&egrave;")
s = replace(s, "ù", "&ugrave;")
s = replace(s, "Á", "&Aacute;")
s = replace(s, "É", "&Eacute;")
s = replace(s, "Ó", "&Oacute;")
s = replace(s, "À", "&Agrave;")
s = replace(s, "ê", "&ecirc;")
s = replace(s, "î", "&icirc;")
s = replace(s, "ô", "&ocirc;")
s = replace(s, "û", "&ucirc;")
s = replace(s, "ç", "&ccedil;")
s = replace(s, "ë", "&euml;")
s = replace(s, "ï", "&iuml;")
s = replace(s, "ö", "&ouml;")
s = replace(s, "ü", "&uuml;")
s = replace(s, "Ö", "&Ouml;")
cvhtml = s & "<br>"
end function

Décomposer un spoule

Pour convertir un spoule :
1. importer le spoule dans Calc / toute la ligne doit tenir dans une cellule
2. Insérer une ligne de titre
3. dans la ligne de titre (et pour chq colonne) mettre le nb de car représentant la colonne
4. en B2 mettre =SUPPRESPACE(SUBSTITUE(STXT(A2;1;B$1);CAR(160);"")) et répliquer sur toute la hauteur
5. en C2 mettre =SUPPRESPACE(SUBSTITUE(STXT($A2;SOMME($B$1:B$1)+1;C$1);CAR(160);"")) et répliquer sur toute la hauteur
6. répliquer la colonne C (exceptée la lig de titre) pour chaque colonne désirée

Renommer des .mp3

le but: renommer des fichiers .mp3 en nn - titre.mp3 en allant chercher nn et le titre dans les tags mp3.
ça marche bien sous XP sp2, ailleurs j'ai pas testé.

le code:

option explicit
const kTrack = 19
const kTitre = 10

const Test = 0 ' si 0, les changements sont apportés aux fichiers

dim output: output = ""
dim nl: nl = ""
sub print(s)
output = output & nl:output = output & s:nl = vbLF
end sub
sub EOP
wscript.echo output: output = "": nl = ""
end sub

dim objShell: Set objShell = CreateObject ("Shell.Application")
dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
dim objFolder
dim objFile
dim objArgs

dim NomDuDossier
dim NomDuFichier
dim NouveauNom
dim i
dim Dossier
dim TrackNum
dim Titre

Set objArgs = WScript.Arguments
For I = 0 to objArgs.Count - 1
    Dossier = objArgs(I)
    Set objFolder = objShell.Namespace(Dossier)
    for each NomDuFichier in objFolder.Items
        if ucase(mid(NomDuFichier, len(NomDuFichier)-3, 4)) = ".MP3" then
            TrackNum = objFolder.GetDetailsOf(NomDuFichier, kTrack)
            Titre = objFolder.GetDetailsOf(NomDuFichier, kTitre)
            if len(TrackNum) < 2 then TrackNum = "0" & TrackNum
            NouveauNom = TrackNum & " - " & Titre & ".mp3"
            NouveauNom = Replace(Replace(NouveauNom, "\", "_"), "/", "-")
            NouveauNom = Replace(Replace(NouveauNom, "<", "_"), ">", "_")
            NouveauNom = Replace(Replace(NouveauNom, "?", "_"), "*", "_")
            NouveauNom = Replace(Replace(NouveauNom, ":", "_"), "|", "_")
            NouveauNom = Replace(NouveauNom, """", "''")
            if Test = 1 then
                print "ren """ & NomDuFichier & """ """ & NouveauNom & """"
            else
                set objFile = objFSO.GetFile(Dossier & "\" & NomDuFichier)
                on error resume next
                objFile.Name = NouveauNom
                if err <> 0 then
                    err = 0
                    print NomDuFichier & " non changé :-("
                else
                    print Dossier & "\" & NomDuFichier & " => " & NouveauNom
                end if
                on error goto 0
                set objFile = nothing
            end if
        end if
    next
    EOP
    Set objFolder = nothing
Next

Lister la musique

option explicit
dim objfolder, fout
dim s
Set objFolder = CreateObject("Shell.Application").Namespace("C:\MyMusic")
set fout = CreateObject("Scripting.FileSystemObject").CreateTextFile("C:\MyMusic.txt", true, true)

For Each s in objFolder.Items
    if s <> "" and left(s, 1) <> "." and left(s, 1) <> "~" and s <> "My Playlists" then fout.WriteLine s
Next

fout.Close
set fout = Nothing
set objFolder = Nothing
wscript.Echo "Done!"

Ouelcome

Et voilà !
Nouveaux murs, nouveau décor...

Bienvenue dans mon nouveau chez moi :-)