Problème avec FreeBasic.

dll_on "placer_tokens_fb.dll"

dim res%, a$

a$="1,str$(10)"

res%=dll_call1("placer_tokens",a$)

message ""

public function placer_tokens (byval param as string) as integer export

' dim expression_a_evaluer as string
dim letters as string
dim numbers as string
dim fonctions as string
dim fonctions1 as string
dim fonctions2 as string
dim fonctions3 as string
dim fonctions_sans_parametre as string
dim fonctions_sans_parametre_retournant_un_resultat as string
dim fonctions_autres as string
dim a as string
dim b as string
dim e as string
dim temporaire as string
dim chaine as string
dim nom_var as string

dim res as integer
dim y as integer

dim expression_a_evaluer as string
expression_a_evaluer=param

letters="abcdefghijklmnopqrstuvwxyz"
numbers="0123456789"

' Fonctions à 1, 2 ou 3 arguments entre parenthèses.
fonctions1=",abs,acos,adr,asin,atn,asc,chr$,cos,count,cube,dec,even,exp,frac,handle,hcos,hex,hex$,hsin,htan,inc,int,len,log,log2,log10,lower$,ltrim$,numeric,"
fonctions1=fonctions1+"o3d_object_exists,o3d_object_type,o3d_x_position,o3d_x_rotate,o3d_x_scale,o3d_y_position,o3d_y_rotate,o3d_y_scale,"
fonctions1=fonctions1+"o3d_z_position,o3d_z_rotate,o3d_z_scale,object_exists,object_internal,object_parent,object_type,"
fonctions1=fonctions1+"odd,reverse$,rnd,rtrim$,sgn,sin,sqr,square,str$,tan,trim$,upper$,val,variable,wrap_value,"

fonctions2=",bin_and,bin_not,bin_or,bin_xor,comparestring,countstring,instr,item_read$,left$,lset$,max,min,mod,o3d_collision,power,right$,right_pos$,rset$,space$,string$,"

fonctions3=",color_pixel_blue,color_pixel_green,color_pixel_red,delta,insert$,instr_pos,mid$,"

fonctions_sans_parametre=",2d_clear,2d_fill_cross,2d_fill_diagonal_cross,2d_fill_diagonal_down,2d_fill_diagonal_up,2d_fill_horizontal,2d_fill_off,2d_fill_on,"
fonctions_sans_parametre=fonctions_sans_parametre+"2d_fill_solid,2d_fill_vertical,2d_pen_dash,2d_pen_dash_dot,2d_pen_dash_dot_dot,2d_pen_dot,2d_pen_solid,3d_delete_all,"
fonctions_sans_parametre=fonctions_sans_parametre+"archiver_off,archiver_on,axes_hide,axes_show,beep,beep_error,"
fonctions_sans_parametre=fonctions_sans_parametre+"beep_exclamation,beep_information,beep_question,cls,display,error_english,error_french,exit_for,fog_on,fog_off,input_mark_off,input_mark_on,input_redo_off,"
fonctions_sans_parametre=fonctions_sans_parametre+"input_redo_on,input_visible_off,input_visible_on,midi_off,midi_on,"
fonctions_sans_parametre=fonctions_sans_parametre+"off_error_goto,separator_is_comma,separator_is_point,sprite_create_hide,sprite_create_show,sprite_delete_all,sprite_show_all,stop,terminate,trace_off,"

fonctions_sans_parametre_retournant_un_resultat="number_2d_target,number_3d_objects,number_3d_target,number_activate,number_change,number_click,number_command_target,number_current_line,number_double_click,number_events,number_input_source,number_key_down,number_key_up,number_objects,number_print_target,number_show,number_sprite_target,number_sprites,number_variables,"

