تبلیغات
برنامه نویسی با پاسکال - دفترچه تلفن

ارائه سورس کد ها و پروژه های پاسکال تحت ویندوز!
صرفا جهت آموزش ، نه کپی برداری برای پروژه های دانشگاهی!

لطفا سورس کد های این وبلاگ را برای پرژه های دانشگاهی تون استفاده نکید ، واقعا هدف وبلاگ این نیست.
تمامی مسولیت کپی کردن و ارائه به استاد بر عهده شخص شماست نه نویسنده.

حسین

جستجو

 

دفترچه تلفن

جمعه 20 دی 1387   11:10 ب.ظ


نوع مطلب : سورس کدهای پاسکال ،آموزش برنامه نویسی با پاسکال ،

دانلود سورس :                                  دفترچه تلفن

دانلود فایل اجرایی :                            دفترچه تلفن

 

برای مشاهده سورس به ادامه مطلب بروید

 

{ Daftarche Telephone
Programming by :
                Hussein Tajarenezhad
E-mail :
        Tajarenezhad@Gmail.com
WebPage :
        PascalPrograms.MihanBlog.com  }

{HINT : File Ha Ra Dar C:\Telephone\  Copy Konid }

uses wincrt;

type
    Contact = record
            firstname,lastname : string[25];
            telephone : string[20];
            mobile : string[20];
            fax : string[20];
            Email : string[20];
            address : string[20];
    end;

var
   CF : File of Contact;
   C : Contact;
   temp1CF,temp2CF : file of contact;
  
   sc : byte;
procedure start;
          begin
               Writeln('DAFTARCE TELEPHONE ');
               writeln;
               writeln('Service Ha :');
               writeln;
               writeln('*  Afzudane Mokhatab   : 01');
               writeln('*  Hazf Mokhatab       : 02');
               writeln('*  Yaftane Mokhatab    : 03');
               writeln('*  Namayesh Mokhataban : 04');
               writeln('*  Rahandazi Mojadad   : 05');
               writeln;
               writeln('Shomare service ra vared konid :');
               readln(sc);
               clrscr;
              
              
          end;

procedure load;
          var
             i: longint;
             pre,k : integer;
          begin
               gotoxy(4,12);
               write('Loading . . . ');
               gotoxy(20,12);
               pre:=0;
               k:=20;
               for i:= 1 to 12500  do
                   begin
                        if i mod 250 = 0 then
                           begin
                                gotoxy(k,11);
                                write('*');
                                gotoxy(k,12);
                                write('*');
                                gotoxy(k,13);
                                write('*');
                                pre := pre+2;
                                k:=k+1;
                           end;
                        gotoxy(45,14);
                        write(pre);
                   end;
              
               Assign(CF,'C:\Telephone\CF.dbf');
               Assign(temp1CF,'C:\Telephone\temp1CF.dbf');
               Assign(temp2CF,'C:\Telephone\temp2CF.dbf');
              
               rewrite(temp1CF);
               reset(CF);
               while not eof(CF) do
                     begin
                          read(CF,C);
                          write(temp1CF,C);
                     end;
               close(CF);
               close(temp1CF);
                             
               clrscr;
               Start;

          end;


procedure add;
          var
             n,i : integer;
          begin
               writeln('Tedade Mokataban Ra vared konid :');
               readln(n);
               rewrite(temp2CF);
               for i:=1 to n do
                   begin
                        writeln('Nam :');
                        readln(C.firstname);
                        writeln('NameKhanevadegi :');
                        readln(C.lastname);
                        writeln('Telephone :');
                        readln(C.telephone);
                        writeln('Mobile :');
                        readln(C.mobile);
                        writeln('E-mail :');
                        readln(C.email);
                        writeln('Address :');
                        readln(C.address);
                        write(temp2CF,C);
                        writeln;
                        writeln('Press any key to continue :');
                        readln;
                        clrscr;
                   end;
               close(temp2CF);

               rewrite(CF);
               reset(temp1CF);
               while not eof(temp1CF) do
                     begin
                          read(temp1CF,C);
                          seek(CF,filesize(CF));
                          write(CF,C);
                     end;
               close(temp1CF);

               reset(temp2CF);
               while not eof(temp2CF) do
                     begin
                          read(temp2CF,C);
                          seek(CF,filesize(CF));
                          write(CF,C);
                     end;
               close(temp2CF);
               close(CF);

               load;
          end;


