标题: you have,I have(有关pascal) [打印本页] 作者: JoJo3001 时间: 2004-1-29 01:53 标题: you have,I have(有关pascal)
考试将至,故写下一些程序,供大家讨论,共同进步。预先祝大家顺利通过!
——————————————————————————————————————————
program hhh;
type
person=record
vorname:string;
name:string;
nummer:string;
studiengang;
end;
var
stud:file of person;
student:person;
i:integer;
stud1:text;
begin
assign(stud,'c:stud.dat');
rewrite(stud);
writeln('Geben Sie vorname,name,studiennummer und studiengang');
for i:=1 to 3 to do begin
with student do begin
readln(voname);
readln(name);
readln(studiengang);
write(stud,student);
end;
end;
close(stud);
reset(stud);
writeln('jetzt lesen:');
while not eof(stud) do begin
read(stud,student);
with student do begin
write(vorname,name,nummer,studiengang);
end;
end;
close(stud);
assign(stud1,'c:s.txt');
rewrite(stud1);
reset(stud);
while not eof(stud) do begin
read(stud,student);
with(stud,student);
if studiengang='mb' then begin
writeln('Wer ist im MB:');
writeln(stud1,vorname,' ',nummer);
end;
end;
close(stud);
close(stud1);
end.
这个程序就是alte klausur 上的第四题中的第二小题。
作用就是将输入学生资料,由file.stud复制到file.stud1,只是stud1要求是text型的,条件是studiengang是mb。作者: JoJo3001 时间: 2004-1-30 23:03 标题: weiter
program hhh;
uses crt;
var
h,n,x:real;
a,b,i:integer;
datname:string;
tabelle:text;
function y(x:real):real;
begin
if x<=0 then y:=exp(sqrt(sqr(x)+1)) {本来用的是:if......then begin......end;if ........then begin........end;........汉!}
else if x<0.5 and x>0 then y:=sqr(x)*sqr(x)*x*ln(x)/(x-1)
else y:=cos(sqrt(x+sqr(sin(x))));
end;
procedure Ptab;
begin
writeln('Geben Sie a,b,h(bitte achten : a<b und h ist shcritweite)');
readln(a,b,h);
n:=(b-a)/h;
writeln('n ist :',n);
writeln('Geben Sie Dateiname :',datname); readln(datname);
assign(tabelle,datname);
rewrite(tabelle);
x:=a;
writeln(x,y(x));
writeln(tabelle,'X-Werte':10,'Funktion-Ewrte':30);
writeln(tabelle,'----------------':10,'---------------------------------':29);
for i:=1 to trunc(n) do begin
x:=x+(i-1)*h;
writeln(tabelle,x,' ,,,,',y(x):20);
end;
close(tabelle);
end;
begin
clrscr; {--Hauptprogramm--}
Ptab;
readln;
end.
......
type matrix=array[1..20,1..20] of real;
......
function sum(var matrix_1,matrix_2:matrix):matrix;
begin
for i:=1 to 20 do
for j:=1 to 20 do
if i<>j then sum[i,j]:=matrix_1[i,j]+matrix_2[i,j];
end;
procedure ex;
begin
writeln('Geben Sie dateiname :'); readln(dateiname);
{$I-}reset(dateiname);{$I+}
io:=IOResult;
if io:=0 then writeln(dateiname,' existieren! ')
else writeln(dateiname,' existieren nicht!');
readln;
end;
begin
reset(gaste); {gaste:filevar.}
while not eof(gaste) do begin
read(gaste,person1); {person1 : var. of person见题}
with person1 do begin
writeln(Familiename:5,Vorname:10,GebDat:15);
writeln('Drueken Sie enter! Und naechste ist :');
readln;
end; {with}
end; {while}
close(gaste);
end.
begin
assign(freibier,'A:FREIBIER.DAT'); {freibier :filevar.}
reset(gaste);
rewrite(freibier);
Anzahl:=1;
while not eof(gaste) do begin
read(gaste,person1);
with person1 do begin
if GebDat='13.02' then begin
write(freibier,Familiename,Vorname);
Anzahl:=Anzahl+1;
end; {if}
end; {with}
end; {while}
writeln('Anzahl :',Anzahl);
readln;
close(gaste); close(freibier);
end.