StartprogrammingusingObjectPascal:NewsDatabaseApplication

From 흡혈양파의 번역工房
Jump to: navigation, search

뉴스 데이터베이스 프로그램

이 예제에서는 뉴스 제목을 추가하고, 모든 뉴스를 표시하며, 검색하는 세 개의 프로시저와, 사용자가 실행하고자 하는 기능을 사용자에게 선택하도록 메뉴를 표시하는 하나의 함수가 있습니다.

Program news;

{$mode objfpc}{$H+}

uses
    {$IFDEF UNIX}{$IFDEF UseCThreads}
    cthreads,
    {$ENDIF}{$ENDIF}
    Classes, SysUtils
    { you can add units after this };

type
    TNews = record
        ATime: TDateTime;
        Title: string[100];
    end;
procedure AddTitle;
var
    F: file of TNews;
    News: TNews;
begin
    AssignFile(F, 'news.dat');
    Write('Input current news title: ');
    Readln(News.Title);
    News.ATime:= Now;
    if FileExists('news.dat') then
    begin
        FileMode:= 2; // Read/Write
        Reset(F);
        Seek(F, System.FileSize(F)); // Go to last record to append
    end
    else
        Rewrite(F);
    Write(F, News);
    CloseFile(F);
end;

procedure ReadAllNews;
var
    F: file of TNews;
    News: TNews;
begin
    AssignFile(F, 'news.dat');
    if FileExists('news.dat') then
    begin
        Reset(F);
        while not Eof(F) do
        begin
            Read(F, News);
            Writeln('------------------------------');
            Writeln('Title: ', News.Title);
            Writeln('Time : ', DateTimeToStr(News.ATime));
        end;
    CloseFile(F);
    end
    else
        Writeln('Empty database');
end;

procedure Search;
var
    F: file of TNews;
    News: TNews;
    Keyword: string;
    Found: Boolean;
begin
    AssignFile(F, 'news.dat');
    Write('Input keyword to search for: ');
    Readln(Keyword);
    Found:= False;
    if FileExists('news.dat') then
    begin
    Reset(F);
    while not Eof(F) do
    begin
        Read(F, News);
        if Pos(LowerCase(Keyword), LowerCase(News.Title)) > 0 then
        begin
            Found:= True;
            Writeln('------------------------------');
            Writeln('Title: ', News.Title);
            Writeln('Time : ', DateTimeToStr(News.ATime));
        end;
    end;
    CloseFile(F);
    if not Found then
        Writeln(Keyword, ' Not found');
    end
    else
    Writeln('Empty database');
end;

function Menu: char;
begin
    Writeln;
    Writeln('...........News database..........');
    Writeln('1. Add news title');
    Writeln('2. Display all news');
    Writeln('3. Search');
    Writeln('x. Exit');
    Write('Please input a selection : ');
    Readln(Result);
end;

// Main application
var
    Selection: Char;
begin
    repeat
        Selection:= Menu;
        case Selection of
        '1': AddTitle;
        '2': ReadAllNews;
        '3': Search;
        end;
    until LowerCase(Selection) = 'x';
end.

이 프로그램은 알아보기 쉬우며 메인 섹션에는 작고 깔끔한 코드를 지니고 있습니다. 다른 부분에 영향을 주거나 수정하지 않고도 임의의 프로시저에 새로운 기능을 추가할 수 있습니다.