procedure delete;
          var
             mlnoc : string;
             Cindex : integer;
             flag : boolean;
          begin
               writeln;
               writeln('Name Khanevadegi Mokhatab Ra vared Koned :');
               readln(mlnoc);
               reset(CF);
               flag :=true;
               Cindex:=-1;
               while not eof(CF) and flag do
                     begin
                          read(CF,C);
                          Cindex:=Cindex+1;
                          if C.lastname = mlnoc then
                             begin
                                  writeln;
                                  writeln('Member Info :');
                                  flag :=false;
                                  write(' *  First Name : ');
                                  writeln(C.firstname);
                                  write(' *  Last Name : ');
                                  writeln(C.lastname);
                                  write(' *  Telephone : ');
                                  writeln(C.telephone);
                                  write(' *  Mobile : ');
                                  writeln(C.mobile);
                                  write(' *  E-mail : ');
                                  writeln(C.email);
                                  write(' *  Address : ');
                                  writeln(C.address);
                                 
                                 
                             end;
                     end;
               close(CF);
                             
               if flag = true then
                  begin
                       writeln('Mokhatab Yaft Nashod');
                       writeln;
                       writeln('For Continue Pree Any Key :');
                       readln;
                       clrscr;
                       start;
                  end;
               rewrite(CF);
               reset(temp1CF);
               while not eof (temp1CF) do
                     begin
                          if filepos(temp1CF)=Cindex then
                               begin
                                    seek(temp1CF,filepos(temp1CF)+1);
                               end;
                          read(temp1CF,C);
                          write(CF,C);
                     end;
               close(CF);
               close(temp1CF);

               writeln('For Continue Pree Any Key :');
               readln;
               clrscr;
               load;

          end;

         
procedure search;
          var
             mln : string[25];
             flag : boolean;
          begin
               writeln('SEARCH MEMBER BY LAST NAME ');
               writeln;
               writeln('Name Khanevadegi Mokhatab Ra vared Koned :');
               readln(mln);
               reset(CF);
               flag :=false;
               while not eof(CF) do
                     begin
                          read(CF,C);
                          if C.lastname = mln then
                             begin
                                  writeln;
                                  writeln('Member Info :');
                                  flag :=true;
                                  write(' *  First Name : ');
                                  writeln(C.firstname);
                                  write(' *  Last Name : ');
                                  writeln(C.lastname);
                                  write(' *  Telephone : ');
                                  writeln(C.telephone);
                                  write(' *  Mobile : ');
                                  writeln(C.mobile);
                                  write(' *  E-mail : ');
                                  writeln(C.email);
                                  write(' *  Address : ');
                                  writeln(C.address);
                             end;
                     end;
               close(CF);
               if flag = false then
                  writeln('Mokhatab Yaft Nashod');

               writeln;
               writeln('Pres any key to conyinue :');
               readln;
               clrscr;
               start;
          end;

procedure show;
          var
             index:integer;
          begin
                index:=5;
               reset(CF);
               writeln('                            * MOSHAKHASAT MOKHATABAN *');
               writeln('  *****************************************************************************');
               writeln('  *            Nam               *      Telephon      *         Mobile        *');
               writeln('  *****************************************************************************');
              
               while not eof(CF) do
                     begin
                         
                          read(CF,C);
                         
                          gotoxy(1,index);
                            write('  * ',C.firstname,' ',C.lastname);
                          gotoxy(32,index);
                            write('* ',C.telephone);
                          gotoxy(52,index);
                            write('* ',C.mobile);
                          gotoxy(79,index);
                          writeln('*');
                         
                          inc(index);
                     end;
               gotoxy(1,index);
               writeln('  *****************************************************************************');
               close(CF);

               writeln;
               writeln('For Continue Press Enter');
               readln;
               clrscr;
               start;
          end;{End of procedure show all Member}


procedure restart;
          begin
               rewrite(temp1CF);
               close(temp1CF);

               rewrite(temp2CF);
               close(temp2CF);

               rewrite(CF);
               close(CF);
                             
               writeln;
               writeln('SYSTEM RESTARTED !');
               writeln;
               writeln('Press any key to continue :');
               readln;
               clrscr;
               start;
          end;

begin
     load;
     while true do
           begin
                case sc of
                     1 : Add;
                     2 : delete;
                     3 : search;
                     4 : Show;
                     5 : restart;
                    
                end;
           end;
          
    
end.

{ Daftarche Telephone
Programming by :
                Hussein Tajarenezhad
E-mail :
        Tajarenezhad@Gmail.com
WebPage :
        PascalPrograms.MihanBlog.com  }


نوشته شده توسط : حسین