' Fonctions avec 1er argument correspondant à un objet système, et sans parenthèse, ou commande sans parenthèse.
' ne pouvant pas entrer dans une expression du genre x%=fonction(argument).
' Traitées dans module_commun().
fonctions_autres=",2d_pen_width,2d_point,2d_poly_from,2d_poly_to,2d_target_is,3d_actor,3d_chain,3d_chain_break,3d_collision_as_cube,3d_collision_as_ellipsoid,3d_collision_as_faces,3d_collision_as_point,3d_collision_as_sphere,3d_cube,3d_sphere,3d_delete,3d_dodecahedron,3d_hide,3d_image_texture,3d_line_width,3d_load_object,3d_load_texture,3d_load_texture_back,3d_load_texture_bottom,3d_load_texture_front,3d_load_texture_left,3d_load_texture_right,3d_load_texture_top,"
fonctions_autres=fonctions_autres+"3d_mesh,3d_move,3d_plane,3d_point_object,3d_show,3d_skybox,3d_target_is,3d_teapot,3d_text,"
fonctions_autres=fonctions_autres+"3d_text_change,3d_u_tile,3d_v_tile,3d_x_position,3d_x_rotate,3d_x_scale,3d_y_position,3d_y_rotate,3d_y_scale,3d_z_position,3d_z_rotate,3d_z_scale,"
fonctions_autres=fonctions_autres+"active,alpha,application_title,archiver_add,archiver_extract,bar_both,bar_horizontal,bar_none,bar_vertical,border_hide,border_normal,border_small,brightness,button,"
fonctions_autres=fonctions_autres+"cam_move,cam_pitch,cam_roll,cam_turn,cam_x_position,cam_y_position,cam_z_position,"
fonctions_autres=fonctions_autres+"caption,check,clear,clipboard_copy,clipboard_cup,clipboard_paste,clipboard_string_copy,combo,command_target_is,container,container_option,container_tab,contrast,"
fonctions_autres=fonctions_autres+"cursor_arrow,cursor_beam,cursor_cross,cursor_default,cursor_help,cursor_hide,cursor_hourglass,cursor_noparking,cursor_point,"
fonctions_autres=fonctions_autres+"delete,dim,dlist,edit,"
fonctions_autres=fonctions_autres+"font_add,font_bold,font_bold_off,font_italic,font_italic_off,font_load,font_name,font_names_add,font_names_load,font_size,font_strike,font_strike_off,font_underline,font_underline_off,form,grid,full_space,height,hide,horizontal,hviewer,image,inactive,input_source_is,item_add,item_delete,item_insert,"
fonctions_autres=fonctions_autres+"label,left,light_x_position,light_y_position,light_z_position,list,main_menu,mark_off,mark_on,maximize,memo,open_dialog,option,panel,picture,"
fonctions_autres=fonctions_autres+"save_dialog,scene2d,scene3d,scroll_bar,set_focus,show,sort,sort_off,sort_on,sound,spin,sprite,sprite_delete,sprite_hide,sprite_show,sprite_target_is,stretch_off,stretch_on,sub_menu,"
fonctions_autres=fonctions_autres+"tab,text,timer,timer_interval,timer_off,timer_off_all,timer_on,to_background,to_foreground,top,track_bar,trigger_click,vertical,wait,width,"

fonctions=fonctions1+Mid(fonctions2,2)+Mid(fonctions3,2)+Mid(fonctions_autres,2)

open "c:\a\tokens.txt" for output as #1

' Le token est une chaîne entre guillemets ?
While 0=0
token_suivant:
      If Len(expression_a_evaluer)=0 then exit while

      a=Left(expression_a_evaluer,1)

      ' Le token est une chaîne ?
      If a="¤" then
         y=instr(2,expression_a_evaluer,"¤")
         print #1,Left(expression_a_evaluer,y)
         expression_a_evaluer=Mid(expression_a_evaluer,y+1)
         Goto token_suivant
      end if
        
      ' Le token est un nombre ?
      If instr(numbers,Left(expression_a_evaluer,1))>0 then  
         If Len(expression_a_evaluer)=1 then
            print #1,Left(expression_a_evaluer,1)
            expression_a_evaluer=""
            Goto token_suivant
               Else  
            For y=1 To Len(expression_a_evaluer)          
                If instr(1,numbers+".",Mid(expression_a_evaluer,y))=0 then
                   print #1,Left(expression_a_evaluer,y-1)
                   expression_a_evaluer=Mid(expression_a_evaluer,y)
                   Goto token_suivant
                end if
            Next
         end if  
      end if

      ' Le token est un opérateur, un séparateur de paramètre ou une parenthèse ?
      If instr("+-*/,()",a)>0 then
         print #1,a
         expression_a_evaluer=Mid(expression_a_evaluer,2)
         Goto token_suivant
      end if

      ' Le token est une fonction ?
      For y=1 To Len(expression_a_evaluer)
          e=Left(expression_a_evaluer,y)
          If instr(1,fonctions,","+e+",")>0 then
             print #1,e
             expression_a_evaluer=Mid(expression_a_evaluer,y+1)
             Goto token_suivant
          end if
      Next

      ' Le token est un nom de variable ?
      ' x%+y%
      If instr(1,letters,a)>0 then
         nom_var=""

         While 1=1
               a=Left(expression_a_evaluer,1)
               If instr(1,letters+"%$",a)>0 then
                  nom_var=nom_var+a
                  expression_a_evaluer=Mid(expression_a_evaluer,2)

                  If instr(1,"%$",a)>0 then
                     print #1,nom_var
                     Goto token_suivant
                  end if

                     Else
                  exit while
               end if
         Wend

         ' Le token est un nom de tableau ?
         If Left(expression_a_evaluer,2)="%(" Or Left(expression_a_evaluer,2)="$(" then
            ' verification_declaration_tableau()
            ' Enregistrer le résultat dans la case du tableau.
            temporaire=Trim(Mid(b,instr(b,"=")+1))
            If Right(chaine,1)="$" then
               temporaire="¤"+temporaire              
            end if  
               Else
            ' verification_declaration_variable()
            If res>0 then
               ' b$=item_read$(101,res)
               temporaire=Trim(Mid(b,instr(b,"=")+1))
               If Right(chaine,1)="$" then
                  temporaire="¤"+temporaire
               end if
               print #1,temporaire
               Goto token_suivant
            end if
         end if
      end if

    Wend
    Close #1
    return res
 end function

