Newsgroup: it.comp.lang.javascript
Titolo: Quasi-script (per QBasic)

Salve, ho scritto e vi posto un paio di sorgenti Qbasic
che ho testato sotto win95. Spero e penso che vi saranno
utili con poche o nessuna modifica, se lo migliorate
fatemi avere i sorgenti migliorati.
Scopo dei due sorgenti sono 
- - creare un numero di pagine html per la visione di 
  immagini in una directory/cartella (avevo chiesto
  se c'erano javascript che realizzano questa funzione)
- - generare dei file htm da corrispondenti file shtml
  per verificare le impostazioni in mancanza di un
  SSI server locale
 
AVVERTENZE: NON SONO PERFETTI, quindi non mi posso
assumere responsabilita' per danni o per l'uso scorretto
che ne venga fatto. Non puo' essere venduto senza il 
mio consenso scritto.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - 




REM dichiarazioni funzioni e subroutine
    DECLARE FUNCTION zDir83$ (zFil32$)
    DECLARE SUB zTravaso (nID%, zFil$)
REM dichiarazioni variabili shared
    DIM SHARED zWrkDsk$, zWrkDir$, zWrkFil$, zWrk$, nWrkID%
    DIM SHARED nHtmID%, zHtmFil$
    DIM zPgm$, zShe$, zTime$
    DIM nPosFile%
 
    zPgm$ = "AGGIORNA" ' ............... Identificativo programma
    nPosFile% = 0 ' .................... Posizione File
REM
REM programma principale
    REM -----------------------------------------------------
    REM Scopo del programma e' verificare un elenco di file
    REM con estensione shtml, dai quali scrivere gli omonimi
    REM file html nei quali i comandi <!--#include file siano
    REM espansi per le verifiche, per documentazione sui
    REM server side
    REM -----------------------------------------------------
    COLOR 15, 1: CLS
    COLOR 0, 15: LOCATE 1, 1
    PRINT MID$(SPACE$(3) + zPgm$ + SPACE$(77), 1, 80);
    COLOR 15, 1: LOCATE 3, 5: PRINT "Aggiornamento file shtml >>
html";
    ''
    ' prendo l'elenco dei files .shtml da elaborare
    GOSUB Elenco.shtml
    ''
    ' per ogni file confronto la data/ora di modifica
    nWrkID% = FREEFILE
    REM zWrk$ = zWrkDsk$ + zWrkDir$ + zWrkFil$
    zWrk$ = zWrkFil$
    OPEN zWrk$ FOR INPUT AS #nWrkID%
    DO UNTIL EOF(nWrkID%)
    ''
    ' elaboro il file .shtml se e' stato modificato dopo la
generazione
    ' del file htm corrispondente
      INPUT #nWrkID%, zWrk$
      ''
      ' Determinazione S.O. ospite
      IF nPosData% = 0 THEN GOSUB Verifica.SO
      ''
      ' Selezione file shtml
      IF INSTR(zWrk$, "shtml") <> 0 THEN
        '
        ' Prelevare nomefile, data e ora modifica
        zShtFil$ = MID$(zWrk$, nPosFile%, 1 + LEN(zWrk$) - nPosFile%)
        zShtFil$ = zDir83$(zShtFil$)
        LOCATE 4, 5: PRINT SPACE$(70); : LOCATE 5, 5: PRINT
SPACE$(70);
        LOCATE 4, 5: PRINT zShtFil$; "<"
        '
        ' Verifica file html corrispondente
        zHtmFil$ = MID$(zShtFil$, 1, LEN(zShtFil$) - 5) + "htm" ' ....
formato FAT32/Linux
        zHtmFil$ = MID$(zShtFil$, 1, INSTR(zShtFil$, ".")) + "HTM" ' .
formato 8.3
        LOCATE 7, 5: PRINT SPACE$(70);
        LOCATE 7, 5: PRINT MID$(zHtmFil$ + "<", 1, 70);
        '
        ' Verifica che il file shtml inizi con <!doctype html
        nShtID% = FREEFILE
        OPEN zShtFil$ FOR INPUT AS nShtID%
        LINE INPUT #nShtID%, zSht$
        CLOSE nShtID%
        IF INSTR(LCASE$(zSht$), "<!doctype html") > 0 THEN
          '
          ' Travaso shtml >> htm
          nHtmID% = FREEFILE
          OPEN zHtmFil$ FOR OUTPUT AS nHtmID%
          CALL zTravaso(nHtmID%, zShtFil$)
          nHtmLen# = LOF(nHtmID%)
          CLOSE nHtmID%
          IF nHtmLen# = 0 THEN
            KILL zHtmFil$
          ELSE
            '
            ' Rinomino il file 8.3 per FAT32/Linux
            zShe$ = "ren " + zHtmFil$ + " "
            zShe$ = zShe$ + MID$(zWrk$, nPosFile%, 1 + LEN(zWrk$) -
nPosFile% - 6) + ".htm"
            SHELL (zShe$)
          END IF
        END IF
      END IF
    LOOP
    ''
    ' chiusura del file
    CLOSE : CLEAR : SYSTEM
REM
REM sub
Elenco.shtml:
  ''
  ' Cancellazione files *.tmp
  zWrkDsk$ = "e:"
  zWrkDir$ = "\tripod\cicely\"
  zWrkFil$ = "*.tmp"
  zShe$ = "del " + zWrkDsk$ + zWrkDir$ + zWrkFil$
  SHELL (zShe$)
  ''
  ' Creazione di una lista dei *.shtml in un file temporaneo
  zTime$ = TIME$
  zWrkFil$ = "~" + MID$(zTime$, 1, 2)
  zWrkFil$ = zWrkFil$ + MID$(zTime$, 4, 2)
  zWrkFil$ = zWrkFil$ + MID$(zTime$, 7, 2) + ".TMP"
  zShe$ = "ver >" + zWrkDsk$ + zWrkDir$ + zWrkFil$
  SHELL (zShe$)
  zShe$ = "dir >>" + zWrkDsk$ + zWrkDir$ + zWrkFil$
  zShe$ = zShe$ + " " + zWrkDsk$ + zWrkDir$ + "*.shtml /o"
  SHELL (zShe$)
  RETURN
Verifica.SO:
  IF nPosFile% > 0 THEN RETURN
  IF LEN(zWrk$) = 0 THEN RETURN
  IF INSTR(zWrk$, "Windows 95") > 0 THEN
    nPosFile% = 45
    RETURN
  END IF
  RETURN
REM funzioni e subroutine
FUNCTION zDir83$ (zFil32$)
STATIC zDir$, nDirID%
  zDir$ = "~tempdir.tmp"
  nDirID% = FREEFILE
  zShe$ = "dir " + zFil32$ + " >" + zDir$
  SHELL (zShe$)
  zDir83$ = ""
  OPEN zDir$ FOR INPUT AS #nDirID%
  DO UNTIL EOF(nDirID%)
    LINE INPUT #nDirID%, zDir$
    IF LEN(zDir$) > 8 AND MID$(zDir$, 1, 1) <> " " THEN
      zDir83$ = MID$(zDir$, 1, (INSTR(zDir$, " ") - 1)) + "." +
MID$(zDir$, 10, 3)
      CLOSE nDirID%
      EXIT FUNCTION
    END IF
  LOOP
  CLOSE nDirID%
END FUNCTION
SUB zTravaso (nID%, zFil$)
STATIC zInc$, nInc%
    REM copia su #nHtmID% il file zFil$
    zInc$ = "<!--#include file="
    nInc% = 2 + LEN(zInc$)
    nFilID% = FREEFILE
    OPEN zFil$ FOR INPUT AS nFilID%
    zFilBuf$ = ""
    DO UNTIL EOF(nFilID%)
      LINE INPUT #nFilID%, zFilBuf$
      IF INSTR(zFilBuf$, zInc$) > 0 THEN
        zShe$ = MID$(zFilBuf$, nInc%, (INSTR(nInc%, zFilBuf$,
CHR$(34)) - nInc%))
        zFil2$ = zDir83$(zShe$)
        CALL zTravaso(nID%, zFil2$)
      ELSE
        PRINT #nID%, zFilBuf$
      END IF
    LOOP
    CLOSE nFilID%
END SUB
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
REM GenHTML.bas
REM scopo del programma e' di estrarre le date di ultima modifica
REM di una directory (ricorsivamente) creando (aggiungendo) un elenco
REM di file (sorgenti COBOL) modificati e in che data
''
' dichiarazioni di vettori e funzioni
  DECLARE SUB zDispErr () ' .......... Display msg errore o warning
  DECLARE SUB zDispCopy () ' ......... Display note Copyright
''
' dichiarazioni variabili globali
  DIM SHARED zSTC$, zOk$, zWarn$' .... Status code condiviso
  DIM SHARED zPGM$, zRTN$ ' .......... Nome programma e rtn in uso
  DIM SHARED zPrf$ ' ................. profilo con ? e * dei file da
usare
  ' .................................. File html generati
  DIM zGenDsk$ ' . . . . . . . . . . . disco
  DIM zGenDir$ ' . . . . . . . . . . . directory
  DIM zGenFil$ ' . .  . . . . . . . .  nomefile
  ' .................................. comandi DOS
  DIM zShe$ ' . . . . . . . .  . . . . stringa riga di comando
ON ERROR GOTO 0
''
' dichiarazioni di variabili globali
  zPGM$ = "GenHTML" ' ................ Nome del programma
  zRTN$ = zPGM$ ' .................... Nome della routine o funzione
in uso
  nOpnFile% = 0 ' .................... Numero file aperti ad ora
  zSTC$ = "0000" ' ................... Status Code
  zOk$ = "0000" ' .................... Tutto bene . . . . . . I
Informazioni
  zWarn$ = "0999" ' .................. Fino a qui solo avvisi W
Warning
  ' .................................. Oltre causa uno stop   A
Ab(normal)End
''
' main del programma
  COLOR 11, 9: CLS
  COLOR 11, 9: PRINT zPGM$ + " " + STRING$(78 - LEN(zPGM$), "_")
  ''
  '
  zGenDsk$ = ""
  zGenDir$ = ""
  zGenFil$ = zGenDsk$ + zGenDir$ + "index.htm"
  zShe$ = "del " + zGenDsk$ + zGenDir$ + "ind*.htm"
  SHELL (zShe$)
  ''
  ' scrittura pagina index.htm
  zGenDsk$ = ""
  zGenDir$ = ""
  zGenFil$ = zGenDsk$ + zGenDir$ + "index.htm"
  OPEN zGenFil$ FOR OUTPUT AS #1
  PRINT #1, "<!doctype html public " + CHR$(34) + "-//ietf//dtd html
3.0//it" + CHR$(34) + ">"
  PRINT #1, "<html><head>"
  PRINT #1, "<title>Elenco immagini sul disco fisso " + zGenDsk$ +
zGenDir$ + "</title>"
  PRINT #1, "</head>"
  PRINT #1, "<frameset cols=" + CHR$(34) + "180,*" + CHR$(34) + "
frameborder=0 border=0 framespacing=0>"
  PRINT #1, " <frame set marginwdth=0 marginheight=0 src=" + CHR$(34)
+ "indexl.htm" + CHR$(34) + " name=" + CHR$(34) + "index" + CHR$(34) +
" >"
  PRINT #1, " <frame set marginwdth=0 marginheight=0 src=" + CHR$(34)
+ "indexr.htm" + CHR$(34) + " name=" + CHR$(34) + "body" + CHR$(34) +
"  >"
  PRINT #1, "</frameset>"
  PRINT #1, "</html>"
  CLOSE #1
  ''
  ' scrittura pagina indexr.htm - Istruzioni
  zGenDsk$ = ""
  zGenDir$ = ""
  zGenFil$ = zGenDsk$ + zGenDir$ + "indexr.htm"
  OPEN zGenFil$ FOR OUTPUT AS #1
  PRINT #1, "<!doctype html public " + CHR$(34) + "-//ietf//dtd html
3.0//it" + CHR$(34) + ">"
  PRINT #1, "<html><head>"
  PRINT #1, "<title>Istruzioni per l'uso</title>"
  PRINT #1, "</head>"
  PRINT #1, "<body>"
  PRINT #1, " <P>Premere su una delle voci riportate a sinistra come
nomefile"
  PRINT #1, "per visualizzarle in questo riquadro, tutto qui.</P>"
  PRINT #1, "</body>"
  PRINT #1, "</html>"
  CLOSE #1
  ''
  ' Creo lista nomifiles
  zGenDsk$ = ""
  zGenDir$ = ""
  zGenFil$ = zGenDsk$ + zGenDir$ + "indexd.txt"
  zShe$ = "dir " + zGenDsk$ + zGenDir$ + "*.gif /o  >" + zGenFil$
  SHELL (zShe$)
  zShe$ = "dir " + zGenDsk$ + zGenDir$ + "*.jpg /o >>" + zGenFil$
  SHELL (zShe$)
  ''
  ' uso la lista di nomi per creare 1 + N file html (limite 999 solo
di comodo)
  OPEN zGenFil$ FOR INPUT AS #3
  zGenFil$ = zGenDsk$ + zGenDir$ + "indexl.htm"
  OPEN zGenFil$ FOR OUTPUT AS #2
  PRINT #2, "<!doctype html public " + CHR$(34) + "-//ietf//dtd html
