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