extern "Windows-MS"

  function IntFunc(n as integer) as integer export
  ' fonction à paramètre entier
    return 2 * n
  end function
  
  function RealFunc(byref x as double) as integer export
  ' fonction à paramètre réel (double précision)
    return int(x)
  end function
    
  function StrFunc(byref p as zstring ptr) as integer export
  ' fonction à paramètre chaîne de caractère
    return len(*p)
  end function
  
end extern

dll_on "testfb.dll"

dim res%, a%

a%=2

res%=dll_call1("IntFunc",a%)

message res%

extern "Windows-MS"

function IntFunc(n as integer) as integer export
  ' fonction à paramètre entier
    return 2 * n
end function
 
function RealFunc(byref x as double) as double export
  ' fonction à paramètre réel (double précision)
    return x*x
end function
   
function StrFunc(byref p as zstring ptr) as integer export
  ' fonction à paramètre chaîne de caractère
    return len(*p)
end function
   
end extern

dim madll$

madll$="testfb.dll"

if file_exists(madll$)=0
   print "' ",madll$," ' non trouvé"
else
   dll_on madll$
end_if

dll_on "placer_tokens_fb.dll"

dim res%, a$

a$="1,str$(10)"

res%=dll_call1("tokens",adr(a$))

message res%

extern "Windows-MS"

function IntFunc(n as integer) as integer export
  ' fonction à paramètre entier
    return 2 * n
end function
  
function RealFunc(byref x as double) as double export
  ' fonction à paramètre réel (double précision)
    return x*x
end function
    
function StrFunc(byref p as zstring ptr) as integer export
  ' fonction à paramètre chaîne de caractère
    return len(*p)
end function

function tokens(byref p as zstring ptr) as integer export

dim expression_a_evaluer as string
dim letters as string
dim numbers as string
dim fonctions as string
dim fonctions1 as string
dim fonctions2 as string
dim fonctions3 as string
dim fonctions_sans_parametre as string
dim fonctions_sans_parametre_retournant_un_resultat as string
dim fonctions_autres as string
dim a as string
dim b as string
dim e as string
dim temporaire as string
dim chaine as string
dim nom_var as string

dim res as integer
dim y as integer

expression_a_evaluer=*p

letters="abcdefghijklmnopqrstuvwxyz"
numbers="0123456789"

' Fonctions à 1, 2 ou 3 arguments entre parenthèses.
fonctions1=",abs,acos,adr,asin,atn,asc,chr$,cos,count,cube,dec,even,exp,frac,handle,hcos,hex,hex$,hsin,htan,inc,int,len,log,log2,log10,lower$,ltrim$,numeric,"
fonctions1=fonctions1+"o3d_object_exists,o3d_object_type,o3d_x_position,o3d_x_rotate,o3d_x_scale,o3d_y_position,o3d_y_rotate,o3d_y_scale,"
fonctions1=fonctions1+"o3d_z_position,o3d_z_rotate,o3d_z_scale,object_exists,object_internal,object_parent,object_type,"
fonctions1=fonctions1+"odd,reverse$,rnd,rtrim$,sgn,sin,sqr,square,str$,tan,trim$,upper$,val,variable,wrap_value,"

