BASİT BİR ANKET DÜZENLEME PROGRAMI
Bu Program Siirt Teknik lise ve Endüstri Meslek lisesi Öğrencilerinden SELÇUK & YAŞAR tarafından hazırlanmıştır.uses crt;
label
sor,go1,go,bas;
var
sifre,isim:text;
tus,d,z:char;
b,c:byte;
a,u:array[1..5] of string;
e:string;
begin
clrscr;
bas:
clrscr;
gotoxy(30,5);write('1-Anket yap');
gotoxy(30,6);write('2-Cevap oku');
gotoxy(30,7);write('Esc-€kŸ');
gotoxy(30,9);write('Se‡iminiz...:');
tus:=readkey;
if tus=#27 then halt;
if tus='#13' then goto go;
if tus='2' then goto go1;
begin
u[1]:='Adnz ve Soyadnz:';
u[2]:='Do§um tarihiniz ve burcunuz:';
u[3]:='En Sevdi§iniz ArkadaŸnz:';
u[4]:='Sevgiliniz varm? varsa ad:';
u[5]:='AŸka inanrmsnz:';
end;
go:
Begin
clrscr;
write(u[1]);readln(a[1]);
write(u[2]);readln(a[2]);
write(u[3]);readln(a[3]);
write(u[4]);readln(a[4]);
write(u[5]);readln(a[5]);
clrscr;
Assign(isim,'Anket.f&c');
{$I-}Append(isim);b:=ioresult;{$I+}
if b<>0 then Rewrite(isim);
for c:=1 to 5 do
writeln(isim,u[c],a[c]);
close(isim);
goto bas;
end;
go1:
begin
clrscr;
assign(sifre,'Parola.f&c');
{$I-}Reset(sifre);b:=ioresult;{$I+}
if b<>0 then begin
write('ifre Koyunuz:');readln(e);
Rewrite(sifre);write(sifre,e);
close(sifre);
end;
Assign(sifre,'Parola.f&c');
reset(sifre);
read(sifre,e);
write('ifreyi giriniz:');readln(d);
if d<>e then halt;
if d=e then
begin
clrscr;
Assign(isim,'Anket.f&c');
Reset(isim);
while not SeekEof(isim) do
begin
if SeekEoln(isim) then
c:=c+1;
Read(isim,u[c],a[c]);
Writeln(u[c],a[c]);
readkey;
end;
close(isim);
goto bas;
end;
end;
end.
Bu Program Siirt Teknik lise ve Endüstri Meslek lisesi Öğrencilerinden SELÇUK & YAŞAR tarafından hazırlanmıştır.uses crt;
label
sor,go1,go,bas;
var
sifre,isim:text;
tus,d,z:char;
b,c:byte;
a,u:array[1..5] of string;
e:string;
begin
clrscr;
bas:
clrscr;
gotoxy(30,5);write('1-Anket yap');
gotoxy(30,6);write('2-Cevap oku');
gotoxy(30,7);write('Esc-€kŸ');
gotoxy(30,9);write('Se‡iminiz...:');
tus:=readkey;
if tus=#27 then halt;
if tus='#13' then goto go;
if tus='2' then goto go1;
begin
u[1]:='Adnz ve Soyadnz:';
u[2]:='Do§um tarihiniz ve burcunuz:';
u[3]:='En Sevdi§iniz ArkadaŸnz:';
u[4]:='Sevgiliniz varm? varsa ad:';
u[5]:='AŸka inanrmsnz:';
end;
go:
Begin
clrscr;
write(u[1]);readln(a[1]);
write(u[2]);readln(a[2]);
write(u[3]);readln(a[3]);
write(u[4]);readln(a[4]);
write(u[5]);readln(a[5]);
clrscr;
Assign(isim,'Anket.f&c');
{$I-}Append(isim);b:=ioresult;{$I+}
if b<>0 then Rewrite(isim);
for c:=1 to 5 do
writeln(isim,u[c],a[c]);
close(isim);
goto bas;
end;
go1:
begin
clrscr;
assign(sifre,'Parola.f&c');
{$I-}Reset(sifre);b:=ioresult;{$I+}
if b<>0 then begin
write('ifre Koyunuz:');readln(e);
Rewrite(sifre);write(sifre,e);
close(sifre);
end;
Assign(sifre,'Parola.f&c');
reset(sifre);
read(sifre,e);
write('ifreyi giriniz:');readln(d);
if d<>e then halt;
if d=e then
begin
clrscr;
Assign(isim,'Anket.f&c');
Reset(isim);
while not SeekEof(isim) do
begin
if SeekEoln(isim) then
c:=c+1;
Read(isim,u[c],a[c]);
Writeln(u[c],a[c]);
readkey;
end;
close(isim);
goto bas;
end;
end;
end.
