!xincollafile moduleModulo con due funzioni
module xincollafile
implicit none
public:: intestazione,ditestomio,pescofilemio
!
! Questa è la codifica standard di Base64
!
character(len=*),dimension(0:63),private,parameter::vale = (/ "A", &
"B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R", &
"S","T","U","V","W","X","Y","Z","a","b","c","d","e","f","g","h","i", &
"j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z",&
"0","1","2","3","4","5","6","7","8","9","+","/" /)
character(len=*),public,parameter::c34=char(34)
character(len=*),public,parameter::c60=char(60)
character(len=*),public,parameter::c62=char(62)
character(len=*),private,parameter::r01=&
c60//"?xml version="//c34//"1.0"//c34//" encoding="//c34//"iso-8859-1"//c34//" ?"//c62
character(len=*),private,parameter::r02=&
c60//"html xmlns="//c34//"http://www.w3.org/1999/xhtml"//c34
character(len=*),private,parameter::r03=&
"xmlns:s="//c34//"http://www.w3.org/2000/svg"//c34
character(len=*),private,parameter::r04=&
"xmlns:l="//c34//"http://www.w3.org/1999/xlink"//c34//c62
character(len=*),private,parameter::r05=&
c60//"head"//c62
character(len=*),private,parameter::r06=&
c60//"title"//c62//"Titolo documento mio"//c60//"/title"//c62
character(len=*),private,parameter::r07=&
c60//"style type="//c34//"text/css"//c34//c62
character(len=*),private,parameter::r08=&
".f { border-bottom :1px solid }"
character(len=*),private,parameter::r09=&
".r { border-top: 1px solid }"
character(len=*),private,parameter::r10=&
".v { text-decoration: overline }"
character(len=*),private,parameter::r11=&
".td { font-weight: normal }"
character(len=*),private,parameter::r12=&
".nuovapagina { page-break-before:always }"
character(len=*),private,parameter::r13=&
c60//"/style"//c62
character(len=*),private,parameter::r14=&
c60//"/head"//c62
character(len=*),private,parameter::r15=&
c60//"body"//c62
!
integer,dimension(0:255,3),private::testa,coda
logical,private::noninizializzato=.true.
!
contains
!
subroutine intestazione(diagnostico)
integer,intent(out)::diagnostico
write(unit=16,fmt="(1a)",iostat=diagnostico) r01
if(diagnostico/=0) then
return
end if
write(unit=16,fmt="(1a)") r02
write(unit=16,fmt="(1a)") r03
write(unit=16,fmt="(1a)") r04
write(unit=16,fmt="(1a)") r05
write(unit=16,fmt="(1a)") r06
write(unit=16,fmt="(1a)") r07
write(unit=16,fmt="(1a)") r08
write(unit=16,fmt="(1a)") r09
write(unit=16,fmt="(1a)") r10
write(unit=16,fmt="(1a)") r11
write(unit=16,fmt="(1a)") r12
write(unit=16,fmt="(1a)") r13
write(unit=16,fmt="(1a)") r14
write(unit=16,fmt="(1a)") r15
return
end subroutine intestazione
!
subroutine ditestomio(idsua,nim)
character(len=*),intent(in)::idsua
integer,intent(in)::nim
character(len=256)::rigona
character(len=9)::idi
integer::diagnostico,nz,j
write(unit=idi,fmt="(1i9)") 900000000+nim
idi(1:2)="qz"
write(unit=16,fmt=*) char(60),"!-- §",idi,"£ ",idsua," --",char(62)
do j=1,999999999
read(unit=12,fmt="(1a)",iostat=diagnostico) rigona
if(diagnostico/=0) then
return
end if
nz=len_trim(rigona)
write(unit=16,fmt="(1a)") rigona(1:nz)
end do
return
end subroutine ditestomio
!
subroutine pescofilemio(idsua,tipo,nim)
!
character(len=*),intent(in)::idsua
integer,intent(in)::tipo,nim
character(len=1)::bit8
integer:: j,k,jj,fase,bit6,resto,nbit,diagnostico
character(len=76)::riga
character(len=9)::idi
if(noninizializzato) then
! Fa questo solo la prima volta...
do k=0,255
testa(k,1)=k/4
coda(k,1)=(k-testa(k,1)*4)*16
testa(k,2)=k/16
coda(k,2)=(k-testa(k,2)*16)*4
testa(k,3)=k/64
coda(k,3)=k-testa(k,3)*64
end do
noninizializzato=.false.
end if
!
write(unit=idi,fmt="(1i9)") 900000000+nim
idi(1:2)="qz"
write(unit=16,fmt=*) char(60),"!-- §",idi,"£ --",char(62)
if(tipo==0) then
write(unit=*,fmt=*)"0 == Non è una immagine"
write(unit=16,fmt=*) char(60),"pre id=",char(34),idsua,char(34),char(62)
else if (tipo==1 ) then
write(unit=*,fmt=*)"1 == Immagine tipo jpg"
write(unit=16,fmt=*) char(60),"img id=",char(34),idsua,char(34)," src=",&
char(34),"data:image/jpg;base64,"
else if (tipo==2 ) then
write(unit=*,fmt=*)"2 == Immagine tipo gif"
write(unit=16,fmt=*) char(60),"img id=",char(34),idsua,char(34)," src=",&
char(34),"data:image/gif;base64,"
else if (tipo==3 ) then
write(unit=*,fmt=*)"3 == Immagine tipo png"
write(unit=16,fmt=*) char(60),"img id=",char(34),idsua,char(34)," src=",&
char(34),"data:image/png;base64,"
else if (tipo==4 ) then
write(unit=*,fmt=*)"4 == Immagine tipo x-bmp"
write(unit=16,fmt=*) char(60),"img id=",char(34),idsua,char(34)," src=",&
char(34),"data:image/x-bmp;base64,"
else
write(unit=*,fmt=*)"5 == Immagine tipo ..."
write(unit=16,fmt=*) char(60),"img id=",char(34),idsua,char(34)," src=",&
char(34),"data:image/...;base64,"
end if
!
! Questo è il vero ciclo di conversione
!
fase=0
k=0
resto=0
carico2:do j=1,999999999
read(unit=12,rec=j,iostat=diagnostico) bit8
if(diagnostico/=0) then
write(unit=*,fmt=*)"Ha letto ",j," caratteri."
exit carico2
else
fase=fase+1
nbit=ichar(bit8)
bit6=testa(nbit,fase)+resto
resto=coda(nbit,fase)
k=k+1
riga(k:k)=vale(bit6)
if(fase==3) then
k=k+1
riga(k:k)=vale(resto)
resto=0
fase=0
if(k==76) then
write(unit=16,fmt="(1a)") riga
k=0
end if
end if
end if
end do carico2
if (fase==1) then
k=k+1
riga(k:k)=vale(resto)
write(unit=16,fmt="(2a)") riga(1:k),"=="
else if(fase==2) then
k=k+1
riga(k:k)=vale(resto)
write(unit=16,fmt="(2a)") riga(1:k),"="
else if (k> 0) then
write(unit=16,fmt="(1a)") riga(1:k)
end if
!
! Fine del ciclo di conversione
!
if(tipo==0) then
write(unit=16,fmt=*) char(60),"/pre",char(62)
else
write(unit=16,fmt=*) char(34),"/",char(62)
end if
write(unit=16,fmt=*) char(60),"!-- §£ --",char(62)
return
end subroutine pescofilemio
!
end module xincollafile
!