fonctions2=",bin_and,bin_not,bin_or,bin_xor,comparestring,countstring,instr,item_read$,left$,lset$,max,min,mod,o3d_collision,power,right$,right_pos$,rset$,space$,string$,"

fonctions3=",color_pixel_blue,color_pixel_green,color_pixel_red,delta,insert$,instr_pos,mid$,"

fonctions_sans_parametre=",2d_clear,2d_fill_cross,2d_fill_diagonal_cross,2d_fill_diagonal_down,2d_fill_diagonal_up,2d_fill_horizontal,2d_fill_off,2d_fill_on,"
fonctions_sans_parametre=fonctions_sans_parametre+"2d_fill_solid,2d_fill_vertical,2d_pen_dash,2d_pen_dash_dot,2d_pen_dash_dot_dot,2d_pen_dot,2d_pen_solid,3d_delete_all,"
fonctions_sans_parametre=fonctions_sans_parametre+"archiver_off,archiver_on,axes_hide,axes_show,beep,beep_error,"
fonctions_sans_parametre=fonctions_sans_parametre+"beep_exclamation,beep_information,beep_question,cls,display,error_english,error_french,exit_for,fog_on,fog_off,input_mark_off,input_mark_on,input_redo_off,"
fonctions_sans_parametre=fonctions_sans_parametre+"input_redo_on,input_visible_off,input_visible_on,midi_off,midi_on,"
fonctions_sans_parametre=fonctions_sans_parametre+"off_error_goto,separator_is_comma,separator_is_point,sprite_create_hide,sprite_create_show,sprite_delete_all,sprite_show_all,stop,terminate,trace_off,"

fonctions_sans_parametre_retournant_un_resultat="number_2d_target,number_3d_objects,number_3d_target,number_activate,number_change,number_click,number_command_target,number_current_line,number_double_click,number_events,number_input_source,number_key_down,number_key_up,number_objects,number_print_target,number_show,number_sprite_target,number_sprites,number_variables,"

' Fonctions avec 1er argument correspondant à un objet système, et sans parenthèse, ou commande sans parenthèse.
' ne pouvant pas entrer dans une expression du genre x%=fonction(argument).
' Traitées dans module_commun().
fonctions_autres=",2d_pen_width,2d_point,2d_poly_from,2d_poly_to,2d_target_is,3d_actor,3d_chain,3d_chain_break,3d_collision_as_cube,3d_collision_as_ellipsoid,3d_collision_as_faces,3d_collision_as_point,3d_collision_as_sphere,3d_cube,3d_sphere,3d_delete,3d_dodecahedron,3d_hide,3d_image_texture,3d_line_width,3d_load_object,3d_load_texture,3d_load_texture_back,3d_load_texture_bottom,3d_load_texture_front,3d_load_texture_left,3d_load_texture_right,3d_load_texture_top,"
fonctions_autres=fonctions_autres+"3d_mesh,3d_move,3d_plane,3d_point_object,3d_show,3d_skybox,3d_target_is,3d_teapot,3d_text,"
fonctions_autres=fonctions_autres+"3d_text_change,3d_u_tile,3d_v_tile,3d_x_position,3d_x_rotate,3d_x_scale,3d_y_position,3d_y_rotate,3d_y_scale,3d_z_position,3d_z_rotate,3d_z_scale,"
fonctions_autres=fonctions_autres+"active,alpha,application_title,archiver_add,archiver_extract,bar_both,bar_horizontal,bar_none,bar_vertical,border_hide,border_normal,border_small,brightness,button,"
fonctions_autres=fonctions_autres+"cam_move,cam_pitch,cam_roll,cam_turn,cam_x_position,cam_y_position,cam_z_position,"
fonctions_autres=fonctions_autres+"caption,check,clear,clipboard_copy,clipboard_cup,clipboard_paste,clipboard_string_copy,combo,command_target_is,container,container_option,container_tab,contrast,"
fonctions_autres=fonctions_autres+"cursor_arrow,cursor_beam,cursor_cross,cursor_default,cursor_help,cursor_hide,cursor_hourglass,cursor_noparking,cursor_point,"
fonctions_autres=fonctions_autres+"delete,dim,dlist,edit,"
fonctions_autres=fonctions_autres+"font_add,font_bold,font_bold_off,font_italic,font_italic_off,font_load,font_name,font_names_add,font_names_load,font_size,font_strike,font_strike_off,font_underline,font_underline_off,form,grid,full_space,height,hide,horizontal,hviewer,image,inactive,input_source_is,item_add,item_delete,item_insert,"
fonctions_autres=fonctions_autres+"label,left,light_x_position,light_y_position,light_z_position,list,main_menu,mark_off,mark_on,maximize,memo,open_dialog,option,panel,picture,"
fonctions_autres=fonctions_autres+"save_dialog,scene2d,scene3d,scroll_bar,set_focus,show,sort,sort_off,sort_on,sound,spin,sprite,sprite_delete,sprite_hide,sprite_show,sprite_target_is,stretch_off,stretch_on,sub_menu,"
fonctions_autres=fonctions_autres+"tab,text,timer,timer_interval,timer_off,timer_off_all,timer_on,to_background,to_foreground,top,track_bar,trigger_click,vertical,wait,width,"

