!
program incollafile
use xincollafile
implicit none
logical :: lotrovo
integer :: zf,k,kk,tipo,diagnostico
character(len=255) ininome,nomefile,titolo,filedacui,idsua
ininome="incollafileprova"
nomefile=ininome(1:len_trim(ininome))//".txt"
zf=len_trim(nomefile)
write(unit=*,fmt=*) "Incollafile genera un file .xhtml contenente"
write(unit=*,fmt=*) "tutte le immagini prescelte..."
write(unit=*,fmt=*) "Ora usa come file comandi : ",nomefile(1:zf)
write(unit=*,fmt=*) " "
write(unit=*,fmt=*) "La prima riga del file di comandi viene ignorata ( titolo )"
write(unit=*,fmt=*) "Per ogni altra riga servono TRE dati :"
write(unit=*,fmt=*) &
"nome_file tra doppi apici, id dell'immagine tra doppi apici e numero del tipo"
write(unit=*,fmt=*) "( -1==solo testo, 0==non immagine, 1==jpg, 2==gif, 3==png, 4==bmp )"
write(unit=*,fmt=*) "[ versione 20110917 - Giampaolo Bottoni ]"
write(unit=*,fmt=*) " "
!
write(unit=*,fmt=*) "Assegna il nome del file pilota delle trasformazioni"
! Tenta 32 volte di aprire il file...
kk=0
do k=0,99
inquire(file=nomefile,exist=lotrovo)
if(lotrovo) then
write(unit=*,fmt=*) "Trovato! ",nomefile(1:zf),&
" Digita 1 per conferma"
read(unit=*,fmt=*) tipo
if( tipo==1 ) then
exit
end if
nomefile=ininome(1:len_trim(ininome))//char(kk+93)//".txt"
zf=len_trim(nomefile)
kk=kk+1
else if(32>kk) then
write(unit=*,fmt=*) kk,") Non trovo ",nomefile(1:zf)
write(unit=*,fmt=*) "Ritenta con un altro nome o dai un invio ..."
read(unit=*,fmt="(1a)") nomefile
zf=len_trim(nomefile)
if (1>zf) then
nomefile=ininome(1:len_trim(ininome))//char(kk+93)//".txt"
zf=len_trim(nomefile)
kk=kk+1
else if ( zf>4) then
ininome=nomefile(1:zf-4)
kk=0
end if
else
stop
end if
end do
open (unit=11,file=nomefile(1:zf),action="read",status="old")
!
! Apre il file risultato
!
open (unit=16,file=nomefile(1:zf)//".xhtml",action="write",status="replace")
call intestazione(diagnostico)
if(diagnostico/=0) then
close(11)
close(16)
write(unit=*,fmt=*)"Errore scrittura. Invia ed amen"
read(unit=*,fmt=*)
stop
end if
!
! Il file di pilotaggio deve contenere una riga di titolo...
!
read(unit=11,fmt="(1a)",iostat=diagnostico) titolo
if(diagnostico/=0) then
close(11)
close(16)
write(unit=*,fmt=*)"Errore lettura del titolo. Invia ed amen"
read(unit=*,fmt=*)
stop
end if
zf=len_trim(titolo)
if(zf>0) then
write(unit=*,fmt=*) titolo(1:zf)
else
close(11)
close(16)
write(unit=*,fmt=*)"Errore lunghezza del titolo. Invia ed amen"
read(unit=*,fmt=*)
stop
end if
!
! Converte vari file mettendoli assieme in un file con estensione .txt
!
write(unit=*,fmt=*) "tipi: 0==non immagine, 1== jpg, 2==gif, 3==png, 4==bmp"
write(unit=16,fmt=*) char(60),"!-- ", &
nomefile(1:len_trim(nomefile))//".txt --",char(62)
ciclo: do k=1,999999999
write(unit=*,fmt=*)"---"
!
! Legge due stringhe tra doppi apici ed un integer.
! La prima stringa è il nome del file da aggiungere
! La seconda stringa è il valore dell'attributo id.
!
read(unit=11,fmt=*,iostat=diagnostico) filedacui,idsua,tipo
if(diagnostico/=0) then
write(unit=*,fmt=*)"Ha raggiunto la fine del file di comandi"
write(unit=*,fmt=*)"alla riga ",k+1
exit ciclo
else
zf=len_trim(filedacui)
write(unit=*,fmt=*) "Codifica ",filedacui(1:zf)
inquire(file=filedacui(1:zf),exist=lotrovo)
if(.not.lotrovo) then
write(unit=*,fmt=*) "NON trovato! - Chiudo"
exit ciclo
end if
if(0>tipo) then
open (unit=12,file=filedacui(1:zf),status="old",action="read")
call ditestomio(idsua(1:len_trim(idsua)),k)
else
open (unit=12,file=filedacui(1:zf),access="direct",form="unformatted", &
recl=1,status="old",action="read")
call pescofilemio(idsua(1:len_trim(idsua)),tipo,k)
end if
close(12)
end if
end do ciclo
close(11)
write(unit=16,fmt=*) c60,"!-- Amen Incollafile --",c62
write(unit=16,fmt="(1a)") c60//"/body"//c62//c60//"/html"//c62
close(16)
write(unit=*,fmt=*) "Un invio per terminare ",nomefile(1:len_trim(nomefile))
read(unit=*,fmt=*)
stop
end program incollafile
!