test/IRDnames.pas

   1 program Generador_De_Nombres_Ordenados_Alfabeticamente;\r
   2 \r
   3 uses\r
   4     CRT;\r
   5 \r
   6 const\r
   7      MAX_APE = 15;\r
   8 \r
   9 type\r
  10     APELLIDO = string[MAX_APE];\r
  11     DOCUMENTO = 10000000..40000000;\r
  12     PERSONA = record\r
  13                     ap: APELLIDO;\r
  14                     dni: DOCUMENTO;\r
  15               end;\r
  16     TABLA = array[1..1000] of PERSONA;\r
  17     TIPO_LETRA = ( TL_VOCAL, TL_CONSO );\r
  18     TIPO_VOCAL = ( TV_AEIOU, TV_EI );\r
  19     INDICADOR = ( I_NADA, I_ESB, I_ESC, I_ESF, I_ESG, I_ESL, I_ESM, I_ESN, I_ESQ, I_ESQU, I_ESR, I_EST );\r
  20 \r
  21 (*********************************************************)\r
  22 \r
  23  function GetVocal( tipo: TIPO_VOCAL ): char;\r
  24 \r
  25    var\r
  26       valor: integer;\r
  27 \r
  28    begin\r
  29         if tipo = TV_AEIOU then valor := random( 16 )\r
  30                            else valor := random( 6 ) + 5;\r
  31         case valor of\r
  32             0..4: GetVocal := 'A';\r
  33             5..7: GetVocal := 'E';\r
  34             8..10: GetVocal := 'I';\r
  35             11..13: GetVocal := 'O';\r
  36             14..15: GetVocal := 'U';\r
  37         end;\r
  38    end;\r
  39 \r
  40 (*********************************************************)\r
  41 \r
  42  procedure GetRNDVocal( var indic: INDICADOR; var proxl: TIPO_LETRA; var vocal: char );\r
  43 \r
  44    var\r
  45       valor: integer;\r
  46 \r
  47     begin\r
  48         case indic of\r
  49             I_ESQ:\r
  50                   begin\r
  51                        vocal := 'U';\r
  52                        indic := I_ESQU;\r
  53                        proxl := TL_VOCAL;\r
  54                   end;\r
  55             I_ESQU:\r
  56                    begin\r
  57                         vocal := GetVocal( TV_EI );\r
  58                         indic := I_NADA;\r
  59                         proxl := TL_CONSO;\r
  60                    end;\r
  61             else\r
  62               begin\r
  63                    vocal := GetVocal( TV_AEIOU );\r
  64                    indic := I_NADA;\r
  65                    if random( 40 ) = 0 then proxl := TL_VOCAL\r
  66                                        else proxl := TL_CONSO;\r
  67               end;\r
  68             end;\r
  69     end;\r
  70 \r
  71 (*********************************************************)\r
  72 \r
  73  procedure GetRNDConsonante( var indic: INDICADOR; var proxl: TIPO_LETRA; var conso: char );\r
  74 \r
  75    var\r
  76       valor: integer;\r
  77 \r
  78    begin\r
  79         proxl := TL_VOCAL;\r
  80         indic := I_NADA;\r
  81 \r
  82         case indic of\r
  83             I_ESF, I_ESR, I_ESG, I_EST: conso := 'R';\r
  84             I_ESB: case random( 2 ) of\r
  85                        0: conso := 'R';\r
  86                        1: conso := 'L';\r
  87                    end;\r
  88             I_ESC: case random( 4 ) of\r
  89                        0: conso := 'C';\r
  90                        1: conso := 'H';\r
  91                        2: conso := 'R';\r
  92                        3: conso := 'L';\r
  93                    end;\r
  94             I_ESL: case random( 6 ) of\r
  95                        0: conso := 'T';\r
  96                        1..5: conso := 'L';\r
  97                    end;\r
  98             I_ESM: case random( 3 ) of\r
  99                        0: conso := 'P';\r
 100                        1: conso := 'B';\r
 101                        2: conso := 'L';\r
 102                    end;\r
 103             I_ESN: case random( 3 ) of\r
 104                             0: conso := 'R';\r
 105                             1: conso := 'V';\r
 106                             2: conso := 'C';\r
 107                    end;\r
 108             else case random( 55 ) of\r
 109                     0..3: begin\r
 110                                conso := 'B';\r
 111                                if random( 10 ) = 0 then begin\r
 112                                                              indic := I_ESB;\r
 113                                                              proxl := TL_CONSO;\r
 114                                                         end;\r
 115                           end;\r
 116                     4..7: begin\r
 117                                conso := 'C';\r
 118                                if random( 5 ) = 0 then begin\r
 119                                                              indic := I_ESC;\r
 120                                                              proxl := TL_CONSO;\r
 121                                                         end;\r
 122                           end;\r
 123                     8..11: conso := 'D';\r
 124                     12..14: begin\r
 125                                conso := 'F';\r
 126                                if random( 10 ) = 0 then begin\r
 127                                                              indic := I_ESF;\r
 128                                                              proxl := TL_CONSO;\r
 129                                                         end;\r
 130                             end;\r
 131                     15..17: begin\r
 132                                conso := 'G';\r
 133                                if random( 5 ) = 0 then\r
 134                                  begin\r
 135                                       indic := I_ESG;\r
 136                                       if random( 4 ) = 0 then proxl := TL_CONSO;\r
 137                                  end;\r
 138                             end;\r
 139                     18..19: conso := 'H';\r
 140                     20..22: conso := 'J';\r
 141                     23..24: conso := 'K';\r
 142                     25..27: begin\r
 143                                conso := 'L';\r
 144                                if random( 15 ) = 0 then\r
 145                                  begin\r
 146                                       indic := I_ESL;\r
 147                                       proxl := TL_CONSO;\r
 148                                  end;\r
 149                             end;\r
 150                     28..30: begin\r
 151                                conso := 'M';\r
 152                                if random( 5 ) = 0 then\r
 153                                  begin\r
 154                                       indic := I_ESM;\r
 155                                       proxl := TL_CONSO;\r
 156                                  end;\r
 157                             end;\r
 158                     31..33: begin\r
 159                                conso := 'N';\r
 160                                if random( 5 ) = 0 then\r
 161                                  begin\r
 162                                       indic := I_ESN;\r
 163                                       proxl := TL_CONSO;\r
 164                                  end;\r
 165                             end;\r
 166                     34..36: conso := 'P';\r
 167                     37..38: begin\r
 168                                conso := 'Q';\r
 169                                indic := I_ESQ;\r
 170                             end;\r
 171                     39..41: begin\r
 172                                conso := 'R';\r
 173                                if random( 3 ) = 0 then\r
 174                                  begin\r
 175                                       indic := I_ESR;\r
 176                                       proxl := TL_CONSO;\r
 177                                  end;\r
 178                             end;\r
 179                     42..44: conso := 'S';\r
 180                     45..47: begin\r
 181                                conso := 'T';\r
 182                                if random( 10 ) = 0 then\r
 183                                  begin\r
 184                                       indic := I_EST;\r
 185                                       proxl := TL_CONSO;\r
 186                                  end;\r
 187                             end;\r
 188                     48..50: conso := 'V';\r
 189                     51: conso := 'W';\r
 190                     52: conso := 'X';\r
 191                     53: conso := 'Y';\r
 192                     54: conso := 'Z';\r
 193                  end; { case random( 55 ) of }\r
 194 \r
 195         end; { case indic of }\r
 196    end; { procedimiento }\r
 197 \r
 198 (*********************************************************)\r
 199 \r
 200  function GetRNDApellido( max, min: integer ): APELLIDO;\r
 201 \r
 202     var\r
 203        tam, i: integer;\r
 204        aux: char;\r
 205        apel: APELLIDO;\r
 206        indic: INDICADOR;\r
 207        proxl: TIPO_LETRA;\r
 208 \r
 209     begin\r
 210          if max > MAX_APE then max := MAX_APE;\r
 211          tam := random( max + 1 ) + min;\r
 212          indic := I_NADA;\r
 213          apel := '';\r
 214          if random( 5 ) = 0 then proxl := TL_VOCAL\r
 215                             else proxl := TL_CONSO;\r
 216          for i := 1 to tam do\r
 217            begin\r
 218                 if proxl = TL_CONSO then GetRNDConsonante( indic, proxl, aux )\r
 219                                     else GetRNDVocal( indic, proxl, aux );\r
 220                 apel := apel + aux;\r
 221            end;\r
 222          GetRNDApellido := apel;\r
 223     end;\r
 224 \r
 225 (*********************************************************)\r
 226 \r
 227  function GetRNDLetra( min, max: char ): char;\r
 228 \r
 229     begin\r
 230          GetRNDLetra := chr( random( ord( max ) - ord( min ) + 1 ) + ord( min ) );\r
 231     end;\r
 232 \r
 233 \r
 234 (*********************************************************)\r
 235  procedure GetInvOrdApellidos( var ar: text; cant: integer );\r
 236 \r
 237     var\r
 238         mil: boolean;\r
 239         letra, letra1: char;\r
 240         i, j, veces: integer;\r
 241         dni: DOCUMENTO;\r
 242         ap, ape, apel: APELLIDO;\r
 243 \r
 244     begin\r
 245          mil := false;\r
 246          if cant = 1000 then mil := true;\r
 247          dni := 34000000 + (random( 15000 ) * 100);\r
 248          ap := '';\r
 249          ape := '';\r
 250          apel := '';\r
 251          for letra := 'Z' downto 'A' do\r
 252            begin\r
 253                 ap := letra;\r
 254                 for letra1 := 'Z' downto 'A' do\r
 255                    begin\r
 256                         if mil then\r
 257                            case letra of\r
 258                                 'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T':\r
 259                                      case letra1 of\r
 260                                           'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'Z': veces := 2;\r
 261                                           else veces := 1;\r
 262                                      end;\r
 263                                 else case letra1 of\r
 264                                           'A', 'B', 'C', 'E', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T': veces := 2;\r
 265                                           else veces := 1;\r
 266                                      end;\r
 267                            end\r
 268                         else\r
 269                            case letra of\r
 270                                 'A', 'B', 'C', 'D', 'E', 'F', 'I', 'L', 'M', 'N', 'O', 'P', 'R', 'S', 'T', 'V':\r
 271                                      case letra1 of\r
 272                                           'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U', 'V': veces := 2;\r
 273                                           else veces := 1;\r
 274                                      end;\r
 275                                 else case letra1 of\r
 276                                           'D', 'F', 'G', 'H', 'I', 'J', 'K', 'U': veces := 2;\r
 277                                           else veces := 1;\r
 278                                      end;\r
 279                            end;\r
 280                         ape := ap + letra1;\r
 281                         for j := 1 to veces do\r
 282                             begin\r
 283                                  if j <> 1 then apel := ape + GetRNDLetra( 'A', 'M' ) + GetRNDApellido( 6, 1 )\r
 284                                           else apel := ape + GetRNDLetra( 'N', 'Z' ) + GetRNDApellido( 6, 1 );\r
 285                                  dni := dni - random( 50000 ) - 1;\r
 286                                  writeln( ar, apel );\r
 287                                  writeln( ar, dni );\r
 288                                  writeln( ar );\r
 289                                  apel := '';\r
 290                             end;\r
 291 \r
 292                         ape := '';\r
 293 \r
 294                    end; { for letra1 := 'A' to 'Z' do }\r
 295 \r
 296                 ap := '';\r
 297 \r
 298            end; { for letra := 'A' to 'Z' do }\r
 299 \r
 300     end; { procedure }\r
 301 \r
 302 (*********************************************************)\r
 303 \r
 304 var\r
 305    datos: TABLA;\r
 306    arch: text;\r
 307    dni: DOCUMENTO;\r
 308    i, n: integer;\r
 309 \r
 310 begin\r
 311      randomize;\r
 312 \r
 313      n := 1000;\r
 314      assign( arch, 'DATOS.TXT' );\r
 315      rewrite( arch );\r
 316      readln( n );\r
 317      GetInvOrdApellidos( arch, n );\r
 318      close( arch );\r
 319 end.