fonctions=fonctions1+Mid(fonctions2,2)+Mid(fonctions3,2)+Mid(fonctions_autres,2)

open "tokens.txt" for output as #1

' Le token est une chaîne entre guillemets ?
While 0=0
token_suivant:
      If Len(expression_a_evaluer)=0 then exit while

      a=Left(expression_a_evaluer,1)

      ' Le token est une chaîne ?
      If a="¤" then
         y=instr(2,expression_a_evaluer,"¤")
         print #1,Left(expression_a_evaluer,y)
         expression_a_evaluer=Mid(expression_a_evaluer,y+1)
         Goto token_suivant
      end if
        
      ' Le token est un nombre ?
      If instr(numbers,Left(expression_a_evaluer,1))>0 then  
         If Len(expression_a_evaluer)=1 then
            print #1,Left(expression_a_evaluer,1)
            expression_a_evaluer=""
            Goto token_suivant
               Else  
            For y=1 To Len(expression_a_evaluer)          
                If instr(1,numbers+".",Mid(expression_a_evaluer,y))=0 then
                   print #1,Left(expression_a_evaluer,y-1)
                   expression_a_evaluer=Mid(expression_a_evaluer,y)
                   Goto token_suivant
                end if
            Next
         end if  
      end if

      ' Le token est un opérateur, un séparateur de paramètre ou une parenthèse ?
      If instr("+-*/,()",a)>0 then
         print #1,a
         expression_a_evaluer=Mid(expression_a_evaluer,2)
         Goto token_suivant
      end if

      ' Le token est une fonction ?
      For y=1 To Len(expression_a_evaluer)
          e=Left(expression_a_evaluer,y)
          If instr(1,fonctions,","+e+",")>0 then
             print #1,e
             expression_a_evaluer=Mid(expression_a_evaluer,y+1)
             Goto token_suivant
          end if
      Next

      ' Le token est un nom de variable ?
      ' x%+y%
      If instr(1,letters,a)>0 then
         nom_var=""

         While 1=1
               a=Left(expression_a_evaluer,1)
               If instr(1,letters+"%$",a)>0 then
                  nom_var=nom_var+a
                  expression_a_evaluer=Mid(expression_a_evaluer,2)

                  If instr(1,"%$",a)>0 then
                     print #1,nom_var
                     Goto token_suivant
                  end if

                     Else
                  exit while
               end if
         Wend

         ' Le token est un nom de tableau ?
         If Left(expression_a_evaluer,2)="%(" Or Left(expression_a_evaluer,2)="$(" then
            ' verification_declaration_tableau()
            ' Enregistrer le résultat dans la case du tableau.
            temporaire=Trim(Mid(b,instr(b,"=")+1))
            If Right(chaine,1)="$" then
               temporaire="¤"+temporaire              
            end if  
               Else
            ' verification_declaration_variable()
            If res>0 then
               ' b$=item_read$(101,res)
               temporaire=Trim(Mid(b,instr(b,"=")+1))
               If Right(chaine,1)="$" then
                  temporaire="¤"+temporaire
               end if
               print #1,temporaire
               Goto token_suivant
            end if
         end if
      end if

Wend
Close #1
return len(*p)
end function
    
end extern