program indaesadecimale
!
! Usa, se lo trova, il file indaesadecimaleini.txt
! e potrebbe operare su diversi file di ingresso,
! altrimenti legge un unico file di ingresso scelto
! tramite la tastiera...
!
! Converte un qualsiasi file binario in esadecimale usando
! come cifre i caratteri Unicode da 192 a 207 ossia dei
! caratteri di testo rarissimamente usati nei documenti
! di testo.
!
! Quando decodifica ignora qualsiasi carattere ad eccezione
! dei caratteri Unicode tra 192 e 208 per cui, in pratica,
! diventa possibile realizzare un file HTML fatto di caratteri
! che non interferiscono con quelli, insoliti, usati dalla
! codifica esadecimale...
!
! Se trova il carattere 208 in fase di decodifica chiude
! il file che stava scrivendo e ne apre un altro.
!
! Il primo file che crea decodificando ha estensione .x2345
! l'eventuale secondo .x2346 e cosi' via...
!
! Se usa il file di inizializzazione l'estensione deve essere scelta
! ossia potrebbe essere .y2345 o .z2345 ( la parte numerica viene
! comunque sempre gestita dal programma )
!
! In sintesi un qualsiasi documento HTML potrebbe "veicolare" un
! qualsiasi insieme di file di qualsiasi tipo binario.
!
implicit none
logical:: lotrovo
integer:: k,no,kodifico
character(len=4) sno
character(len=128) nomef
nomef="indaesadecimaleini.txt"
inquire(file=nomef(1:len_trim(nomef)),exist=lotrovo)
if(lotrovo) then
write(unit=*,fmt=*)"Digita 1 per usare "//nomef(1:len_trim(nomef))
read(unit=*,fmt=*) k
if(k/=1) then
nomef="indaesadecimaleinu.txt"
inquire(file=nomef(1:len_trim(nomef)),exist=lotrovo)
end if
else
nomef="indaesadecimaleinu.txt"
inquire(file=nomef(1:len_trim(nomef)),exist=lotrovo)
end if
write(unit=*,fmt=*)"Digita 0 per operare COMUNQUE manualmente"
read(unit=*,fmt=*) k
if(k==0) then
lotrovo=.false.
end if
if(lotrovo) then
write(unit=*,fmt=*) "Pilotato dal file "//nomef(1:len_trim(nomef))
open(unit=11,file=nomef(1:len_trim(nomef)),status="old",action="read")
read(unit=11,fmt=*,iostat=no) kodifico
if(no/=0) then
write(unit=*,fmt=*) "Errore di lettura dal file "//nomef(1:len_trim(nomef))
write(unit=*,fmt=*)
write(unit=*,fmt=*) "La prima riga deve contenere un intero"
write(unit=*,fmt=*) "Se l'intero vale 1 codifica altrimenti decodifica"
write(unit=*,fmt=*) "Se codifica, in ogni riga seguente usa ..."
write(unit=*,fmt=*) " il nome del file da codificare, tra doppi apici"
write(unit=*,fmt=*) "Se decodifica, in ogni riga seguente contiene due dati :"
write(unit=*,fmt=*) " 1) il nome del file da decodificare, tra doppi apici"
write(unit=*,fmt=*) " 2) l'estensione dei file generati, tra doppi apici"
else
if(kodifico==1) then
cod:do k=1,9999
read(unit=11,fmt=*,iostat=no) nomef
if(no/=0) then
exit cod
end if
call codifica(nomef(1:len_trim(nomef)))
end do cod
else
decod:do k=1,9999
read(unit=11,fmt=*,iostat=no) nomef,sno
if(no/=0) then
exit decod
end if
sno(1:1)="."
call decodifica(nomef(1:len_trim(nomef)),sno(1:len_trim(sno)))
end do decod
end if
end if
else
!
write(unit=*,fmt=*)"Codificatore e Decodificatore in cifre esadecimali"
write(unit=*,fmt=*)"Usa il file pilotaggio : indaesadecimaleini.txt"
write(unit=*,fmt=*)"e se non lo trova tenta di usare indaesadecimaleinu.txt"
write(unit=*,fmt=*)" "
write(unit=*,fmt=*)"Converte un qualsiasi file binario in esadecimale usando"
write(unit=*,fmt=*)"come cifre i caratteri Unicode da 192 a 207 ossia dei"
write(unit=*,fmt=*)"caratteri di testo rarissimamente usati nei documenti"
write(unit=*,fmt=*)"di testo."
write(unit=*,fmt=*)"Quando decodifica ignora qualsiasi carattere ad eccezione"
write(unit=*,fmt=*)"dei caratteri Unicode tra 192 e 208 per cui, in pratica,"
write(unit=*,fmt=*)"diventa possibile realizzare un file HTML fatto di caratteri"
write(unit=*,fmt=*)"che non interferiscono con quelli, insoliti, usati dalla"
write(unit=*,fmt=*)"codifica esadecimale."
write(unit=*,fmt=*)" "
write(unit=*,fmt=*)"Se trova il carattere 208 in fase di decodifica chiude"
write(unit=*,fmt=*)"il file che stava scrivendo e ne apre un altro."
write(unit=*,fmt=*)" "
write(unit=*,fmt=*)"Il primo file che crea decodificando ha estensione .x2345"
write(unit=*,fmt=*)"l'eventuale secondo .x2346 e cosi' via..."
write(unit=*,fmt=*)" "
write(unit=*,fmt=*)"Giampaolo Bottoni : versione 4 aprile 2012"
write(unit=*,fmt=*)" "
write(unit=*,fmt=*)"Digita 1 se vuoi codificare, altrimenti decodifica"
read(unit=*,fmt=*) kodifico
if(kodifico==1) then
write(unit=*,fmt=*)"Trasforma in esadecimale"
write(unit=*,fmt=*)"Genera un file con estensione .txt"
call codifica("0")
else
write(unit=*,fmt=*)"Decodifica usando solo i caratteri esadecimali"
write(unit=*,fmt=*)"Genera file con estensione .x234#"
call decodifica("0",".x")
end if
end if
write(unit=*,fmt=*)"Ha finito. Un invio..."
read(unit=*,fmt=*)
stop
!
contains
!
subroutine codifica(nome)
character(len=*),intent(in)::nome
character(len=1)::bit8
character(len=2)::dueb
character(len=256)::nomefile,riga
integer::nf,j,k,nstato,m,r,diagnostico,diagnosticw
integer::nbit,nbit1,nbit2,kk,kkk
logical::esiste
!
write(unit=*,fmt=*)"Digita il nome del file da trasformare in esadecimale"
do j=1,3
if(len_trim(nome)>3) then
nomefile=nome
if(j>1) then
exit
end if
else
read(unit=*,fmt="(1a)") nomefile
endif
nf=len_trim(nomefile)
if(1>nf ) then
exit
end if
write(unit=*,fmt=*)"Cerco ",nomefile(1:nf)
inquire(file=nomefile(1:nf),exist=esiste)
if(esiste) then
write(unit=*,fmt=*)"Apertura riuscita"
open (unit=12,file=nomefile(1:nf),access="direct",form="unformatted", &
recl=1,status="old",action="read")
open (unit=13,file=nomefile(1:nf)//".txt",access="direct",form="unformatted", &
recl=2,status="replace",action="write")
kk=3
kkk=0
dueb=char(60)//char(33)
write(unit=13,rec=1,iostat=diagnosticw) dueb
dueb="--"
write(unit=13,rec=2,iostat=diagnosticw) dueb
dueb=char(13)//char(10)
write(unit=13,rec=3,iostat=diagnosticw) dueb
carico2:do k=1,999999999
read(unit=12,rec=k,iostat=diagnostico) bit8
if(diagnostico/=0) then
write(unit=*,fmt=*)"Ha letto ",k," caratteri."
exit carico2
else
nbit=ichar(bit8)
nbit1=nbit/16
nbit2=nbit-16*nbit1
dueb=char(192+nbit1)//char(192+nbit2)
kk=kk+1
write(unit=13,rec=kk,iostat=diagnosticw) dueb
if(diagnosticw/=0) then
write(unit=*,fmt=*)"Errore scrittura a ",kk," avendo letto ",k
exit carico2
end if
kkk=kkk+1
if(kkk>35) then
kkk=0
dueb=char(13)//char(10)
kk=kk+1
write(unit=13,rec=kk,iostat=diagnosticw) dueb
if(diagnosticw/=0) then
write(unit=*,fmt=*)"Errore scrittura a ",kk," avendo letto ",k
exit carico2
end if
end if
end if
end do carico2
close(12)
kk=kk+1
dueb=char(13)//char(10)
write(unit=13,rec=kk,iostat=diagnosticw) dueb
kk=kk+1
dueb="--"
write(unit=13,rec=kk,iostat=diagnosticw) dueb
kk=kk+1
dueb=char(62)//char(32)
write(unit=13,rec=kk,iostat=diagnosticw) dueb
close(13)
write(unit=*,fmt=*)"Chiusura riuscita di "//nomefile(1:nf)//".txt"
exit
else
write(unit=*,fmt=*)"Non trovo ",nomefile(1:nf)
write(unit=*,fmt=*)"...altro tentativo..."
end if
end do
return
end subroutine codifica
!
subroutine decodifica(nome,sno)
character(len=*),intent(in)::nome,sno
character(len=1)::bit8,dueb
character(len=4)::estendo
character(len=256)::nomefile,riga
integer::nf,j,k,nstato,m,r,diagnostico,diagnosticw
integer::nbit,nbit1,bene,kk,numero
logical::esiste
!
write(unit=*,fmt=*)"Digita il nome del file da decodificare"
do j=1,3
if(len_trim(nome)>3) then
nomefile=nome
if(j>1) then
exit
end if
else
read(unit=*,fmt="(1a)") nomefile
endif
nf=len_trim(nomefile)
if(1>nf ) then
exit
end if
write(unit=*,fmt=*)"Cerco ",nomefile(1:nf)
inquire(file=nomefile(1:nf),exist=esiste)
if(esiste) then
write(unit=*,fmt=*)"Apertura riuscita"
bene=1
kk=0
numero=2345
write(unit=estendo,fmt="(1I4)") numero
open (unit=12,file=nomefile(1:nf),access="direct",form="unformatted", &
recl=1,status="old",action="read")
open (unit=13,file=nomefile(1:nf)//sno//estendo,access="direct", &
form="unformatted",recl=1,status="replace",action="write")
carico2:do k=1,999999999
read(unit=12,rec=k,iostat=diagnostico) bit8
if(diagnostico/=0) then
write(unit=*,fmt=*)"Ha letto ",k," caratteri."
exit carico2
else
nbit=ichar(bit8)
if(nbit>191) then
if(208>nbit) then
bene=-bene
if(bene>0) then
dueb=char(nbit1*16+nbit-192)
kk=kk+1
write(unit=13,rec=kk,iostat=diagnosticw) dueb
if(diagnosticw/=0) then
write(unit=*,fmt=*)"Errore scrittura al carattere ",kk
exit carico2
end if
else
nbit1=nbit-192
end if
else if(nbit==208) then
! Chiude il file e ne apre un altro
close(13)
numero=numero+1
write(unit=*,fmt=*)"Apre il file ",numero
write(unit=estendo,fmt="(1I4)") numero
open (unit=13,file=nomefile(1:nf)//sno//estendo,access="direct", &
form="unformatted",recl=1,status="replace",action="write")
kk=0
end if
end if
end if
end do carico2
close(12)
close(13)
write(unit=*,fmt=*)"Chiusura riuscita file con estensione "//sno//estendo
exit
else
write(unit=*,fmt=*)"Non trovo ",nomefile(1:nf)
write(unit=*,fmt=*)"...altro tentativo..."
end if
end do
return
end subroutine decodifica
!
end program indaesadecimale
!