prog_grl.pas

   1 unit PROG_GRL;\r
   2 \r
   3 {\r
   4    Unidad General para utilizar con los programas que utilicen el archivo de comandos\r
   5    Tambien incluye algunas funciones y procedimientos utiles para la manipulacion de datos.\r
   6 }\r
   7 \r
   8 interface\r
   9 \r
  10  uses\r
  11     GRAL, DOS, CRT, TABLA;\r
  12 \r
  13  type\r
  14     T_COMANDO = record\r
  15                    Comando: string[2];\r
  16                    DNI: string[8];\r
  17                    Nombre: string[40];\r
  18                    Movimiento: string[1];\r
  19                    DNI_hasta: string[8];\r
  20                    end;\r
  21     ID_COMANDO = ( INS, INSO, ORDEN, BC, BR, LS, LC, BO, MO, LI, DESC );\r
  22 \r
  23     T_ARCHIVO_COMANDOS = file of T_COMANDO;\r
  24 \r
  25  {----------------------------------------------------------------------------}\r
  26  {- Procedimiento: Muestra un mensaje de bienvenida al programa\r
  27  {----------------------------------------------------------------------------}\r
  28  procedure mensajeDeEntrada( descripcion: String );\r
  29 \r
  30  {----------------------------------------------------------------------------}\r
  31  {- Funcion: verifica si existe un archivo.\r
  32  {----------------------------------------------------------------------------}\r
  33  function existeArchivo( nombre: String ): boolean;\r
  34 \r
  35  {----------------------------------------------------------------------------}\r
  36  {- Procedimiento: Procesa los parametros de la ejecucion del programa\r
  37  {----------------------------------------------------------------------------}\r
  38  procedure procesarParametros( var archivoEntrada: T_ARCHIVO_COMANDOS; var archivoSalida: text; var error: boolean );\r
  39 \r
  40  {----------------------------------------------------------------------------}\r
  41  {- Procedimiento: Muestra un mensaje de error y la sintaxis del programa.\r
  42  {----------------------------------------------------------------------------}\r
  43  procedure errorParametros;\r
  44 \r
  45  {----------------------------------------------------------------------------}\r
  46  {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
  47  {----------------------------------------------------------------------------}\r
  48  procedure intro( var f: text );\r
  49 \r
  50  {----------------------------------------------------------------------------}\r
  51  {- Funcion: Convierte un dato del tipo T_MOVIM en un string\r
  52  {----------------------------------------------------------------------------}\r
  53  function movimToStr( m: T_MOVIM): string;\r
  54 \r
  55  {----------------------------------------------------------------------------}\r
  56  {- Funcion: Convierte un dato del tipo ID_COMANDO en un string\r
  57  {----------------------------------------------------------------------------}\r
  58  function comandoToStr( c: ID_COMANDO ): string;\r
  59 \r
  60  {----------------------------------------------------------------------------}\r
  61  {- Funcion: Convierte un string en un dato del tipo ID_COMANDO\r
  62  {----------------------------------------------------------------------------}\r
  63  function strToComando( s: string ): ID_COMANDO;\r
  64 \r
  65  {----------------------------------------------------------------------------}\r
  66  {- Funcion: Convierte un string en un dato del tipo T_MOVIM\r
  67  {----------------------------------------------------------------------------}\r
  68  function strToMovim( s: string; var error: boolean ): T_MOVIM;\r
  69 \r
  70  {----------------------------------------------------------------------------}\r
  71  {- Procedimiento: Agrega el texto de un comando a ejecutar en el archivo de salida\r
  72  {----------------------------------------------------------------------------}\r
  73  procedure agregaComando( var f: text; c: T_COMANDO );\r
  74 \r
  75  {----------------------------------------------------------------------------}\r
  76  {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
  77  {----------------------------------------------------------------------------}\r
  78  procedure agregaError( var f: text; cmd, msg: string );\r
  79 \r
  80  {----------------------------------------------------------------------------}\r
  81  {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
  82  {----------------------------------------------------------------------------}\r
  83  procedure agregaRegistro( var f: text; cmd: string; r: T_REGISTRO );\r
  84 \r
  85 \r
  86 implementation\r
  87 \r
  88  {----------------------------------------------------------------------------}\r
  89  {- Procedimiento: Muestra un mensaje de bienvenida al programa\r
  90  {----------------------------------------------------------------------------}\r
  91  procedure mensajeDeEntrada( descripcion: String );\r
  92 \r
  93    begin\r
  94       writeln;\r
  95       writeln( 'ALGORITMOS Y PROGRAMACION II - Trabajo Practico n. 1' );\r
  96       writeln( 'GRUPO 22 - Primer Cuatrimestre 2000' );\r
  97       writeln;\r
  98       writeln( descripcion );\r
  99       writeln;\r
 100    end;\r
 101 \r
 102  {-- Fin del Procedimiento --}\r
 103 \r
 104  {----------------------------------------------------------------------------}\r
 105  {- Funcion: verifica si existe un archivo.\r
 106  {----------------------------------------------------------------------------}\r
 107 \r
 108     function existeArchivo( nombre: String ): boolean;\r
 109 \r
 110     { funcion extrida de la ayuda del Turbo Pascal 7 }\r
 111 \r
 112        var\r
 113           arch: text;\r
 114 \r
 115        begin\r
 116             {$I-}\r
 117             Assign( arch, nombre );\r
 118             FileMode := 0;  { Solo lectura }\r
 119             Reset( arch );\r
 120             Close( arch );\r
 121             {$I+}\r
 122             ExisteArchivo := (IOResult = 0) and (nombre <> '');\r
 123        end;\r
 124 \r
 125  {-- Fin de la Funcion ExisteArchivo --}\r
 126 \r
 127  {----------------------------------------------------------------------------}\r
 128  {- Procedimiento: Procesa los parametros de la ejecucion del programa\r
 129  {----------------------------------------------------------------------------}\r
 130 \r
 131  procedure procesarParametros( var archivoEntrada: T_ARCHIVO_COMANDOS; var archivoSalida: text; var error: boolean );\r
 132 \r
 133    begin\r
 134       if ( paramcount = 2 ) then begin\r
 135          if ( existeArchivo( paramstr( 1 ) ) ) then begin\r
 136             assign( archivoEntrada, paramstr( 1 ) );\r
 137             reset( archivoEntrada );\r
 138             assign( archivoSalida, paramstr( 2 ) );\r
 139             rewrite( archivoSalida );\r
 140             error := false;\r
 141             end\r
 142          else\r
 143             error := true;\r
 144          end\r
 145       else\r
 146          error := true;\r
 147    end;\r
 148 \r
 149  {-- Fin del Procedimiento procesarParametros --}\r
 150 \r
 151   {----------------------------------------------------------------------------}\r
 152   {- Procedimiento: Muestra un mensaje de error y la sintaxis del programa.\r
 153   {----------------------------------------------------------------------------}\r
 154 \r
 155   procedure errorParametros;\r
 156 \r
 157     var\r
 158       dir: dirstr;\r
 159       fname: namestr;\r
 160       ext: extstr;\r
 161 \r
 162     begin\r
 163       fsplit( paramstr( 0 ), dir, fname, ext );\r
 164       writeln;\r
 165       writeln;\r
 166       writeln( 'ERROR: No se pudieron abrir los archivos o numero de parametros incorrectos.' );\r
 167       writeln( '       Verifique que el archivo de comandos exista y que el archivo de salida no.' );\r
 168       writeln( '       Ademas asegurese de que tenga permiso de escritura en la unidad que desee' );\r
 169       writeln( '       guardar el archivo de salida.' );\r
 170       writeln;\r
 171       writeln( 'Modo de uso:' );\r
 172       writeln( '             ', fname, ' archivo_entrada archivo_salida' );\r
 173       writeln;\r
 174     end;\r
 175 \r
 176   {-- Fin del Procedimiento errorParametros --}\r
 177 \r
 178    {----------------------------------------------------------------------------}\r
 179    {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
 180    {----------------------------------------------------------------------------}\r
 181 \r
 182    procedure intro( var f: text );\r
 183 \r
 184      begin\r
 185          writeln( f );\r
 186          writeln( f );\r
 187          writeln( f, 'Archivo de Comandos    : ', ParamStr( 1 ) );\r
 188          writeln( f, 'Archivo de Informacion : ', ParamStr( 2 ) );\r
 189          writeln( f );\r
 190      end;\r
 191 \r
 192    {-- Fin del Procedimiento --}\r
 193 \r
 194    {----------------------------------------------------------------------------}\r
 195    {- Funcion: Convierte un dato del tipo T_MOVIM en un string\r
 196    {----------------------------------------------------------------------------}\r
 197 \r
 198    function movimToStr( m: T_MOVIM): string;\r
 199 \r
 200      begin\r
 201         case ( m ) of\r
 202          T_MOVIM_primero:\r
 203             movimToStr := 'P';\r
 204          T_MOVIM_ultimo:\r
 205             movimToStr := 'U';\r
 206          T_MOVIM_anterior:\r
 207             movimToStr := 'A';\r
 208          T_MOVIM_siguiente:\r
 209             movimToStr := 'S';\r
 210         end;\r
 211      end;\r
 212 \r
 213    {-- Fin del Procedimiento --}\r
 214 \r
 215    {----------------------------------------------------------------------------}\r
 216    {- Funcion: Convierte un dato del tipo ID_COMANDO en un string\r
 217    {----------------------------------------------------------------------------}\r
 218 \r
 219    function comandoToStr( c: ID_COMANDO ): string;\r
 220 \r
 221      begin\r
 222         case ( c ) of\r
 223          INS:\r
 224             comandoToStr := 'IN';\r
 225          INSO:\r
 226             comandoToStr := 'IO';\r
 227          ORDEN:\r
 228             comandoToStr := 'OR';\r
 229          BC:\r
 230             comandoToStr := 'BC';\r
 231          BR:\r
 232             comandoToStr := 'BR';\r
 233          LS:\r
 234             comandoToStr := 'LS';\r
 235          LC:\r
 236             comandoToStr := 'LC';\r
 237          BO:\r
 238             comandoToStr := 'BO';\r
 239          MO:\r
 240             comandoToStr := 'MO';\r
 241          LI:\r
 242             comandoToStr := 'LI';\r
 243          else\r
 244             comandoToStr := 'DE';\r
 245         end;\r
 246      end;\r
 247 \r
 248    {-- Fin del Procedimiento --}\r
 249 \r
 250    {----------------------------------------------------------------------------}\r
 251    {- Funcion: Convierte un string en un dato del tipo ID_COMANDO\r
 252    {----------------------------------------------------------------------------}\r
 253 \r
 254    function strToComando( s: string ): ID_COMANDO;\r
 255 \r
 256      begin\r
 257          if ( ( s = 'IN' ) or ( s = 'in' ) or ( s = 'In' ) or ( s = 'iN' ) ) then\r
 258             strToComando := INS\r
 259          else if ( ( s = 'IO' ) or ( s = 'io' ) or ( s = 'Io' ) or ( s = 'iO' ) ) then\r
 260             strToComando := INSO\r
 261          else if ( ( s = 'OR' ) or ( s = 'or' ) or ( s = 'Or' ) or ( s = 'oR' ) ) then\r
 262             strToComando := ORDEN\r
 263          else if ( ( s = 'BC' ) or ( s = 'bc' ) or ( s = 'Bc' ) or ( s = 'bC' ) ) then\r
 264             strToComando := BC\r
 265          else if ( ( s = 'BR' ) or ( s = 'br' ) or ( s = 'Br' ) or ( s = 'bR' ) ) then\r
 266             strToComando := BR\r
 267          else if ( ( s = 'LS' ) or ( s = 'ls' ) or ( s = 'Ls' ) or ( s = 'lS' ) ) then\r
 268             strToComando := LS\r
 269          else if ( ( s = 'LC' ) or ( s = 'lc' ) or ( s = 'Lc' ) or ( s = 'lC' ) ) then\r
 270             strToComando := LC\r
 271          else if ( ( s = 'BO' ) or ( s = 'bo' ) or ( s = 'bO' ) or ( s = 'Bo' ) ) then\r
 272             strToComando := BO\r
 273          else if ( ( s = 'MO' ) or ( s = 'mo' ) or ( s = 'mO' ) or ( s = 'Mo' ) ) then\r
 274             strToComando := MO\r
 275          else if ( ( s = 'LI' ) or ( s = 'li' ) or ( s = 'Li' ) or ( s = 'lI' ) ) then\r
 276             strToComando := LI\r
 277          else\r
 278             strToComando := DESC;\r
 279      end;\r
 280 \r
 281    {-- Fin del Procedimiento --}\r
 282 \r
 283    {----------------------------------------------------------------------------}\r
 284    {- Funcion: Convierte un string en un dato del tipo T_MOVIM\r
 285    {----------------------------------------------------------------------------}\r
 286 \r
 287    function strToMovim( s: string; var error: boolean ): T_MOVIM;\r
 288 \r
 289      begin\r
 290          error := false;\r
 291          if ( ( s = 'P' ) or ( s = 'p' ) ) then\r
 292             strToMovim := T_MOVIM_primero\r
 293          else if ( ( s = 'U' ) or ( s = 'u' ) ) then\r
 294             strToMovim := T_MOVIM_ultimo\r
 295          else if ( ( s = 'A' ) or ( s = 'a' ) ) then\r
 296             strToMovim := T_MOVIM_anterior\r
 297          else if ( ( s = 'S' ) or ( s = 's' ) ) then\r
 298             strToMovim := T_MOVIM_siguiente\r
 299          else begin\r
 300             strToMovim := T_MOVIM_primero;\r
 301             error := true;\r
 302          end;\r
 303      end;\r
 304 \r
 305    {-- Fin del Procedimiento --}\r
 306 \r
 307    {----------------------------------------------------------------------------}\r
 308    {- Procedimiento: Agrega el texto de un comando a ejecutar en el archivo de salida\r
 309    {----------------------------------------------------------------------------}\r
 310 \r
 311    procedure agregaComando( var f: text; c: T_COMANDO );\r
 312 \r
 313      var\r
 314         err: boolean;\r
 315         m: string;\r
 316 \r
 317      begin\r
 318         writeln( f );\r
 319         write( f, '>>> ', comandoToStr( strToComando( c.comando ) ) ); { Para que aparezca en mayusculas }\r
 320         write( f, ' ; ', c.dni );\r
 321         write( f, ' ; ', c.nombre );\r
 322         m := movimToStr( strToMovim( c.Movimiento, err ) );\r
 323         if ( err ) then begin\r
 324            if ( c.movimiento = '*' ) then\r
 325               m := 'Desconocido'\r
 326            else\r
 327               m := 'Ninguno';\r
 328            end;\r
 329         write( f, ' ; ', m ); { Para que aparezca en mayusculas }\r
 330         write( f, ' ; ', c.dni_hasta );\r
 331         writeln( f );\r
 332     end;\r
 333 \r
 334    {-- Fin del Procedimiento --}\r
 335 \r
 336 \r
 337     {----------------------------------------------------------------------------}\r
 338     {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
 339     {----------------------------------------------------------------------------}\r
 340 \r
 341     procedure agregaError( var f: text; cmd, msg: string );\r
 342 \r
 343       begin\r
 344          writeln( f, '  * ' + comandoToStr( strToComando( cmd ) ) + ' ERROR: ' + msg );\r
 345       end;\r
 346 \r
 347     {-- Fin del Procedimiento --}\r
 348 \r
 349 \r
 350     {----------------------------------------------------------------------------}\r
 351     {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
 352     {----------------------------------------------------------------------------}\r
 353 \r
 354     procedure agregaRegistro( var f: text; cmd: string; r: T_REGISTRO );\r
 355 \r
 356       var\r
 357          s1, s2: string;\r
 358 \r
 359       begin\r
 360          s1 := '  @ ' + comandoToStr( strToComando( cmd ) ) + ' REGISTRO: Clave = ';\r
 361          s2 := ' | Nombre = ' + r.nombre;\r
 362          writeln( f, s1, r.dni, s2  );\r
 363       end;\r
 364 \r
 365     {-- Fin del Procedimiento --}\r
 366 end.