3.0//it" + CHR$(34) + ">"
  PRINT #2, "<html><head>"
  PRINT #2, "<title>Indice immagini</title>"
  PRINT #2, "</head>"
  PRINT #2, "<body>"
  PRINT #2, "<font face=" + CHR$(34) + "Helvetica,Verdana,Arial" +
CHR$(34) + "size=-2>"
  PRINT #2, "<OL>Elenco Files<br>"
  i% = 1001
  DO
    INPUT #3, zWrk$ ' indexd.txt
    ' PRINT zWrk$
    IF (44 = INSTR(43, zWrk$, " ")) THEN
      zWrk$ = MID$(zWrk$, 45)
     ' PRINT "sto elaborando il file : ind" + MID$(STR$(i%), 3, 3) +
".htm per img" + zWrk$; "<-"
      ''
      ' scrittura file #3
      zGenFil$ = zGenDsk$ + zGenDir$ + "ind" + MID$(STR$(i%), 3, 3) +
".htm"
      OPEN zGenFil$ FOR OUTPUT AS #1
      PRINT #1, "<!doctype html public " + CHR$(34) + "-//ietf//dtd
html 3.0//it" + CHR$(34) + ">"
      PRINT #1, "<html><head>"
      PRINT #1, " <title>Immagine n." + MID$(STR$(i%), 3, 3) +
