Le petit explorateur

 ...bonjour ;) x(8) :D

' hexify.bas

' ******************** programme de base ************

label labels : gosub labels
gosub constantes
gosub variables
gosub form0
gosub GUI
gosub initialisations
end

' ******************** routines de structure ************

labels:
  label constantes, variables, form0, GUI, initialisations
  label fnd_bas, bas_to_hex, fnd_hex, hex_to_bas, bth, htb
  return
 
constantes:
  return
 
variables:
  dim no%, no1% , no_bas%, no_hex%, no_d_bas%, no_d_hex%, s$, n%, i%, h$
  dim no_bas_to_hex%, no_hex_to_bas%, f_bas$, f_hex$
  return
 
form0:
  width 0,800 : height 0,190
  caption 0,"Hexify - codage/décodage d'un fichier entre ASCII<->Hexa"
  return
 
GUI:
  no% = no% + 1 : open_dialog no% : no_d_bas%  = no%
    filter no%,"Source BAS|*.bas"
  no% = no% + 1 : open_dialog no% : no_d_hex%  = no%
    filter no%,"Ficher HEX|*.hex"

  no% = no% + 1 : container no% : no1% = no%
    top no%,10 : left no%,10 : caption no%,"Fichier source en ASCII"
    width no%,770 : height no%,60
  no% = no% + 1 : edit no% : parent no%,no1% : no_bas% = no%
    top no%,20 : left no%,10 : width no%,500
  no% = no% + 1 : button no% : parent no%,no1%
    top no%,20 : left no%,530 : width no%,50 : caption no%,"..."
    on_click no%,fnd_bas
  no% = no% + 1 : button no% : parent no%,no1%  : no_bas_to_hex% = no% : inactive no%
    top no%,20 : left no%,600 : width no%,150 : caption no%,"Coder en hexa-décimal"
    on_click no%,bas_to_hex

  no% = no% + 1 : container no% : no1% = no%
    top no%,80 : left no%,10 : caption no%,"Fichier codé en hexa-décimal"
    width no%,770 : height no%,60
  no% = no% + 1 : edit no% : parent no%,no1% : no_hex% = no%
    top no%,20 : left no%,10 : width no%,500
  no% = no% + 1 : button no% : parent no%,no1%
    top no%,20 : left no%,530 : width no%,50 : caption no%,"..."
    on_click no%,fnd_hex
  no% = no% + 1 : button no% : parent no%,no1%  : no_hex_to_bas% = no%  : inactive no%
    top no%,20 : left no%,600 : width no%,150 : caption no%,"Décoder en Ascii"
    on_click no%,hex_to_bas


  return
 
initialisations:
  dir_dialog no_d_bas%, dir_current$
  dir_dialog no_d_hex%, dir_current$
  return
 
' ******************** routines spécifiques ************

fnd_bas:
  s$ = file_name$(no_d_bas%)
  if s$="_" then return
  if right$(s$,4)=".bas" then s$ = left$(s$,len(s$)-4)
  text no_bas%,s$+".bas"
  text no_hex%,s$+".hex"
  active no_bas_to_hex%
  inactive no_hex_to_bas%
  return

bas_to_hex:
  f_bas$ = trim$(text$(no_bas%))
  if file_exists(f_bas$)=0
    message "Le fichier en entrée est inexistant !"
    text no_bas% = ""
    text no_hex% = ""
    return
  end_if
  f_hex$ = trim$(text$(no_hex%))
  if file_exists(f_hex$)=1
    s$ = "Le fichier en sortie existe déjà !"
    s$ = s$ + chr$(13)+chr$(10)+"Voulez-vous le remplacer ?"
    if message_confirmation_yes_no(s$)<>1 then return
  end_if
  file_open_read 1,f_bas$
  file_open_write 2,f_hex$
  h$ = ""
  while file_eof(1)=0
    file_readln 1,s$
    gosub bth
    s$ = chr$(0)
    gosub bth
  end_while
  if len(h$)>0 then file_writeln 2,h$
  file_close 2
  file_close 1
  message "Terminé."
  return

bth:
  if len(s$)=0 then return
  for i%=1 to len(s$)
    h$ = h$ + right$("0"+hex$(asc(mid$(s$,i%,1))),2)
    if len(h$)=80
      file_writeln 2,h$
      h$ = ""
    end_if
  next i%
  return

