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, ABO_AB, ABO_UTIL, PILA_C;\r
  12 \r
  13  type\r
  14     T_COMANDO_TABLA = 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     T_COMANDO_ABO = record\r
  22                       Comando: string[2];\r
  23                       DNI: string[8];\r
  24                       Nombre: string[40];\r
  25                     end;\r
  26     ID_COMANDO = ( INS, IO, ORDEN, BC, BR, LS, LC, BO, MO, LI, DESC );\r
  27 \r
  28     T_ARCHIVO_COMANDOS_TABLA = file of T_COMANDO_TABLA;\r
  29 \r
  30     T_ARCHIVO_COMANDOS_ABO = file of T_COMANDO_ABO;\r
  31 \r
  32  {----------------------------------------------------------------------------}\r
  33  {- Procedimiento: Muestra un mensaje de bienvenida al programa\r
  34  {----------------------------------------------------------------------------}\r
  35  procedure mensajeDeEntrada( descripcion: String );\r
  36 \r
  37  {----------------------------------------------------------------------------}\r
  38  {- Funcion: verifica si existe un archivo.\r
  39  {----------------------------------------------------------------------------}\r
  40  function existeArchivo( nombre: String ): boolean;\r
  41 \r
  42  {----------------------------------------------------------------------------}\r
  43  {- Procedimiento: Procesa los parametros de la ejecucion del programa\r
  44  {----------------------------------------------------------------------------}\r
  45  procedure procesarParametros( var archivoEntradaTabla: T_ARCHIVO_COMANDOS_TABLA;\r
  46                                var archivoEntradaABO: T_ARCHIVO_COMANDOS_ABO;\r
  47                                var archivoSalida: text; var error: boolean );\r
  48 \r
  49  {----------------------------------------------------------------------------}\r
  50  {- Procedimiento: Muestra un mensaje de error y la sintaxis del programa.\r
  51  {----------------------------------------------------------------------------}\r
  52  procedure errorParametros;\r
  53 \r
  54  {----------------------------------------------------------------------------}\r
  55  {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
  56  {----------------------------------------------------------------------------}\r
  57  procedure intro( var f: text );\r
  58 \r
  59  {----------------------------------------------------------------------------}\r
  60  {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
  61  {----------------------------------------------------------------------------}\r
  62  procedure introTabla( var f: text );\r
  63 \r
  64  {----------------------------------------------------------------------------}\r
  65  {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
  66  {----------------------------------------------------------------------------}\r
  67  procedure introABO( var f: text );\r
  68 \r
  69  {----------------------------------------------------------------------------}\r
  70  {- Funcion: Convierte un dato del tipo T_MOVIM en un string\r
  71  {----------------------------------------------------------------------------}\r
  72  function movimToStr( m: T_MOVIM): string;\r
  73 \r
  74  {----------------------------------------------------------------------------}\r
  75  {- Funcion: Convierte un dato del tipo ID_COMANDO en un string\r
  76  {----------------------------------------------------------------------------}\r
  77  function comandoToStr( c: ID_COMANDO ): string;\r
  78 \r
  79  {----------------------------------------------------------------------------}\r
  80  {- Funcion: Convierte un string en un dato del tipo ID_COMANDO\r
  81  {----------------------------------------------------------------------------}\r
  82  function strToComando( s: string ): ID_COMANDO;\r
  83 \r
  84  {----------------------------------------------------------------------------}\r
  85  {- Funcion: Convierte un string en un dato del tipo T_MOVIM\r
  86  {----------------------------------------------------------------------------}\r
  87  function strToMovim( s: string; var error: boolean ): T_MOVIM;\r
  88 \r
  89  {----------------------------------------------------------------------------}\r
  90  {- Procedimiento: Agrega el texto de un comando a ejecutar en el archivo de salida\r
  91  {----------------------------------------------------------------------------}\r
  92  procedure agregaComandoTBL( var f: text; c: T_COMANDO_TABLA );\r
  93 \r
  94  {----------------------------------------------------------------------------}\r
  95  {- Procedimiento: Agrega el texto de un comando a ejecutar en el archivo de salida\r
  96  {----------------------------------------------------------------------------}\r
  97  procedure agregaComandoABO( var f: text; c: T_COMANDO_ABO );\r
  98 \r
  99  {----------------------------------------------------------------------------}\r
 100  {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
 101  {----------------------------------------------------------------------------}\r
 102  procedure agregaError( var f: text; cmd, msg: string );\r
 103 \r
 104  {----------------------------------------------------------------------------}\r
 105  {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
 106  {----------------------------------------------------------------------------}\r
 107  procedure agregaRegistro( var f: text; cmd: string; r: T_REGISTRO );\r
 108 \r
 109  {----------------------------------------------------------------------------}\r
 110  {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
 111  {----------------------------------------------------------------------------}\r
 112  procedure mostrarPila( var f: text; var p: T_PILAC );\r
 113 \r
 114 \r
 115 implementation\r
 116 \r
 117  {----------------------------------------------------------------------------}\r
 118  {- Procedimiento: Muestra un mensaje de bienvenida al programa\r
 119  {----------------------------------------------------------------------------}\r
 120  procedure mensajeDeEntrada( descripcion: String );\r
 121 \r
 122    begin\r
 123       writeln;\r
 124       writeln( 'ALGORITMOS Y PROGRAMACION II - Trabajo Practico n. 2' );\r
 125       writeln( 'GRUPO 22 - Primer Cuatrimestre 2000' );\r
 126       writeln;\r
 127       writeln( descripcion );\r
 128       writeln;\r
 129    end;\r
 130 \r
 131  {-- Fin del Procedimiento --}\r
 132 \r
 133  {----------------------------------------------------------------------------}\r
 134  {- Funcion: verifica si existe un archivo.\r
 135  {----------------------------------------------------------------------------}\r
 136 \r
 137     function existeArchivo( nombre: String ): boolean;\r
 138 \r
 139     { funcion extrida de la ayuda del Turbo Pascal 7 }\r
 140 \r
 141        var\r
 142           arch: text;\r
 143 \r
 144        begin\r
 145             {$I-}\r
 146             Assign( arch, nombre );\r
 147             FileMode := 0;  { Solo lectura }\r
 148             Reset( arch );\r
 149             Close( arch );\r
 150             {$I+}\r
 151             ExisteArchivo := (IOResult = 0) and (nombre <> '');\r
 152        end;\r
 153 \r
 154  {-- Fin de la Funcion ExisteArchivo --}\r
 155 \r
 156  {----------------------------------------------------------------------------}\r
 157  {- Procedimiento: Procesa los parametros de la ejecucion del programa\r
 158  {----------------------------------------------------------------------------}\r
 159 \r
 160  procedure procesarParametros( var archivoEntradaTabla: T_ARCHIVO_COMANDOS_TABLA;\r
 161                                var archivoEntradaABO: T_ARCHIVO_COMANDOS_ABO;\r
 162                                var archivoSalida: text; var error: boolean );\r
 163 \r
 164    begin\r
 165       if ( paramcount = 3 ) then begin\r
 166          if ( existeArchivo( paramstr( 1 ) ) and existeArchivo( paramstr( 2 ) ) ) then begin\r
 167             assign( archivoEntradaTabla, paramstr( 1 ) );\r
 168             reset( archivoEntradaTabla );\r
 169             assign( archivoEntradaABO, paramstr( 2 ) );\r
 170             reset( archivoEntradaABO );\r
 171             assign( archivoSalida, paramstr( 3 ) );\r
 172             rewrite( archivoSalida );\r
 173             error := false;\r
 174             end\r
 175          else\r
 176             error := true;\r
 177          end\r
 178       else\r
 179          error := true;\r
 180    end;\r
 181 \r
 182  {-- Fin del Procedimiento procesarParametros --}\r
 183 \r
 184   {----------------------------------------------------------------------------}\r
 185   {- Procedimiento: Muestra un mensaje de error y la sintaxis del programa.\r
 186   {----------------------------------------------------------------------------}\r
 187 \r
 188   procedure errorParametros;\r
 189 \r
 190     var\r
 191       dir: dirstr;\r
 192       fname: namestr;\r
 193       ext: extstr;\r
 194 \r
 195     begin\r
 196       fsplit( paramstr( 0 ), dir, fname, ext );\r
 197       writeln;\r
 198       writeln;\r
 199       writeln( 'ERROR: No se pudieron abrir los archivos o numero de parametros incorrectos.' );\r
 200       writeln( '       Verifique que el archivo de comandos exista y que el archivo de salida no.' );\r
 201       writeln( '       Ademas asegurese de que tenga permiso de escritura en la unidad que desee' );\r
 202       writeln( '       guardar el archivo de salida.' );\r
 203       writeln;\r
 204       writeln( 'Modo de uso:' );\r
 205       writeln( '             ', fname, ' archivo_comandos_tabla archivo_comandos_abo archivo_salida' );\r
 206       writeln;\r
 207     end;\r
 208 \r
 209   {-- Fin del Procedimiento errorParametros --}\r
 210 \r
 211    {----------------------------------------------------------------------------}\r
 212    {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
 213    {----------------------------------------------------------------------------}\r
 214 \r
 215    procedure intro( var f: text );\r
 216 \r
 217      begin\r
 218          writeln( f );\r
 219          writeln( f );\r
 220          writeln( f, 'Archivo de Comandos de Tabla: ', ParamStr( 1 ) );\r
 221          writeln( f, 'Archivo de Comandos de ABO  : ', ParamStr( 2 ) );\r
 222          writeln( f, 'Archivo de Informacion      : ', ParamStr( 3 ) );\r
 223          writeln( f );\r
 224      end;\r
 225 \r
 226    {-- Fin del Procedimiento --}\r
 227 \r
 228    {----------------------------------------------------------------------------}\r
 229    {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
 230    {----------------------------------------------------------------------------}\r
 231 \r
 232    procedure introTabla( var f: text );\r
 233 \r
 234      begin\r
 235          writeln( f );\r
 236          writeln( f );\r
 237          writeln( f, 'PROCESO DE ARCHIVO DE COMANDOS DE TABLA' );\r
 238          writeln( f, '======= == ======= == ======== == =====' );\r
 239          writeln( f );\r
 240          writeln( f );\r
 241      end;\r
 242 \r
 243    {-- Fin del Procedimiento --}\r
 244 \r
 245    {----------------------------------------------------------------------------}\r
 246    {- Procedimiento: Muestra mensaje introductorio en archivo de salida\r
 247    {----------------------------------------------------------------------------}\r
 248 \r
 249    procedure introABO( var f: text );\r
 250 \r
 251      begin\r
 252          writeln( f );\r
 253          writeln( f );\r
 254          writeln( f, 'PROCESO DE ARCHIVO DE COMANDOS DEL ABO' );\r
 255          writeln( f, '======= == ======= == ======== === ===' );\r
 256          writeln( f );\r
 257          writeln( f );\r
 258      end;\r
 259 \r
 260    {-- Fin del Procedimiento --}\r
 261 \r
 262    {----------------------------------------------------------------------------}\r
 263    {- Funcion: Convierte un dato del tipo T_MOVIM en un string\r
 264    {----------------------------------------------------------------------------}\r
 265 \r
 266    function movimToStr( m: T_MOVIM): string;\r
 267 \r
 268      begin\r
 269         case ( m ) of\r
 270          T_MOVIM_primero:\r
 271             movimToStr := 'P';\r
 272          T_MOVIM_ultimo:\r
 273             movimToStr := 'U';\r
 274          T_MOVIM_anterior:\r
 275             movimToStr := 'A';\r
 276          T_MOVIM_siguiente:\r
 277             movimToStr := 'S';\r
 278         end;\r
 279      end;\r
 280 \r
 281    {-- Fin del Procedimiento --}\r
 282 \r
 283    {----------------------------------------------------------------------------}\r
 284    {- Funcion: Convierte un dato del tipo ID_COMANDO en un string\r
 285    {----------------------------------------------------------------------------}\r
 286 \r
 287    function comandoToStr( c: ID_COMANDO ): string;\r
 288 \r
 289      begin\r
 290         case ( c ) of\r
 291          INS:\r
 292             comandoToStr := 'IN';\r
 293          IO:\r
 294             comandoToStr := 'IO';\r
 295          ORDEN:\r
 296             comandoToStr := 'OR';\r
 297          BC:\r
 298             comandoToStr := 'BC';\r
 299          BR:\r
 300             comandoToStr := 'BR';\r
 301          LS:\r
 302             comandoToStr := 'LS';\r
 303          LC:\r
 304             comandoToStr := 'LC';\r
 305          BO:\r
 306             comandoToStr := 'BO';\r
 307          MO:\r
 308             comandoToStr := 'MO';\r
 309          LI:\r
 310             comandoToStr := 'LI';\r
 311          else\r
 312             comandoToStr := 'DE';\r
 313         end;\r
 314      end;\r
 315 \r
 316    {-- Fin del Procedimiento --}\r
 317 \r
 318    {----------------------------------------------------------------------------}\r
 319    {- Funcion: Convierte un string en un dato del tipo ID_COMANDO\r
 320    {----------------------------------------------------------------------------}\r
 321 \r
 322    function strToComando( s: string ): ID_COMANDO;\r
 323 \r
 324      begin\r
 325          if ( ( s = 'IN' ) or ( s = 'in' ) or ( s = 'In' ) or ( s = 'iN' ) ) then\r
 326             strToComando := INS\r
 327          else if ( ( s = 'IO' ) or ( s = 'io' ) or ( s = 'Io' ) or ( s = 'iO' ) ) then\r
 328             strToComando := IO\r
 329          else if ( ( s = 'OR' ) or ( s = 'or' ) or ( s = 'Or' ) or ( s = 'oR' ) ) then\r
 330             strToComando := ORDEN\r
 331          else if ( ( s = 'BC' ) or ( s = 'bc' ) or ( s = 'Bc' ) or ( s = 'bC' ) ) then\r
 332             strToComando := BC\r
 333          else if ( ( s = 'BR' ) or ( s = 'br' ) or ( s = 'Br' ) or ( s = 'bR' ) ) then\r
 334             strToComando := BR\r
 335          else if ( ( s = 'LS' ) or ( s = 'ls' ) or ( s = 'Ls' ) or ( s = 'lS' ) ) then\r
 336             strToComando := LS\r
 337          else if ( ( s = 'LC' ) or ( s = 'lc' ) or ( s = 'Lc' ) or ( s = 'lC' ) ) then\r
 338             strToComando := LC\r
 339          else if ( ( s = 'BO' ) or ( s = 'bo' ) or ( s = 'bO' ) or ( s = 'Bo' ) ) then\r
 340             strToComando := BO\r
 341          else if ( ( s = 'MO' ) or ( s = 'mo' ) or ( s = 'mO' ) or ( s = 'Mo' ) ) then\r
 342             strToComando := MO\r
 343          else if ( ( s = 'LI' ) or ( s = 'li' ) or ( s = 'Li' ) or ( s = 'lI' ) ) then\r
 344             strToComando := LI\r
 345          else\r
 346             strToComando := DESC;\r
 347      end;\r
 348 \r
 349    {-- Fin del Procedimiento --}\r
 350 \r
 351    {----------------------------------------------------------------------------}\r
 352    {- Funcion: Convierte un string en un dato del tipo ID_COMANDO\r
 353    {----------------------------------------------------------------------------}\r
 354 \r
 355    {----------------------------------------------------------------------------}\r
 356    {- Funcion: Convierte un string en un dato del tipo T_MOVIM\r
 357    {----------------------------------------------------------------------------}\r
 358 \r
 359    function strToMovim( s: string; var error: boolean ): T_MOVIM;\r
 360 \r
 361      begin\r
 362          error := false;\r
 363          if ( ( s = 'P' ) or ( s = 'p' ) ) then\r
 364             strToMovim := T_MOVIM_primero\r
 365          else if ( ( s = 'U' ) or ( s = 'u' ) ) then\r
 366             strToMovim := T_MOVIM_ultimo\r
 367          else if ( ( s = 'A' ) or ( s = 'a' ) ) then\r
 368             strToMovim := T_MOVIM_anterior\r
 369          else if ( ( s = 'S' ) or ( s = 's' ) ) then\r
 370             strToMovim := T_MOVIM_siguiente\r
 371          else begin\r
 372             strToMovim := T_MOVIM_primero;\r
 373             error := true;\r
 374          end;\r
 375      end;\r
 376 \r
 377    {-- Fin del Procedimiento --}\r
 378 \r
 379    {----------------------------------------------------------------------------}\r
 380    {- Procedimiento: Agrega el texto de un comando a ejecutar en el archivo de salida\r
 381    {----------------------------------------------------------------------------}\r
 382 \r
 383    procedure agregaComandoTBL( var f: text; c: T_COMANDO_TABLA );\r
 384 \r
 385      var\r
 386         err: boolean;\r
 387         m: string;\r
 388 \r
 389      begin\r
 390         writeln( f );\r
 391         write( f, '>>> ', comandoToStr( strToComando( c.comando ) ) ); { Para que aparezca en mayusculas }\r
 392         write( f, ' ; ', c.dni );\r
 393         write( f, ' ; ', c.nombre );\r
 394         m := movimToStr( strToMovim( c.Movimiento, err ) );\r
 395         if ( err ) then begin\r
 396            if ( c.movimiento = '*' ) then\r
 397               m := 'Desconocido'\r
 398            else\r
 399               m := 'Ninguno';\r
 400            end;\r
 401         write( f, ' ; ', m ); { Para que aparezca en mayusculas }\r
 402         write( f, ' ; ', c.dni_hasta );\r
 403         writeln( f );\r
 404     end;\r
 405 \r
 406    {-- Fin del Procedimiento --}\r
 407 \r
 408    {----------------------------------------------------------------------------}\r
 409    {- Procedimiento: Agrega el texto de un comando a ejecutar en el archivo de salida\r
 410    {----------------------------------------------------------------------------}\r
 411 \r
 412    procedure agregaComandoABO( var f: text; c: T_COMANDO_ABO );\r
 413 \r
 414      var\r
 415         err: boolean;\r
 416         m: string;\r
 417 \r
 418      begin\r
 419         writeln( f );\r
 420         write( f, '>>> ', comandoToStr( strToComando( c.comando ) ) ); { Para que aparezca en mayusculas }\r
 421         write( f, ' ; ', c.dni );\r
 422         write( f, ' ; ', c.nombre );\r
 423         writeln( f );\r
 424     end;\r
 425 \r
 426    {-- Fin del Procedimiento --}\r
 427 \r
 428 \r
 429     {----------------------------------------------------------------------------}\r
 430     {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
 431     {----------------------------------------------------------------------------}\r
 432 \r
 433     procedure agregaError( var f: text; cmd, msg: string );\r
 434 \r
 435       begin\r
 436          writeln( f, '  * ' +  cmd + ' ERROR: ' + msg );\r
 437       end;\r
 438 \r
 439     {-- Fin del Procedimiento --}\r
 440 \r
 441 \r
 442     {----------------------------------------------------------------------------}\r
 443     {- Procedimiento: Agrega mensaje de error en el archivo de salida\r
 444     {----------------------------------------------------------------------------}\r
 445 \r
 446     procedure agregaRegistro( var f: text; cmd: string; r: T_REGISTRO );\r
 447 \r
 448       var\r
 449          s1, s2: string;\r
 450 \r
 451       begin\r
 452          s1 := '  @ ' + cmd + '> REGISTRO: Clave = ';\r
 453          s2 := ' | Nombre = ' + r.nombre;\r
 454          writeln( f, s1, r.dni, s2  );\r
 455       end;\r
 456 \r
 457     {-- Fin del Procedimiento --}\r
 458 \r
 459 \r
 460     {----------------------------------------------------------------------------}\r
 461     {- Procedimiento: Muestra el contenido de una pila (vaciandola)\r
 462     {----------------------------------------------------------------------------}\r
 463     procedure mostrarPila( var f: text; var p: T_PILAC );\r
 464 \r
 465       var\r
 466          r: T_REGISTRO;\r
 467 \r
 468       begin\r
 469          while ( not PILAC_vacio( p ) ) do begin\r
 470             PILAC_sacar( p, r );\r
 471             agregaRegistro( f, 'PILAC', r );\r
 472          end;\r
 473       end;\r
 474 \r
 475 end.