delphi 控制台输入输出实例代码

program Project1;

{$APPTYPE CONSOLE}

uses

SysUtils, Classes;

type

TFriend = record

name: string[10];

age : integer;

end;

PFriend = ^TFriend;

var

FriendList : TList;

FriendFileName: string;

//const

// LeftTop = '┛';

// LeftBottom = '┓';

// Level = '━';

// RightBottom = '┏';

// RightTop = '┗';

// Cross = '╋';

// Vertical = '┃';

// Right = '┣';

// Left = '┫';

// Bottom = '┳';

// Top = '┻';

procedure LoadFriendFrmFile();

procedure AddFriendItem(S: string);

var

strList: TStringList;

P: PFriend;

begin

if Length(s) < 0 then exit;

strList := TStringList.Create();

try

strList.Delimiter := '|';

strList.DelimitedText := S;

New(p);

P^.name := strList.Strings[0];

P^.age := strToIntDef(strList.Strings[1], -1);

FriendList.Add(P);

finally

strList.Free();

end;

var

F: TextFile;

S: string;

begin

if not FileExists(FriendFileName) then exit;

AssignFile(F, FriendFileName);

try

Reset(F);

while not Eof(F) do

begin

Readln(F, S);

AddFriendItem(S);

end;

finally

CloseFile(F);

end;

procedure SaveFriendToFile();

var

F: TextFile;

S: string;

I: integer;

P: PFriend;

begin

if not Assigned(FriendList) then exit;

if FriendList.Count <= 0 then

AssignFile(F, FriendFileName);

try

ReWrite(F);

for i := 0 to FriendList.Count - 1 do

begin

P := FriendList.Items[I];

S := P^.name + '|' + IntToStr(P^.age);

Writeln(s);

end;

finally

CloseFile(F);

end;

procedure Description();

begin

Writeln('┏━━━━━━━━━━━━━━┓');

Writeln('┃ 好友管理 ┃');

Writeln('┃============================┃');

Writeln('┃1.A/a 添加新的好友。 ┃');

Writeln('┃2.M/m 修改好友年龄信息。 ┃');

Writeln('┃3.D/d 通过好友姓名删除好友。┃');

Writeln('┃4.P/p 查看好友信息。 ┃');

Writeln('┃5.F/f 查找好友信息。 ┃');

Writeln('┃6.E/e 退出。 ┃');

Writeln('┗━━━━━━━━━━━━━━┛');

end;

function CheckStr(S: string): boolean;

var

i: integer;

const

FLAG = '!@#$%^&*()_+-=[]{},./<>?:"|;''\0123456789';

begin

Result := false;

for i := 1 to Length(FLAG) do

begin

if Pos(FLAG[i], S) > 0 then

begin

Result := true;

Writeln('输入的姓名不合法！');

break;

end;

function GetName(): string;

var

S: string;

begin

repeat

write('请输入姓名: ');

ReadLn(s);

until ((Length(s) <= 10) and (not CheckStr(s)));

Result := S;

end;

function GetAge(): integer;

var

S: string;

R: integer;

begin

R := -1;

while TRUE do

begin

write('请输入年龄: ');

ReadLn(S);

if ((not TryStrToInt(S, R)) and (R <= 0)) then

writeln('输入的年龄不合法')

else

break;

end;

Result := R;

end;

procedure AddFriend();

var

P: PFriend;

begin

New(p);

P^.name := GetName();

P^.age := GetAge();

FriendList.Add(P);

end;

function GetFriendFrmName(name: string): PFriend;

var

I: integer;

P: PFriend;

begin

Result := nil;

for I := 0 to FriendList.Count - 1 do

begin

P := FriendList.Items[I];

if P^.name = name then

begin

Result := P;

break;

end;

procedure ModifyFriend();

var

P: PFriend;

begin

P := GetFriendFrmName(GetName());

if Assigned(p) then

begin

P^.age := GetAge();

end

else

Writeln('好友不存在！');

end;

procedure DeleteFriend();

var

P: PFriend;

I: integer;

name: string;

B: boolean;

begin

name := GetName();

B := false;

for I := 0 to FriendList.Count - 1 do

begin

P := FriendList.Items[I];

if P^.name = name then

begin

Dispose(P);

FriendList.Delete(I);

B := true;

break;

end;

if B = false then

Writeln('好友不存在！');

end;

procedure PrintTitle();

begin

Writeln('┏━━━━━┳━━━━━┳━━━━━┓');

Writeln('┃index ┃Name ┃Age ┃');

end;

procedure PrintBottom();

begin

Writeln('┗━━━━━┻━━━━━┻━━━━━┛');

end;

procedure FindFriend();

var

P: PFriend;

S: string;

begin

P := GetFriendFrmName(GetName());

if Assigned(P) then

begin

PrintTitle();

Writeln('┣━━━━━╋━━━━━╋━━━━━┫');

Writeln(Format('┃%-10d┃%-10s┃%-10d┃', [1, P^.name, P^.age]));

PrintBottom();

end

else

Writeln('好友不存在！');

end;

procedure PrintFriend();

var

I: integer;

P: PFriend;

begin

if FriendList.Count > 0 then

begin

PrintTitle();

for I := 0 to FriendList.Count - 1 do

begin

P := FriendList.Items[I];

Writeln('┣━━━━━╋━━━━━╋━━━━━┫');

Writeln(Format('┃%-10d┃%-10s┃%-10d┃', [I + 1, P^.name, P^.age]));

end;

PrintBottom();

end;

procedure GetInput();

var

s: string;

begin

Description();

write('请输入命令: ');

Readln(s);

while true do

begin

s := LowerCase(s);

case s[1] of

'a':

begin

AddFriend();

end;

'm':

begin

ModifyFriend();

end;

'd':

begin

DeleteFriend();

end;

'p':

begin

PrintFriend();

end;

'f':

begin

FindFriend();

end;

'e':

begin

break;

end;

else

writeln('输入的命令不存在！');

end;

write('请输入命令: ');

Readln(s);

end;

procedure InitFriend();

begin

FriendList := TList.Create();

LoadFriendFrmFile();

end;

procedure FreeFriend();

var

P: PFriend;

I: integer;

begin

if FriendList.Count > 1 then

begin

repeat

I := FriendList.Count - 1;

P := FriendList.Items[I];

Dispose(p);

FriendList.Delete(I);

until FriendList.Count = 0;

end;

FreeAndNil(FriendList);

end;

begin

FriendFileName := ExtractFilePath(paramstr(0)) + 'friend.txt';

InitFriend();

GetInput();

FreeFriend();

end.

来源：https://www.cnblogs.com/qkhhxkj/archive/2013/01/02/2842439.html

推荐分享

delphi 控制台 输入输出实例代码

delphi 控制台输入输出实例代码