fnd_hex:
  s$ = file_name$(no_d_hex%)
  if s$="_" then return
  if right$(s$,4)=".hex" then s$ = left$(s$,len(s$)-4)
  text no_bas%,s$+".bas"
  text no_hex%,s$+".hex"
  inactive no_bas_to_hex%
  active no_hex_to_bas%
  return

hex_to_bas:
  f_hex$ = trim$(text$(no_hex%))
  if file_exists(f_hex$)=0
    message "Le fichier en entrée est inexistant !"
    text no_bas% = ""
    text no_hex% = ""
    return
  end_if
  f_bas$ = trim$(text$(no_bas%))
  if file_exists(f_bas$)=1
    s$ = "Le fichier en sortie existe déjà !"
    s$ = s$ + chr$(13)+chr$(10)+"Voulez-vous le remplacer ?"
    if message_confirmation_yes_no(s$)<>1 then return
  end_if

  file_open_read 1,f_hex$
  file_open_write 2,f_bas$
  s$ = ""
  while file_eof(1)=0
    file_readln 1,h$
    gosub htb
  end_while
  file_close 2
  file_close 1
  message "Terminé."
  return

htb:
  for i%=1 to len(h$)-1 step 2
    n% = hex(mid$(h$,i%,2))
    if n%=0
      file_writeln 2,s$
      s$ = ""
    else
      s$ = s$ + chr$(n%)
    end_if
  next i%
  return

' hexify.bas

' ******************** programme de base ************

label labels : gosub labels
gosub constantes
gosub variables
gosub form0
gosub GUI
gosub initialisations
end

' ******************** routines de structure ************

labels:
  label constantes, variables, form0, GUI, initialisations
  label fnd_bas, bas_to_hex, fnd_hex, hex_to_bas, bth, htb
  label mode_change
  return
 
constantes:
  return
 
variables:
  dim no%, no1% , no_bas%, no_hex%, no_d_bas%, no_d_hex%, s$, n%, i%, h$, j%
  dim no_bas_to_hex%, no_hex_to_bas%, f_bas$, f_hex$, no_bin%, buf%(513)
  dim siz%, no_bar%, tot%, no_aff%
  return
 
form0:
  width 0,1000 : height 0,230
  caption 0,"Hexify - codage/décodage d'un fichier entre ASCII<->Hexa"
  return
 
GUI:
  no% = no% + 1 : open_dialog no% : no_d_bas%  = no%
    filter no%,"Source BAS|*.bas"
  no% = no% + 1 : open_dialog no% : no_d_hex%  = no%
    filter no%,"Ficher HEX|*.hex"

  no% = no% + 1 : container no% : no1% = no%
    top no%,10 : left no%,10 : caption no%,"Fichier source en ASCII"
    width no%,770 : height no%,60
  no% = no% + 1 : edit no% : parent no%,no1% : no_bas% = no%
    top no%,20 : left no%,10 : width no%,500
  no% = no% + 1 : button no% : parent no%,no1%
    top no%,20 : left no%,530 : width no%,50 : caption no%,"..."
    on_click no%,fnd_bas
  no% = no% + 1 : button no% : parent no%,no1%  : no_bas_to_hex% = no% : inactive no%
    top no%,20 : left no%,600 : width no%,150 : caption no%,"Coder en hexa-décimal"
    on_click no%,bas_to_hex

  no% = no% + 1 : container no% : no1% = no%
    top no%,80 : left no%,10 : caption no%,"Fichier codé en hexa-décimal"
    width no%,770 : height no%,60
  no% = no% + 1 : edit no% : parent no%,no1% : no_hex% = no%
    top no%,20 : left no%,10 : width no%,500
  no% = no% + 1 : button no% : parent no%,no1%
    top no%,20 : left no%,530 : width no%,50 : caption no%,"..."
    on_click no%,fnd_hex
  no% = no% + 1 : button no% : parent no%,no1%  : no_hex_to_bas% = no%  : inactive no%
    top no%,20 : left no%,600 : width no%,150 : caption no%,"Décoder en Ascii"
    on_click no%,hex_to_bas

  no% = no% + 1 : container no% : no1% = no%
    top no%,10 : left no%,790 : caption no%,"Options"
    width no%,190 : height no%,130
  no% = no% + 1 : check no% : parent no%, no1% : no_bin% = no%
    top no%,20 : left no%,10 : caption no%,"Mode binaire"
    on_click no%,mode_change
   
  no% = no% + 1 : progress_bar no%  : no_bar% = no%
    top no%,160 : left no%,10 : width no%,770
    min no%,0 : max no%,1000 : position no%,0
  no% = no% + 1 : alpha no% : no_aff% = no%
    top no%,160 : left no%,790

  return
 
