Pascal/Turbo Pascal - AYUDA ARCHIVOS

   
Vista:

AYUDA ARCHIVOS

Publicado por Juancito (20 intervenciones) el 19/08/2013 19:51:37
Alguna ayuda para ordenar un archivo utilizando el metodo de burbujeo? Que funcione con cualquier tipo de archivos o al menos con un archivo de registros. Gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

AYUDA ARCHIVOS

Publicado por ramon (2072 intervenciones) el 02/09/2013 12:08:11
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
{Mira esto te Ayudara }
 
program ordenarchi;
 uses
    crt;
  type
    archivo = record
           nombre : string[50];
           telefo : longint;
           ciudad : string[100];
         end;
   const
      archi = 'c:\tp\bin\miprueva.rek';
 
   var
     f : file of archivo;
     dato : archivo;
 
  procedure cargadatos_a_archivo(nom : string);
  var
    tkl : char;
  begin
    repeat
      clrscr;
      write('   Entre Nombre   : ');
      readln(dato.nombre);
      write('   Entre Telefono : ');
      readln(dato.telefo);
      write('   Entre Ciudad   : ');
      readln(dato.ciudad);
      assign(f,archi);
   {$I-} reset(f); {$I+}
   if ioresult <> 0 then
   begin
       rewrite(f);
       seek(f,0);
       write(f,dato);
       close(f);
   end
 else
    begin
       seek(f,filesize(f));
       write(f,dato);
       close(f);
    end;
    writeln;
    writeln('    Desea Entrar Mas Datos [S/N]');
   repeat
       tkl := upcase(readkey);
   until tkl in['S','N'];
   until tkl = 'N';
  end;
 
  procedure ver_archivos;
  var
     ar : longint;
  begin
      assign(f,archi);
   {$I-} reset(f); {$I+}
   if ioresult <> 0 then
   begin
      writeln('  El Archivo No Existe o Esta Da¤ado Pulse Una Tecla');
      readkey;
      exit;
   end
  else
     begin
        clrscr;
        ar := 0;
        repeat
            seek(f,ar);
            read(f,dato);
            writeln(dato.nombre,'   ',dato.telefo,'    ',dato.ciudad);
            ar := ar + 1;
        until ar > filesize(f) - 1;
        writeln('   Fin De Datos Pulse Una Tecla');
        readkey;
        close(f);
     end;
  end;
 
  procedure intercambio(var d, b : archivo);
   var
     temp : archivo;
   begin
      temp := d;
      d := b;
      b := temp;
   end;
 
  procedure ordenacion_burbuja;
  var
   longt, i, j : longint;
   da, ja : archivo;
 begin
    assign(f,archi);
  {$I-} reset(f); {$I+}
  if ioresult = 0 then
  begin
    longt := filesize(f) - 1;
   for i := 0 to longt do
   begin
      seek(f,i);
      read(f,da);
     for j := longt downto i + 1 do
     begin
       seek(f, j);
       read(f, ja);
       if da.nombre > ja.nombre then
       begin
       Intercambio(da,ja);
       seek(f,i);
       write(f,da);
       seek(f,j);
       write(f,ja);
       end;
     end;
    end;
     close(f);
    end;
  end;
 
  procedure menu;
  var
    tecla : char;
    fin : boolean;
  begin
      fin := false;
    repeat
        clrscr;
        writeln('***** Menu Jeneral *****');
        writeln;
        writeln('   1 = Entrada De Datos');
        writeln('   2 = Ver Datos Guardados');
        writeln('   3 = Ordenar Archivo Por Nombre');
        writeln('   4 = Salir');
        writeln;
        writeln('<<<<< Elija Opcion >>>>>>');
        repeat
            tecla := readkey;
        until tecla in['1','2','3','4'];
        clrscr;
   case tecla of
 '1' : cargadatos_a_archivo(archi);
 '2' : ver_archivos;
 '3' : ordenacion_burbuja;
 '4' : fin := true;
   end;
   until fin = true;
 end;
 
  begin
      menu;
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar