回 帖 发 新 帖 刷新版面

主题:[转帖]纯pascal写的一个学生信息管理程序

纯PASCAL语言写的一个学生信息管理,
主要基于文件操作,,,,在网上用PASCAL来写的很少,,所以本人出于爱好
用PASCAL来写一个,希望对有需要的朋友有点帮助吧.

{***********************************************************************}
{                                                                       }
{                 学生信息管理v1.0                                      }
{                                                                       }
{       开发平台:Delphi 7.0                                             }
{       开发者: zhan.z.r                                                }
{       开发时间: 2008-12-17                                            }
{       Copyright@ 2008                                                 }
{       联系方式: gdzhan@tom.com    QQ: 214880229                       }
{                                                                       }
{      说明: 本程序属个人兴趣爱好所编写,没有版权声明,可以自由复制     }
{            研究使用,但请您不要用于其它的商业用途,否则一切后果自     }
{            负,本人不承担任何责任.                                     }
{                                                                       }
{***********************************************************************}

program sysStudent;

{$APPTYPE CONSOLE}

uses
  SysUtils,windows;

Const
  MAXSTUDENT = 1000;           //容纳最多的学生人数,可自行增加本值
  filename = 'c:\student.dat'; //学生信息数据文件

//////////////////////////////////////////////////////////
//学生成绩结构定义
Type
  TGradeInfo = Record
    Chinese : Single;
    Math:Single;
    English:Single;

    ave:Single;
  end;

//////////////////////////////////////////////////////////
//学生个人信息结构定义
  TStudentInfo = Record
    Name:String[10];
    StuID:Integer;
    Sex: string[10];
    Old: 15..25;
    Phone:String[13];
    Address:String[50];
    School:String[50];

    Grade:TGradeInfo;
  end;
var
  pStuFile:FILE of TStudentInfo;           //学生信息类型文件

/////////////////////////////////////////////////////////////
//用户界面

Function MainMenu:Integer;
var
  select:Integer;
BEGIN
  Writeln('=========================================================');
  Writeln('                   学生信息管理v1.0                      ');
  Writeln('---------------------------------------------------------');
  Writeln('        -> [1]. 建立数据文件                             ');
  Writeln('        -> [2]. 添加学生信息                             ');
  Writeln('        -> [3]. 修改学生信息                             ');
  Writeln('        -> [4]. 删除学生信息                             ');
  Writeln('        -> [5]. 查找学生信息                             ');
  Writeln('        -> [6]. 显示所有学生信息                         ');
  Writeln('        -> [7]. 系统信息                                 ');
  Writeln('        -> [8]. 退出系统                                 ');
  Writeln('---------------------------------------------------------');
  Write('请选择: ');
  Readln(select);

  if not select in [1..8] then
  begin
    MainMenu := -1;
    exit;
  end;

  MainMenu := select;
END;

///////////////////////////////////////////////////////////
//返回所有数据记录
Function RecordCount:Integer;
var
  tmpStu:TStudentInfo;
  iCount:Integer;
BEGIN
  assign(pstufile,filename);
  ReSet(pStuFile);
  seek(pstufile,0);
  iCount := 0;
  while not eof(pStuFile) do
  begin
    Read(pstuFile,tmpstu);
    Inc(iCount);
  end;
  Close(pStuFile);
  RecordCount := iCount;
END;

/////////////////////////////////////////////////////////
//保存数据到文件中
Function SaveToFile(pStu:TStudentInfo):Boolean;
var
  iRecordCount:Integer;
BEGIN
  iRecordCount := RecordCount;
  if iRecordCount >= MAXSTUDENT then
  begin
    SaveToFile := False;
    exit;
  end;
  assign(pstufile,filename);
  reset(pstufile);
  Seek(pStuFile,iRecordCount);{ 指向文件尾 }
  Write(pstufile,pstu);
  Close(pStuFile);
  SaveToFile := True;
END;

////////////////////////////////////////////////////////////
//增加学生信息界面
procedure AddRecord;
var
  tmpStu:TStudentInfo;
  isNext:char;
BEGIN
  Writeln('                          学生信息录入                               ');
  Writeln('=====================================================================');
  while TRUE do
  begin
    Write('请输入学生的姓名: ');
    Readln(tmpStu.Name);
    Write('请输入学生的学号: ');
    Readln(tmpstu.stuid);
    Write('请输入学生的性别: ');
    Readln(tmpstu.sex);
    Write('请输入学生的年龄: ');
    readln(tmpstu.old);
    write('请输入学生的电话: ');
    readln(tmpstu.phone);
    write('请输入学生的所住地址: ');
    readln(tmpstu.address);
    write('请输入学生所在院校: ');
    readln(tmpstu.school);
    write('请输入该学生的语文成绩: ');
    readln(tmpstu.grade.chinese);
    write('请输入该学生的数学成绩: ');
    readln(tmpstu.grade.math);
    write('请输入该学生的英语成绩: ');
    readln(tmpstu.grade.english);
    tmpstu.Grade.ave := (tmpstu.Grade.Chinese + tmpstu.Grade.Math + tmpstu.Grade.English) / 3.0;
    if SaveToFile(tmpstu) then
    begin
      Write('是否继续输入下一个学生信息!_Y/N:');
      readln(isNext);
      if isNext in ['Y','y'] then
        continue
      else
        exit;
    end else
    begin
      write('保存数据失败,请确认记录已满!');
      readln;
      exit;
    end;
  end;
END;

//////////////////////////////////////////////////
//按姓名查找记录
Function FindRecordByName(tmpName:String;var tmpstu:TStudentInfo):Integer;
var
  icount:Integer;
BEGIN
  iCount := 0;
  FindRecordByName := iCount;

  Assign(pStuFile,FileName);
  Reset(pstufile);
  Seek(pStuFile,0);

  while not eof(pstufile) do
  begin
    Read(pStuFile,tmpstu);
    inc(iCount);
    if tmpstu.Name = tmpName then
    begin
      FindRecordByName := iCount;
      close(pstufile);
      exit;
    end;
  end;
  Close(pstufile);
END;

//////////////////////////////////////////////////////////////
//找查并显示
procedure FindRecord;
var
  Name:String[10];
  stu:TStudentInfo;
BEGIN
  if RecordCount = 0 then
  begin
    Write('当前没有可用的学生信息!');
    readln;
    exit;
  end;

  Write('请输入要查找的学生姓名: ');
  readln(Name);
  if FindRecordByName(name,stu) > 0 then
  begin
    writeln('           以下是搜索到[ ',Name,' ]的相关信息!');
    writeln('----------------------------------------------');
    writeln('姓名: ',stu.name);
    writeln('学号: ',stu.stuid);
    writeln('性别: ',stu.sex);
    writeln('年龄: ',stu.old);
    writeln('电话: ',stu.phone);
    writeln('地址: ',stu.address);
    writeln('学校: ',stu.school);
    writeln('语文: ',stu.grade.chinese:0:2);
    writeln('数学: ',stu.grade.math:0:2);
    writeln('英语: ',stu.grade.english:0:2);
    writeln('平均分: ',stu.grade.ave:0:2);
    readln;
  end else
  begin
    writeln('                 搜索不到[ ',Name,' ]的相关信息!');
    Readln;
  end;
END;

////////////////////////////////////////////////////////////
//修改学生信息
procedure ModRecord;
var
  Name:String[10];
  tmpstu:TStudentInfo;
  iCount:Integer;
BEGIN
  write('请输入需修改的学生姓名: ');
  readln(Name);
  iCount := FindRecordByName(Name,tmpstu);
  if iCount <> 0 then
  begin
    tmpStu.Name := Name;
    Write('请输入学生的新学号: ');
    Readln(tmpstu.stuid);
    Write('请输入学生的新性别: ');
    Readln(tmpstu.sex);
    Write('请输入学生的新年龄: ');
    readln(tmpstu.old);
    write('请输入学生的新电话: ');
    readln(tmpstu.phone);
    write('请输入学生的新所住地址: ');
    readln(tmpstu.address);
    write('请输入学生新所在学校: ');
    readln(tmpstu.school);
    write('请输入该学生的新语文成绩: ');
    readln(tmpstu.grade.chinese);
    write('请输入该学生的新数学成绩: ');
    readln(tmpstu.grade.math);
    write('请输入该学生的新英语成绩: ');
    readln(tmpstu.grade.english);
    tmpstu.Grade.ave := (tmpstu.Grade.Chinese + tmpstu.Grade.Math + tmpstu.Grade.English) / 3.0;

    Assign(pStuFile,FileName);
    reset(pstufile);
    seek(pstufile,icount - 1);
    Write(pStuFile,tmpstu);
    write('修改成功!');
  end else
  begin
    Write('没有该学生的信息!');
  end;
  readln;
END;
/////////////////////////////////////////////////////////////
//删除学生信息
procedure DelRecord;
var
  iRecordCount,iIndex:Integer;
  Name: String;
  dyStu:array of TStudentInfo;
  tmpstu:TStudentInfo;
BEGIN
  Write('请输入要删除的学生姓名: ');
  Readln(Name);
  iRecordCount := FindRecordByName(Name,tmpstu);
  if iRecordCount = 0 then
  begin
    Write('没有此学生信息!');
    Readln;
    exit;
  end;

  iRecordCount := RecordCount;

  Assign(pstufile,FileName);
  reset(pstufile);
  SetLength(dystu,iRecordCount);
  iIndex := 0;
  While not Eof(pstufile) do
  begin
    Read(pstufile,dyStu[iIndex]);
    inc(iIndex);
  end;

  close(pstufile);
  assign(pstufile,FileName);
  ReWrite(pstufile);
  for iIndex := Low(dyStu) to high(dystu) do
  begin
    if dystu[iIndex].Name <> Name then
    begin
      Write(pstufile,dystu[iIndex]);
    end;
  end;

  close(pstufile);
  Write('此学生信息已成功删除!');
  readln;
END;

////////////////////////////////////////////////////////////
//建立数据文件
Procedure ConnectionToDataBase;
var
  ch:Char;
BEGIN
  Write('建立前请确认你是否已经建立了数据文件,否则会清空原有数据!真的要建立吗Y/N');
  readln(ch);
  if ch in ['Y','y'] then
  begin
    Assign(pStuFile,FileName);
    reWrite(pStuFile,FileName);
    Close(pStuFile);
  end;
END;

回复列表 (共2个回复)

沙发


//////////////////////////////////////////////////////////////////////////
//显示所有学生信息
procedure ViewRecord;
var
  tmpstu:TStudentInfo;
begin
  Assign(pStuFile,FileName);
  reset(pstufile);
  Seek(pstufile,0);
  while not eof(pstufile) do
  begin
    Read(pStuFile,tmpstu);
    writeln('----------------------------------------------');
    writeln('---------所有学生信息以下---------------------');
    Writeln('姓名: ',tmpstu.name);
    writeln('学号: ',tmpstu.stuid);
    writeln('性别: ',tmpstu.sex);
    writeln('年龄: ',tmpstu.old);
    writeln('电话: ',tmpstu.phone);
    writeln('地址: ',tmpstu.address);
    writeln('学校: ',tmpstu.school);
    writeln('语文成绩: ',tmpstu.grade.chinese:0:2);
    writeln('数不成绩: ',tmpstu.grade.math:0:2);
    writeln('英语成绩: ',tmpstu.grade.english:0:2);
    writeln('平均分: ',tmpstu.grade.ave:0:2);
    writeln('--------------------------------------------');
  end;
  Writeln('信息已显示完!');
  readln;
END;

////////////////////////////////////////////////////////////
//系统信息
procedure sysinfo;
BEGIN
  writeln('================================================');
  writeln('          学生信息管理v1.0                      ');
  writeln('   Copyright@ 2008                              ');
  writeln('   程序作者:zhan.z.r                            ');
  writeln('   编写时间: 2008-12-17                         ');
  writeln('   联系方式: gdzhan@tom.com   QQ:214880229      ');
  writeln('说明: 本程序没有版权,可自由复制研究使用        ');
  writeln('------------------------------------------------');
  readln;
END;

////////////////////////////////////////////////////////////
//退出系统
procedure OutSys;
var
  isOut:char;
BEGIN
  Write('真的要退出系统吗? Y/N: ');
  Readln(isOut);
  if isOut in ['y','Y'] then
  begin
    Halt;
  end else
  begin
    Exit;
  end;
END;

////////////////////////////////////////////////////////////
//操作导航
procedure GotoOption;
BEGIN

  while true do
  begin
    case MainMenu of
      1:          ConnectionToDataBase;
      2:          AddRecord;
      3:          ModRecord;
      4:          DelRecord;
      5:          FindRecord;
      6:          ViewRecord;
      7:          SysInfo;
      8:          OutSys;
    end;
  end;
END;

BEGIN
  //connectiontodatabase;
  GotoOption;
  readln;
END.

板凳

怎么看都不像在Delphi里面开发的.......

我来回复

您尚未登录,请登录后再回复。点此登录或注册