program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, Crt, sysutils
{ you can add units after this };
type
TData = packed record
ID : Integer;
Age : Byte;
Name : string[20];
Address : string[30];
end;
var
Data: array of TData;
const
DataFileName = 'MyData.dat';
function ReadLnInteger(ValMin, ValMax: Integer): Integer;
var
UserInput : Integer;
S : string;
Valid : Boolean;
begin
repeat
Valid := True;
ReadLn(S);
if not(TryStrToInt(S, UserInput)) then
Valid := False;
if (UserInput < ValMin) or (UserInput > ValMax) then
Valid := False;
if not(Valid) then
WriteLn('Please provide a valid value (' + ValMin.ToString + ' - ' +
ValMax.ToString + '):');
until Valid;
Result := UserInput;
end;
function ReadLnString(MaxLength: Integer): string;
var
S : string;
Valid : Boolean;
begin
repeat
Valid := True;
ReadLn(S);
if (S = '') or (Length(S) > MaxLength) then
Valid := False;
if not(Valid) then
begin
WriteLn('Maximum ' + MaxLength.ToString + ', empty input is not allowed.');
WriteLn('Please provide a valid input:');
end;
until Valid;
Result := S;
end;
procedure WriteScreen(S: string);
const
LineNo: Byte = 0;
begin
if S = 'clrscr' then
begin
LineNo := 0;
Exit;
end;
if LineNo <= 0 then
ClrScr;
WriteLn(S);
Inc(LineNo);
if LineNo > 22 then
begin
LineNo := 0;
ReadKey;
end;
end;
procedure ReadData;
var
DataFile : File of TData;
Index : Integer;
begin
SetLength(Data, 0);
if not(FileExists(DataFileName)) then
Exit;
AssignFile(DataFile, DataFileName);
Reset(DataFile);
Index := 0;
while not(EOF(DataFile)) do
begin
SetLength(Data, Index+1);
Read(DataFile, Data[Index]);
Inc(Index);
end;
CloseFile(DataFile);
end;
procedure SaveData;
var
DataFile : File of TData;
i : Integer;
begin
AssignFile(DataFile, DataFileName);
Rewrite(DataFile);
for i := 0 to High(Data) do
Write(DataFile, Data[i]);
CloseFile(DataFile);
end;
procedure MenuShow;
var
i: Integer;
begin
ClrScr;
if Length(Data) <= 0 then
begin
WriteLn('Nothing to show.');
ReadKey;
Exit;
end;
WriteScreen('clrscr');
WriteScreen('=== Data File : ' + DataFileName + ' === Total : ' +
Length(Data).ToString + ' record ===');
WriteScreen('');
for i := 0 to High(Data) do
begin
WriteScreen(' Record #' + (i+1).ToString);
WriteScreen(' ID : ' + Data[i].ID.ToString);
WriteScreen(' Age : ' + Data[i].Age.ToString);
WriteScreen(' Name : ' + Data[i].Name);
WriteScreen(' Address : ' + Data[i].Address);
WriteScreen('');
end;
WriteScreen('Press any key to go to the main menu ...');
ReadKey;
end;
procedure MenuAdd;
var
CurrentData : TData;
C : Char;
begin
ClrScr;
Write('ID = ');
CurrentData.ID := ReadLnInteger(0, 9999);
Write('Age = ');
CurrentData.Age := ReadLnInteger(0, 150);
Write('Name = ');
CurrentData.Name := ReadLnString(SizeOf(CurrentData.Name));
Write('Address = ');
CurrentData.Address := ReadLnString(SizeOf(CurrentData.Address));
ClrScr;
WriteLn('ID : ' + CurrentData.ID.ToString);
WriteLn('Age : ' + CurrentData.Age.ToString);
WriteLn('Name : ' + CurrentData.Name);
WriteLn('Address : ' + CurrentData.Address);
WriteLn;
WriteLn('Save the data? [y/n]');
repeat
C := ReadKey;
case C of
'n', 'N' : Exit;
'y', 'Y' :
begin
SetLength(Data, Length(Data)+1);
Data[High(Data)] := CurrentData;
SaveData;
Exit;
end;
end;
until False;
end;
procedure MenuDelete;
var
RecordNo : Integer;
C : Char;
i : Integer;
begin
ClrScr;
if Length(Data) <= 0 then
begin
WriteLn('Nothing to delete.');
ReadKey;
Exit;
end;
WriteLn('Please provide the record no of the data you want to delete:');
RecordNo := ReadLnInteger(1, Length(Data));
WriteLn;
WriteLn(' Record #' + (RecordNo).ToString);
WriteLn(' ID : ' + Data[RecordNo-1].ID.ToString);
WriteLn(' Age : ' + Data[RecordNo-1].Age.ToString);
WriteLn(' Name : ' + Data[RecordNo-1].Name);
WriteLn(' Address : ' + Data[RecordNo-1].Address);
WriteLn;
WriteLn('Delete the data? [y/n]');
repeat
C := ReadKey;
case C of
'n', 'N' : Exit;
'y', 'Y' :
begin
for i := 1 to High(Data) do
if i >= RecordNo then
Data[i-1] := Data[i];
SetLength(Data, Length(Data)-1);
SaveData;
Exit;
end;
end;
until False;
end;
procedure MenuMain;
var
Selected: Char;
begin
repeat
ClrScr;
WriteLn('Welcome to the Pascal Binary File Demo');
WriteLn;
WriteLn('Main Menu:');
WriteLn('1 - Show data');
WriteLn('2 - Add data');
WriteLn('3 - Delete data');
WriteLn('x - Exit');
WriteLn;
Selected := ReadKey;
case Selected of
'1': MenuShow;
'2': MenuAdd;
'3': MenuDelete;
'x', #27: Exit;
end;
until False;
end;
begin
ReadData;
MenuMain;
ClrScr;
end.
Poll
Recent