"</title>"
      PRINT #1, "</head>"
      PRINT #1, "<body>"
      PRINT #1, "<font face=" + CHR$(34) + "Helvetica,Verdana,Arial" +
CHR$(34) + "size=+1><b> &nbsp;" + MID$(STR$(i%), 3, 3) + " " +
zGenDsk$ + zGenDir$ + zWrk$ + "<br></b></font>"
      PRINT #1, " <img vspace=12 hspace=12 src=" + CHR$(34) + zWrk$ +
CHR$(34) + " border=0>"
      PRINT #1, "</body>"
      PRINT #1, "</html>"
      CLOSE #1
      ''
      '
      zShe$ = "<li><a href=" + CHR$(34) 
      zShe$ = zShe$ +  zGenFil$ + CHR$(34)
      zShe$ = zShe$ + " target=body >" + zWrk$ + "</A> "
      PRINT #2, zShe$
      i% = i% + 1
    END IF
  LOOP UNTIL EOF(3) OR (i% > 1999)
  PRINT #2, "<br>Fine elenco.</OL></font></body>"
  PRINT #2, "</html>"
  ''
  ' fine loop
  ''
  ' fine
  PRINT zPGM$: CALL zDispCopy
  SYSTEM
''
' subroutine e funzioni
SUB zDispCopy
  zRTN$ = "zDispCopy()"
  PRINT "(c) Copyright 1998, Massimo Rainato, Albignasego - Padova
Italia "
END SUB
SUB zDispErr
  ' unica sub che non imposta zRTN$
  IF zSTC$ = zOk$ THEN
    PRINT DATE$ + " " + TIME$ + " I " + zSTC$ + " " + zRTN$
    EXIT SUB
  END IF
  IF zSTC$ <> zOk$ AND zSTC$ < zWarn$ THEN
    PRINT DATE$ + " " + TIME$ + " W " + zSTC$ + " " + zRTN$
    EXIT SUB
  END IF
  '
  PRINT DATE$ + " " + TIME$ + " A " + zSTC$ + " " + zRTN$
  CALL zDispCopy
  SYSTEM
END SUB