initialisations:
  dir_dialog no_d_bas%, dir_current$
  dir_dialog no_d_hex%, dir_current$
  return
 
' ******************** routines spécifiques ************

fnd_bas:
  s$ = file_name$(no_d_bas%)
  if s$="_" then return
  if checked(no_bin%)=0
    if right$(s$,4)=".bas" then s$ = left$(s$,len(s$)-4)
    text no_bas%,s$+".bas"
  else
    text no_bas%,s$
  end_if
  text no_hex%,s$+".hex"
  active no_bas_to_hex%
  inactive no_hex_to_bas%
  return

bas_to_hex:
  f_bas$ = trim$(text$(no_bas%))
  if file_exists(f_bas$)=0
    message "Le fichier en entrée est inexistant !"
    text no_bas% = ""
    text no_hex% = ""
    return
  end_if
  f_hex$ = trim$(text$(no_hex%))
  if file_exists(f_hex$)=1
    s$ = "Le fichier en sortie existe déjà !"
    s$ = s$ + chr$(13)+chr$(10)+"Voulez-vous le remplacer ?"
    if message_confirmation_yes_no(s$)<>1 then return
  end_if
  if checked(no_bin%)=0
    filebin_open_read 1,f_bas$
    tot% = filebin_size(1)
    caption no_aff%,str$(tot%)+" Octets"
    filebin_close 1
    file_open_read 1,f_bas$
    file_open_write 2,f_hex$
    h$ = ""
    siz% = 0
    while file_eof(1)=0
      file_readln 1,s$
      siz% = siz% + len(s$) + 2
      gosub bth
      s$ = chr$(0)
      gosub bth
      position no_bar%,(siz%/tot%)*1000
    end_while
    if len(h$)>0 then file_writeln 2,h$
    file_close 2
    file_close 1
  else
    filebin_open_read 1,f_bas$
    file_open_write 2,f_hex$
    siz% = filebin_size(1)
    tot% = siz%
    caption no_aff%,str$(tot%)+" Octets"
    if siz%>0
      repeat
        n% = 512
        if n%>siz% then n% = siz%
        filebin_block_read 1,n%,buf%(1)
        h$ = ""
        for i%=1 to n%
          h$ = h$ + right$("0"+hex$(buf%(i%)),2)
        next i%
        file_writeln 2,h$
        siz% = siz% - n%
        position no_bar%,((tot%-siz%)/tot%)*1000
      until siz% = 0
    end_if
    file_close 2
    filebin_close 1
  end_if
  message "Terminé."
  position no_bar%,0
  caption no_aff%,""
  return


bth:
  if len(s$)=0 then return
  for i%=1 to len(s$)
    h$ = h$ + right$("0"+hex$(asc(mid$(s$,i%,1))),2)
    if len(h$)=80
      file_writeln 2,h$
      h$ = ""
    end_if
  next i%
  return

fnd_hex:
  s$ = file_name$(no_d_hex%)
  if s$="_" then return
  if right$(s$,4)=".hex" then s$ = left$(s$,len(s$)-4)
  if checked(no_bin%)=1
    text  no_bas%,s$
  else
    text no_bas%,s$+".bas"
  end_if
  text no_hex%,s$+".hex"
  inactive no_bas_to_hex%
  active no_hex_to_bas%
  return

hex_to_bas:
  f_hex$ = trim$(text$(no_hex%))
  if file_exists(f_hex$)=0
    message "Le fichier en entrée est inexistant !"
    text no_bas% = ""
    text no_hex% = ""
    return
  end_if
  f_bas$ = trim$(text$(no_bas%))
  if file_exists(f_bas$)=1
    s$ = "Le fichier en sortie existe déjà !"
    s$ = s$ + chr$(13)+chr$(10)+"Voulez-vous le remplacer ?"
    if message_confirmation_yes_no(s$)<>1 then return
  end_if
  if checked(no_bin%)=0
    filebin_open_read 1,f_hex$
    tot% = filebin_size(1)
    caption no_aff%,str$(tot%)+" Octets"
    filebin_close 1
    file_open_read 1,f_hex$
    file_open_write 2,f_bas$
    s$ = ""
    siz% = 0
    while file_eof(1)=0
      file_readln 1,h$
      siz% = siz% + len(h$) + 2
      gosub htb
      position no_bar%,(siz%/tot%)*1000
    end_while
    file_close 2
    file_close 1
  else
    filebin_open_read 1,f_hex$
    tot% = filebin_size(1)
    caption no_aff%,str$(tot%)+" Octets"
    filebin_close 1
    file_open_read 1,f_hex$
    filebin_open_write 2,f_bas$
    siz% = 0
    j% = 0
    while file_eof(1)=0
      file_readln 1,h$
      siz% = siz% + len(h$) + 2
      n% = len(h$)
      for i%=1 to n%-1 step 2
        j% = j% + 1
        buf%(j%) = hex(mid$(h$,i%,2))
        if j%=512
          filebin_block_write 2,512,buf%(1)
          j% = 0
        end_if
      next i%
      position no_bar%,(siz%/tot%)*1000
    end_while
    if j%>0
      filebin_block_write 2,j%,buf%(1)
      position no_bar%,(siz%/tot%)*1000
    end_if
    filebin_close 2
    file_close 1
  end_if
  message "Terminé."
  caption no_aff%,""
  return

htb:
  for i%=1 to len(h$)-1 step 2
    n% = hex(mid$(h$,i%,2))
    if n%=0
      file_writeln 2,s$
      s$ = ""
    else
      s$ = s$ + chr$(n%)
    end_if
  next i%
  return
 
mode_change:
  if checked(no_bin%)=1
    filter no_d_bas%,"Tous fichiers|*.*"
    caption no_hex_to_bas%,"Décoder en binaire"
  else
    filter no_d_bas%,"Source BAS|*.bas"
    caption no_hex_to_bas%,"Décoder en Ascii"
  end_if
  return

LABEL bin2hex, hex2bin
DIM f1$, f2$, fh$, a$, sz%, n%, i%

' binaire ou ascii -> hexa
f1$ = "C:\Textes\Lorem.txt": fh$ = "C:\Temp\Test.hex": gosub bin2hex
end
' hexa -> binaire (reconstitution du fichier original)
f2$ = "C:\Temp\Test.txt": gosub hex2bin
print "Terminé !"
END

bin2hex:
' conversion fichier quelconque en valeurs hexadécimales f1$ -> fh$
FILEBIN_OPEN_READ 1, f1$: sz% = FILEBIN_SIZE(1): FILE_OPEN_WRITE 2, fh$
IF sz% > 2000
    n% = INT(sz%/2000)
    FOR i% = 1 TO n%
        FILEBIN_HEXA_READ 1, 2000, a$: FILE_WRITE 2, a$
    NEXT i%
    sz% = MOD(sz%, 2000): ' reste
END_IF
FILEBIN_HEXA_READ 1, sz%, a$: FILE_WRITELN 2, a$
FILEBIN_CLOSE 1: FILE_CLOSE 2
RETURN

hex2bin:
' reconversion fichier hexadécimal en fichier normal fh$ -> f2$
FILEBIN_OPEN_READ 1, fh$: sz% = FILEBIN_SIZE(1): FILEBIN_CLOSE 1
FILE_OPEN_READ 1, fh$: FILEBIN_OPEN_WRITE 2, f2$
IF sz% > 4000
    n% = INT(sz%/4000)
    FOR i% = 1 TO n%
        FILE_READBUF 1, a$, 4000: FILEBIN_HEXA_WRITE 2, 2000, a$
    NEXT i%
    sz% = MOD(sz%, 4000): ' reste
END_IF
FILE_READBUF 1, a$, sz%: sz% = (sz%-2)/2
FILEBIN_HEXA_WRITE 2, sz%, a$
FILE_CLOSE 1: FILEBIN_CLOSE 2
RETURN