Pascal Telefon Ajanda Programı

Program AJANDA;
Uses CRT;
Type
Kayit=Record
KAYITNOtring[8];
ADSOYADtring[20];
TELtring[10];
ADREString[100];F:Char;
End;
Var
Dosya:File Of Kayit;
Kay:Kayit;
Tus:Char;
T:Boolean;
I,Kod,M:Integer;

Procedure CERCEVE(X1,Y1,X2,Y2:Byte);
Var
I:Integer;
Cizgitring[80];
Begin
Fillchar(Cizgi,X2-X1,#196);
Cizgi[0]:=Chr(X2-X1-1);
Gotoxy(X1,Y1);Write(Chr(218),Cizgi,Chr(191));
For I:=Y1+1 To Y2-1 Do
Begin
Gotoxy(X1,I);Write(Chr(179));
Gotoxy(X2,I);Write(Chr(179));
End;
Gotoxy(X1,Y2);Write(Chr(192),Cizgi,Chr(217));
End;







procedure dos;
var
sifTring;
begin
clrscr;
Cerceve(10,5,70,20);gotoxy(12,9);Writeln('Dosyay� Yeniden Olusturursan�z Kay�tlar Silinecek[ENTER] ');
gotoxy(12,12); WRite('Sifreyi Girin...:');Readln(sif);
IF Sif='123456' Then
begin
assign(dosya,'AJANDA.dat');
rewrite(dosya);
close(dosya);
Gotoxy(12,15); WRite('S�fre Dogru Dosyan�z Yeniden Olusturuldu.');
tus:=readkey;
exit;
end;
gotoxy(12,15);WRite('Sifre Yanl�s');
tus:=readkey;
end;

Procedure KAYITYAP;
Begin
Assign(Dosya,'AJANDA.Dat');
Reset(Dosya);
Repeat
Clrscr;
Cerceve(10,5,70,20);
Gotoxy(15,7);Write('SIRA NO...:');Readln(Kay.KAYITNO);
If Kay.KAYITNO='' Then
Begin
Close(Dosya);Exit;
End;
Gotoxy(15,9);Write('ADI/SOYADI....:');Readln(Kay.A DSOYAD);
Gotoxy(15,11);Write('TELEFON NUM......:');Readln(Kay.TEL);
Gotoxy(15,13);Write('ADRES......:');Readln(Kay.ADR ES);
Cerceve(10,21,70,23);Gotoxy(11,22);
write('Bilgi Dosyaya yaz�ls�n m�? [E/H] ');
Repeat
Tus:=Upcase(Readkey);
Until Tus In ['E','H',#27];
If Tus='E' Then
Begin Kay.F:='*';
Seek(Dosya,Filesize(Dosya));
Write(Dosya,Kay);
Close(Dosya);
End
Else Tus:=Readkey;Exit;
Until 1=2;
End;

Procedure LISTELEME;
VAR
S:Integer;
Begin
Assign(Dosya,'AJANDA.Dat');
Reset(Dosya);
Clrscr;
S:=2;
For I:=0 To Filesize(Dosya)-1 Do
Begin
Seek(Dosya,I);Read(Dosya,Kay);
If Kay.F='*' Then
Begin
gotoxy(1,1);Writeln('SIRANO ADI/SOYADI TELEFON NUM ADRES');
gotoxy(1,2);Writeln('------ ----------- ------------- ------------------------------------------');
S:=S+1;
Gotoxy(2,S);Write(Kay.KAYITNO);
Gotoxy(10,S);Write(Kay.ADSOYAD);
Gotoxy(23,S);Write(Kay.TEL);
Gotoxy(40,S);Write(Kay.ADRES);
End;
If S>18 Then
Begin
Gotoxy(20,21);
Write('Diger sayfa i‡in bir tusa bas�n�z...');
Tus:=Readkey;
S:=1;
Clrscr;
End;
End;
Gotoxy(20,21);Write('Listelenecek Kayitlar bitti...');
Tus:=Readkey;
Close(Dosya);
End;


Procedure YAZ;
var
kalan,kod,mik,cikmik,KAYITNO:Word;
z,i:Word;
cev:Char;
Begin
Assign(Dosya,'AJANDA.Dat'); Reset(Dosya);
Clrscr;
Cerceve(5,3,75,18);
Gotoxy(10,5);Write('SIRA NO......:');Readln(KAYITNO);
For i:=0 to Filesize(Dosya)-1 Do
Begin
Seek(Dosya,i);
Read(Dosya,kay);
val(Kay.KAYITNO,Kod,Z);
if (KAYITNO=Kod) And (Kay.F='*') then
begin
Gotoxy(10,7);Write('ADI/SOYADI.......:',Kay.ADSOYA D);
Gotoxy(10,9);Write('TELEFON NUM.........:',Kay.TEL);
Gotoxy(10,11);Write('ADRES........:',Kay.ADRES);
Gotoxy(10,17);writeln('Aranilan kayit bu mu?');gotoxy(31,17);cev:=upcase(readkey);
if cev='E' Then
Begin
Val(Kay.ADRES,mik,z);
Kalan:=mik-cikmik;
Gotoxy(10,21);write('ADRES=',kalan);
Str(kalan,kay.ADRES);
Seek(dosya,i);
Write(dosya,kay);readkey;close(dosya);exit;
End;
End;
End;
If Cev<>'E' Then Begin
Gotoxy(10,21);Write('Kay�t Yok');End;
Close(Dosya);
readkey;
End;

Procedure DUZELTME;
VAR
ARAtring[30];
Begin
Assign(Dosya,'AJANDA.Dat');
Reset(Dosya);
Clrscr;
Cerceve(20,3,60,5);
Gotoxy(22,4);Write('D�zeltilecek SIRA NO..:');Readln(ARA);
For I:=0 To Filesize(Dosya)-1 Do
Begin
Seek(Dosya,I);Read(Dosya,Kay);
If (ARA=Kay.KAYITNO) And (Kay.F='*') Then
Begin
Clrscr;
Cerceve(10,5,70,19);
Gotoxy(15,7);Writeln('SIRANO......:',Kay.KAYITNO);
Gotoxy(15,9);Writeln('ADI/SOYADI.......:',Kay.ADSO YAD);
Gotoxy(15,11);Writeln('TELEFON NUM.........:',Kay.TEL);
Gotoxy(15,13);Writeln('ADRES........:',Kay.ADRES);
Cerceve(10,20,70,22);
Gotoxy(20,21);Write('D�zeltilecek Kay�t bu mu? [E/H] ');
Repeat
Tus:=Upcase(Readkey);
Until Tus In['E','H'];
If Tus='E' Then
Repeat
Clrscr;
Cerceve(10,3,70,19);
Gotoxy(15,5);Writeln('1-SIRANO.....:',Kay.KAYITNO);
Gotoxy(15,7);Writeln('2-ADI/SOYADI......:',Kay.ADSOYAD);
Gotoxy(15,9);Writeln('3-TELEFON NUM........:',Kay.TEL);
Gotoxy(15,11);Writeln('4-ADRES.......:',Kay.ADRES);
Gotoxy(15,17);Writeln('7-Islemi Tamamla...');
Cerceve(10,20,70,22);
Gotoxy(20,21);
Write('Se‡iminiz (1..7) ( ESC=iPTAL ) ...:');
Repeat
Tus:=Readkey;
Until Tus In['1'..'7',#27];
If Tus<>#27 Then Cerceve(10,23,70,25);
Case Tus Of
'1' :Begin
Gotoxy(15,24);
Write('SIRANO...:');Read(Kay.KAYITNO);
End;
'2' :Begin
Gotoxy(15,24);
Write('ADI/SOYADI...:');Read(Kay.ADSOYAD);
End;
'3' :Begin
Gotoxy(15,24);
Write('TELEFON NUM...:');Readln(Kay.TEL);
End;
'4' :Begin
Gotoxy(15,24);
Write('ADRES...:');Read(Kay.ADRES);
End;
#27 :Exit;
End;
Until 1=2;
End;
End;
Gotoxy(20,20);Write('Kay�t yok...!');
Close(Dosya);
Tus:=Readkey;
End;

Procedure SILME;
VAR
ARAtring[30];
Begin
Assign(Dosya,'AJANDA.Dat');
Reset(Dosya);
Clrscr;
Cerceve(10,3,70,5);
Gotoxy(15,4);Write('Silinecek TEL NO Kodu...:');Readln(ARA);
For I:=0 To Filesize(Dosya)-1 Do
Begin
Seek(Dosya,I);Read(Dosya,Kay);
If (ARA=Kay.KAYITNO) And (Kay.F='*') Then
Begin
Clrscr;
Cerceve(10,3,70,17);
Gotoxy(15,5);Writeln('SIRANO ........:',Kay.KAYITNO);
Gotoxy(15,7);Writeln('ADI/SOYADI .........:',Kay.ADSOYAD);
Gotoxy(15,9);Writeln('TELEFON NUM ...........:',Kay.TEL);
Gotoxy(15,11);Writeln('ADRES ..........:',Kay.ADRES);
Cerceve(10,18,70,20);Gotoxy(25,19);
Write('Silinecek Kayit bu mu?[E/H]');
Repeat
Tus:=Upcase(Readkey);
Until Tus In ['E','H'];
If Tus='E' Then
Begin
Kay.F:='S';
Seek(Dosya,I);Write(Dosya,Kay);
Gotoxy(25,22);Write('Kayit silindi....');
Close(Dosya);
Tus:=Readkey;
Exit;
End;
End;
End;
Gotoxy(20,20);Write('Kayit yok...');
Close(Dosya);
Tus:=Readkey;
End;

Procedure ILK_EKRAN;
var
a,c:string;
b,i:integer;
Begin
Clrscr;
Cerceve(1,1,80,24);
Cerceve(3,2,78,4);gotoxy(31,6);write('AJANDA PROGRAMI V.S.1.0');
textcolor(4);gotoxy(5,8);write('Adana/Y�re§ir');
textcolor(4);gotoxy(5,10);write('i.m.k.b');
textcolor(4);gotoxy(4,12);write('end�stri.mes.lis' );
textcolor(4);gotoxy(6,14);write('BILGISAYAR ');
textcolor(4);gotoxy(8,16);write('B™LšMš');
textcolor(4);gotoxy(63,8);write('Hidayet Y�lmaz');
textcolor(4);gotoxy(63,10);write('T�rker Erdevir');
textcolor(4);gotoxy(63,12);write('Veli �amaral');
textcolor(4);gotoxy(64,14);write('Musa');
textcolor(1);
Cerceve(3,5,20,20);
Cerceve(22,5,60,7);
Cerceve(22,8,60,23);
Cerceve(62,5,78,20);
Cerceve(3,21,20,23);
Cerceve(62,21,78,23);
textcolor(19);highvideo;
gotoxy(32,3);write('TEL AJANDA PROGRAMI');
End;
Begin
M:=0;
textcolor(15);highvideo;
textbackground(8);
clrscr;
Repeat
ILK_EKRAN;
textcolor(4);Gotoxy(30,9);Write('0_DOSYA OLUSTUR ');
textcolor(4);Gotoxy(30,11);Write('1- K˜�˜ BILGI GIRISI ');
textcolor(4);Gotoxy(30,13);Write('2- K˜�˜ LISTESI ');
textcolor(4);Gotoxy(30,15);Write('3- K˜�˜ DšZELTME ');
textcolor(4);Gotoxy(30,17);Write('4- K˜�˜ SIL ');
textcolor(14);Gotoxy(30,24);Write('[5]-CIKIS--[ESC]-CIKIS');
textcolor(4);Gotoxy(28,21);Write(' SECIMINIZ [1..5]...:');
Repeat
Tus:=Readkey;
Until Tus In ['0'..'6',#27];
Case Tus Of
'0' :dos;
'1' :KAYITYAP;
'2' :LISTELEME;
'3' UZELTME;
'4' :SILME;
'5' :Begin Clrscr;Halt;End;
#27 :Begin Clrscr;Halt;End;
End;
Until 1=2;
End.