saludos Erick:
perdon por la parrafada , espero que te sea util ;
las unidades constan de
- cabecera
- interfaz
- implementation
- inicializacion
unit mi_uni ;
{la cabecera: Usando unit en vez de program el Compilador genera .TPU en vez de .exe }
interface;
{ seccion INTERFACE parte publica , aqui se declaran constantes ,variables...
... y procedimientos y funciones pero solo la cabecera sin el código. la cabecera
comleta (procedimientos y funciones) se deben poner en la seccion implementation.}
{ se pueden definir tambien cabeceras de proc. y func. externas al programa definidos
en ensamblador por ejemplo ,en este caso no se definen en la seccion implementacion
quedando el codigo invisible a nuestros ojos
implementation
uses i,j,k; { tambien se puede usar uses dentro de interface }
{ esta seccion se usa "como un programa normal" pero local a si mismo es decir lo
anterior seria la parte global o externa y esto la parte inerna , aqui
se definen
los procedimientos y funciones internos que ya se definieron en la seccion interface
pero con cabecera y codigo ompletamente }
begin
{ igual que un programa normal begin...end pero se usa solo para inicializar la unidad o algunas
variables , o algun procedimiento , el resto se deberia manejar desde el programa que usa la
unidad si no hay variables o funciones se puede quitar el begin}
end.
------------------------------------------------------------------------------------------------
___________ programa de ejemplo _________________________
uses crt, u_varios;
var cadena:string;
a:byte;
begin
cadena:='hola mundo aqui Pascal DOS totalmente operativo';
clrscr;
trozear_frase(cadena);
for a:=1 to contador_de_palabras do
begin
sonido;
writeln( trozos_de_cadenas[a] );
end;
readln;
end.
____________ fin del programa _______________________________
____________ ej de unidad __________________________________
guardar fichero como u_varios.pas (lo mismo que en unit)
______________________________________________________________
UNIT U_VARIOS;
INTERFACE { DECLARACIONES PUBLICAS }
VAR
trozos_de_cadenas:array[1..40] of string[30];{usado por trocear frase}
contador_de_palabras:byte; {usado por trocear frase}
procedure color_normal;
procedure sonido;
procedure trozear_frase(cadena:string);
procedure analiza_una_a_una;
function existe(nombre:string):boolean;
procedure analiza(nombre_de_archivo:string);
IMPLEMENTATION { DECLARACIONES PRIVADAS }
uses crt,dos;
procedure color_normal;
begin
textcolor(7);
textbackground(0);
end;
procedure sonido;
begin
sound(300);
delay(1000);
nosound;
end;
procedure trozear_frase(cadena:string);
{* guarda por separado todas las palabras de una frase * }
{ entrada:una cadena de texto }
{ salida: }
{ þ en trozos_de_cadenas[1] se encuentra la primera palabra }
{ þ en contador_de_palabras se encuentra el numero total de palabras }
var c1:string;
begin
c1:=cadena+' '; {hacemos una copia de la cadena}
contador_de_palabras:=0;
while length(c1)>1 do
begin
inc(contador_de_palabras);
trozos_de_cadenas[contador_de_palabras]:=copy(c1,1,pos(' ',c1)-1 );
{writeln(pos(' ',c1));}
delete(c1,1,pos(' ',c1));
{write((trozos_de_cadenas[contador_de_palabras]),' ');}
end;
{write(contador_de_palabras);}
end;
procedure analiza_una_a_una;
{ usado por analiza }
var a:integer;
longitud:integer;
temporal:string;
begin
for a:=1 to contador_de_palabras do
begin
longitud:=length(trozos_de_cadenas[a]);
{ si una palabra termina en , . ; : entonces ... }
if (trozos_de_cadenas[a][longitud]in[',','.',';',':']) then
begin
{sonido;}
{delay(1000);}
{ suprime el ultimo caracter de la cadena }
delete(trozos_de_cadenas[a],longitud,1);
end;
writeln(trozos_de_cadenas[a]);
end;
end;
{$f-}
function existe(nombre:string):boolean;
{ * ENTRADA:nombre del archivo como STRING
* SALIDA :TRUE si existe el archivo,sino FALSE
* FUNCION:comprueba si existe un archivo y devuelve la
expresion booleana correspondiente }
var fxper:file;
errorio:byte;
atributo_cero:word;
atributo_original:word;
begin
atributo_cero:=0;
{$i-}
errorio:=ioresult;
assign(fxper,nombre);
reset(fxper);
close(fxper);
errorio:=ioresult ;
{$i+}
{ MUY IMPORTANTE: gracias gracias gracias !!! }
{ ioresult da el mismo error para archivo no encontrado y para }
{ archivo de solo lectura deberemos quitar los atributos y }
{ comprobar que realmente no existe el archivo para dar por echo }
{ que realmente no existe el fichero cuando ioresul<>0 }
if errorio<>0 then begin
getfattr(fxper,atributo_original);
setfattr(fxper,atributo_cero);
{$i-}
assign(fxper,nombre);
reset(fxper);
close(fxper);
errorio:=ioresult ;
{$i+}
setfattr(fxper,atributo_original);
end;
if (errorio=0) and (nombre<>'')then existe:=true else existe:=false;
end;
{$f+}
{////////////////////////////////////////////////////////////////////////////}
procedure analiza(nombre_de_archivo:string);
var f:text;
linea:string;
begin
if (not existe(nombre_de_archivo)) then
begin
writeln('ERROR: NO SE ENCUENTRA -> ',nombre_de_archivo);
halt;
end;
assign(F,nombre_de_archivo);
reset(f);
while not eof(f) do
begin
readln(f,linea);
trozear_frase(linea);
analiza_una_a_una;
{write(linea,' ',contador_de_palabras);}
{readln;}
end;
close(f);
end;
BEGIN
END.
______________________________________________________________
