База водителей автобусов

  Secund : Byte;

End;

CoordinatesRecord=Record

  Country: String[20];

  City   : String[20];

  Street : String[20];

  HouseNumber    : Word;

  ApartmentNumber: Word;

End;

NameRecord=Record

  Name      : String[20];

  SurName   : String[30];

  SecondName: String[30];

End;

 

DataBaseRecord=Record

  Name           : NameRecord       ;

  Coordinates    : CoordinatesRecord;

  TelephoneNumber: String[30]       ;

  BirthDay       : Date;

  InternetAdres  : String[50];

  ElectronicMail : String[50];

  RecordDate     : Date;

End;

 

Var

DataBaseFileName       : String;

DataBaseFile           : File of DataBaseRecord;

DataBaseModified       : Boolean;

NumberOfDataBaseRecords: Word;

 

PointerToPointers: Pointer;

PointerToPointersArray: Array[0..1] of Word Absolute PointerToPointers;

 

Function MyVal(S: String): Integer;

Var

Code: Integer;

MV  : Integer;

Begin

Val(S,MV,Code);

IF Code<>0 Then MV:=0;

MyVal:=MV;

End;

 

Function MyStr(W: Word): String;

Var

S: String;

Begin

Str(W, S);

MyStr:=S;

End;

 

Function MyLen(S: String): Byte;

Begin

MyLen:=Ord(S[0]);

End;

 

Function MinWord(W1, W2: Word): Word;

Begin

IF W1<W2 Then MinWord:=W1 Else MinWord:=W2;

End;

 

Function MaxWord(W1, W2: Word): Word;

Begin

IF W1>W2 Then MaxWord:=W1 Else MaxWord:=W2;

End;

 

Function MinByte(B1, B2: Byte): Byte;

Begin

IF B1<B2 Then MinByte:=B1 Else MinByte:=B2;

End;

 

Function MaxByte(B1, B2: Byte): Byte;

Begin

IF B1>B2 Then MaxByte:=B1 Else MaxByte:=B2;

End;

 

Procedure OpenDataBaseFileForRead;

Begin

 

Assign(DataBaseFile, DataBaseFileName);

Reset(DataBaseFile);

IF IOResult<>0 Then Rewrite(DataBaseFile);

 

End;

 

Procedure OpenDataBaseFileForWrite;

Begin

Assign(DataBaseFile, DataBaseFileName);

ReWrite(DataBaseFile);

End;

 

Procedure CloseDataBaseFile;

Begin

Close(DataBaseFile);

End;

 

Function EndOfDataBaseFile: Boolean;

Begin

EndOfDataBaseFile:=EOF(DataBaseFile);

End;

 

Procedure WriteNumberToPointersArray(PointerNumber: Word; Number: Word);

Var

Segment: Word;

Begin

Segment:=PointerToPointersArray[1];

Asm

  Mov Es, Segment

  Mov Bx, PointerNumber

  Shl BX, 1

  Mov Ax, Number

  Mov ES:[BX], Ax

End;

End;

 

Procedure ReadNumberFromPointersArray(PointerNumber: Word; Var Number: Word);

Var

Segment: Word;

NumberTMP: Word;

Begin

Segment:=PointerToPointersArray[1];

Asm

  Mov Es, Segment

  Mov Bx, PointerNumber

  Shl Bx, 1

  Mov Ax, ES:[BX]

  Mov NumberTMP, Ax

End;

Number:=NumberTMP;

End;

 

Procedure NewRecord;

Var

PointerTMP: Pointer;

PointerTMPArray: Array[0..1] of Word Absolute PointerTMP;

Begin

GetMem(PointerTMP, SizeOf(DataBaseRecord));

INC(NumberOfDataBaseRecords);

WriteNumberToPointersArray(NumberOfDataBaseRecords, PointerTMPArray[1]);

End;

 

Procedure ScanDataBaseAndGetMemory;

Var

RecordTMP: DataBaseRecord;

NumTMP: Word;

N: Word;

Begin

NumberOfDataBaseRecords:=0;

NumTMP:=0;

OpenDataBaseFileForRead;

While EndOfDataBaseFile=False Do Begin

  INC(NumTMP);

  Read(DataBaseFile, RecordTMP);

End;

GetMem(PointerToPointers, (NumberOfDataBaseRecords+100) shl 2);

For N:=1 to NumTMP do NewRecord;

CloseDataBaseFile;

End;

 

Procedure WriteRecordIntoMemory(N: Word; RecordTMP:DataBaseRecord);

Var

Segment: Word;

RecordTMPTMP: DataBaseRecord;

RecordArray : Array[0..SizeOf(DataBaseRecord)] OF Byte Absolute RecordTMPTMP;

B: Word;

Begin

RecordTMPTMP:=RecordTMP;

ReadNumberFromPointersArray(N, Segment);

For B:=0 To SizeOf(DataBaseRecord) Do

  Mem[Segment: B]:=RecordArray[B];

DataBaseModified:=True;

End;

 

Procedure ReadRecordFromMemory(N: Word; Var RecordTMP:DataBaseRecord);

Var

Segment: Word;

RecordTMPTMP: DataBaseRecord;

RecordArray : Array[0..SizeOf(DataBaseRecord)] OF Byte Absolute RecordTMPTMP;

B: Word;

Begin

ReadNumberFromPointersArray(N, Segment);

For B:=0 To SizeOf(DataBaseRecord) Do

  RecordArray[B]:=Mem[Segment: B];

RecordTMP:=RecordTMPTMP;

End;

 

Procedure DeleteRecord(N: Word);

Var

PointerTMP: Pointer;

PointerTMPArray: Array[0..1] of Word Absolute PointerTMP;

RecordTMP: DataBaseRecord;

Segment: Word;

Begin

ReadRecordFromMemory(NumberOfDataBaseRecords, RecordTMP);

WriteRecordIntoMemory(N, RecordTMP);

ReadNumberFromPointersArray(NumberOfDataBaseRecords, Segment);

PointerTMPArray[1]:=Segment;

Dispose(PointerTMP);

WriteNumberToPointersArray(NumberOfDataBaseRecords, 0);

DEC(NumberOfDataBaseRecords);

End;

 

Procedure ReadInformationFromDataBaseFile;

Var

N: Word;

RecordTMP: DataBaseRecord;

Begin

ScanDataBaseAndGetMemory;

OpenDataBaseFileForRead;

For N:=1 to NumberOfDataBaseRecords Do Begin

  Read(DataBaseFile, RecordTMP);

  WriteRecordIntoMemory(N, RecordTMP);

End;

CloseDataBaseFile;

DataBaseModified:=False;

End;

 

Procedure WriteInformationToDataBaseFile;

Var

N: Word;

RecordTMP: DataBaseRecord;

Begin

OpenDataBaseFileForWrite;

For N:=1 to NumberOfDataBaseRecords Do Begin

  ReadRecordFromMemory(N, RecordTMP);

  Write(DataBaseFile, RecordTMP);

End;

CloseDataBaseFile;

DataBaseModified:=False;

End;

 

Function Yes_Or_No(Prompt : string) : Boolean;

Var Ch : char;

BEGIN

While True do Begin

  writeln(Prompt);

  Ch:=ReadKey;

  case Ch of

   'y','Y','Н','н' : Begin Yes_Or_No:=True;  EXIT; End;

   'n','N','Т','т' : Begin Yes_Or_No:=False; EXIT; End;

 

  end;

End;

END;

 

Procedure InputRecordFromKeyBoard(Var RecordTMP: DataBaseRecord);

Var

StrTMP: String;

Begin

ClrScr;

  WriteLN('Biografiya Voditelyaя:');

  Write('   Familiya voditelya : ') ;ReadLn(RecordTMP.Name.SurName   );

  Write('   Imya voditelya: ') ;ReadLn(RecordTMP.Name.Name      );

  Write('   Otchestvo voditelya: ') ;ReadLn(RecordTMP.Name.SecondName);

  WriteLN(':');

  Write('   Nomer Avtobusa: ') ;ReadLn(RecordTMP.Coordinates.Country        );

  Write('   Gorod         : ') ;ReadLn(RecordTMP.Coordinates.City           );

  Write('   Ulica         : ') ;ReadLn(RecordTMP.Coordinates.Street         );

  Write('   Nomer Doma    : ') ;ReadLn(StrTMP                               );

  RecordTMP.Coordinates.HouseNumber    :=MyVal(StrTmp);

  Write('   Nomer Kvartiri: ') ;ReadLn(StrTMP                               );

  RecordTMP.Coordinates.ApartmentNumber:=MyVal(StrTMP);

  WriteLN;

  Write('   Nomer Telefona: ') ;ReadLn(RecordTMP.TelephoneNumber);

  WriteLN(':');

  Write('   Dohod za God : ') ;ReadLn(StrTMP);

  RecordTMP.BirthDay.Year :=MyVal(StrTMP);

  Write('   Dohod za Mesyac: ') ;ReadLn(StrTMP);

  RecordTMP.BirthDay.Month:=MyVal(StrTMP);

  Write('   Dohod za Den: ') ;ReadLn(StrTMP);

  RecordTMP.BirthDay.Day  :=MyVal(StrTMP);

  {$I+}

End;

 

Procedure PrintRecordOnScreen(RecordTMP: DataBaseRecord);

Var

StrTMP: String;

Begin

ClrScr;

 

  WriteLN('Biografiya Voditelya:');

  Write('Familiya voditelya: ') ;WriteLN(RecordTMP.Name.SurName   );

  Write('  Imya voditelya: ') ;WriteLN(RecordTMP.Name.Name      );

  Write('  Otchestvo voditelya: ') ;WriteLN(RecordTMP.Name.SecondName);

  WriteLN(':');

  Write('   Nomer Avtobusa: ') ;WriteLN(RecordTMP.Coordinates.Country        );

  Write('   Gorod        : ') ;WriteLN(RecordTMP.Coordinates.City           );

  Write('   Ulica          : ') ;WriteLN(RecordTMP.Coordinates.Street         );

  StrTMP:=MyStr(RecordTMP.Coordinates.HouseNumber);

  Write('  Nomer Doma   : ') ;WriteLN(StrTMP                               );

  StrTMP:=MyStr(RecordTMP.Coordinates.ApartmentNumber);

  Write('  Nomer Kvartiri: ') ;WriteLN(StrTMP                               );

  WriteLN(':');

  Write('  Nomer Telefona: ') ;WriteLN(RecordTMP.TelephoneNumber);

  WriteLN(':');

  StrTMP:=MyStr(RecordTMP.BirthDay.Year );

  Write(' Dohod za God: ') ;WriteLn(StrTMP);

  StrTMP:=MyStr(RecordTMP.BirthDay.Month);

  Write(' Dohod za Mesyac: ') ;WriteLn(StrTMP);

  StrTMP:=MyStr(RecordTMP.BirthDay.Day  );

  Write('   Dohod za den: ') ;WriteLn(StrTMP);

  WriteLN('Zapis sdelana:');

  StrTMP:=MyStr(RecordTMP.RecordDate.Year   );

  Write('   God    : ') ;WriteLn(StrTMP);

  StrTMP:=MyStr(RecordTMP.RecordDate.Month  );

  Write('   Mesyac: ') ;WriteLn(StrTMP);

  StrTMP:=MyStr(RecordTMP.RecordDate.Day    );

  Write('   Den: ') ;WriteLn(StrTMP);

  StrTMP:=MyStr(RecordTMP.RecordDate.Hours  );

  Write('   chasi   : ') ;WriteLn(StrTMP);

  StrTMP:=MyStr(RecordTMP.RecordDate.Minutes);

  Write('   minyti : ') ;WriteLn(StrTMP);

  StrTMP:=MyStr(RecordTMP.RecordDate.Secund );

  Write('   sekyndi: ') ;WriteLn(StrTMP);

End;

 

Procedure AddInformation;

Var

RecordTMP: DataBaseRecord;

TMP: Word;

T1,T2,T3: Word;

Begin

Repeat

  InputRecordFromKeyboard(RecordTMP);

 

  GetDate(T1,T2,T3, TMP);

  RecordTMP.RecordDate.Year :=T1;

  RecordTMP.RecordDate.Month:=T2;

  RecordTMP.RecordDate.Day  :=T3;

  GetTime(T1,T2,T3, TMP);

  RecordTMP.RecordDate.Hours  :=T1;

  RecordTMP.RecordDate.Minutes:=T2;

  RecordTMP.RecordDate.Secund :=T3;

 

  NewRecord;

  WriteRecordIntoMemory(NumberOfDataBaseRecords, RecordTMP);

Until (Yes_Or_No('Bydete vvodit eshe odny zapis?')=False);

End;

 

Procedure CompareStrings(Var CompIndex: Word; String1, String2: String);

Var

S : Byte;

Begin

For S:=1 to MinByte(MyLen(String1), MyLen(String2)) do

  IF (String1[S]=String2[S]) or (String1[S]='?') or (String2[S]='?') Then Inc(CompIndex);

End;

 

Procedure CompareWords(Var CompIndex: Word; W1,W2: Word);

Var

S1, S2: String;

Begin

IF (W1>0) and (W2>0) Then Begin

  S1:=MyStr(W1); S2:=MyStr(W2);

  CompareStrings(CompIndex, S1, S2);

End;

End;

 

Function CompareRecords(Record1, Record2: DataBaseRecord): Word;

Var

CompIndex: Word;

S1,S2: String;

Begin

CompIndex:=0;

 

S1:=Record1.Name.SurName       ; S2:=Record2.Name.SurName       ;

CompareStrings(CompIndex,S1,S2);

S1:=Record1.Name.Name          ; S2:=Record2.Name.Name          ;

CompareStrings(CompIndex,S1,S2);

S1:=Record1.Name.SecondName    ; S2:=Record2.Name.SecondName    ;

CompareStrings(CompIndex,S1,S2);

S1:=Record1.Coordinates.Country; S2:=Record2.Coordinates.Country;

CompareStrings(CompIndex,S1,S2);

S1:=Record1.Coordinates.City   ; S2:=Record2.Coordinates.City   ;

CompareStrings(CompIndex,S1,S2);

S1:=Record1.Coordinates.Street ; S2:=Record2.Coordinates.Street ;

CompareStrings(CompIndex,S1,S2);

S1:=Record1.TelephoneNumber; S2:=Record2.TelephoneNumber;

CompareStrings(CompIndex,S1,S2);

 

CompareWords(CompIndex, Record1.Coordinates.HouseNumber    , Record2.Coordinates.HouseNumber    );

CompareWords(CompIndex, Record1.Coordinates.ApartmentNumber, Record2.Coordinates.ApartmentNumber);

CompareWords(CompIndex, Record1.BirthDay.Year , Record2.BirthDay.Year );

CompareWords(CompIndex, Record1.BirthDay.Month, Record2.BirthDay.Month);

CompareWords(CompIndex, Record1.BirthDay.Day  , Record2.BirthDay.Day  );

 

CompareRecords:=CompIndex;

End;

 

Procedure SearchInformation;

Var

RecordToSearch: DataBaseRecord;

ReadedRecord  : DataBaseRecord;

Num     : Word;

T1,T2,T3: Word;

Index   : Word;

MaxIndex: Word;

RecordOfMaxIndex: Word;

Begin

Repeat

  InputRecordFromKeyboard(RecordToSearch);

  ClrScr;

 

  MaxIndex:=0;

  For Num:=1 to NumberOfDataBaseRecords Do Begin

   ReadRecordFromMemory(Num, ReadedRecord);

   Index:=CompareRecords(RecordToSearch, ReadedRecord);

   IF Index>MaxIndex Then Begin MaxIndex:=Index; RecordOfMaxIndex:=Num; End;

  End;

  ReadRecordFromMemory(RecordOfMaxIndex, ReadedRecord);

  PrintRecordOnScreen(ReadedRecord);

Until (Yes_Or_No('Bydete Iskat eshe odny zapis?')=False);

End;

 

Procedure TxtCol(C,B: Byte);

Begin

TextColor(C);TextBackGround(B);

End;

 

Procedure WriteLN(S: String; C1,C2,C3: Byte);

Var

N : Byte;

Ch: Char;

Begin

TxtCol(C1,C3);

IF Ord(S[0])>0 Then

For N:=1 to Ord(S[0]) do Begin

  Ch:=S[N];

  IF Ch=']' Then TxtCol(C1,C3);

  Write(Ch);

  IF Ch='[' Then TxtCol(C2,C3);

End;

GotoXY(1,Succ(WhereY));

End;

 

Function MakeStr(C: Char; L: Integer): String;

Var LT: Integer;

    ST: String;

Begin

ST:='';

For LT:=1 to L do ST:=ST+C;

MakeStr:=ST;

End;

 

Function GetString(N: Word): String;

Var

ReadedRecord: DataBaseRecord;

ST: String;

Begin

ReadRecordFromMemory(N, ReadedRecord);

ST:=ReadedRecord.Name.SurName      +MakeStr(' ',SurNameLen        -MyLen(ReadedRecord.Name.SurName   ));

ST:=ST+Chr(179)+ReadedRecord.Name.Name      +MakeStr(' ',NameLen           -MyLen(ReadedRecord.Name.Name      ));

ST:=ST+Chr(179)+ReadedRecord.Name.SecondName+MakeStr(' ',SecondNameLen     -MyLen(ReadedRecord.Name.SecondName));

ST:=ST+Chr(179)+ReadedRecord.TelephoneNumber+MakeStr(' ',TelephoneNumberLen-MyLen(ReadedRecord.TelephoneNumber));

GetString:=ST;

End;

 

Procedure SwapRecords(N1,N2: Word);

Var

Rec1,Rec2:DataBaseRecord;

Begin

ReadRecordFromMemory(N1,Rec1);

ReadRecordFromMemory(N2,Rec2);

WriteRecordIntoMemory(N1,Rec2);

WriteRecordIntoMemory(N2,Rec1);

End;

 

Procedure SortRecords(K1,K2: Word);

Var

in1, in2: Integer;

Tempp   : String;

Vart    : DataBaseRecord;

ModifOld: Boolean;

Begin

ModifOld:=DataBaseModified;

IF K2-K1>1 Then Begin

  in1:=K1; in2:=K2;

  Tempp:=GetString((K1+K2) shr 1);

 

  Repeat

   While GetString(in1)<Tempp do inc(in1);

   While GetString(in2)>Tempp do dec(in2);

   IF in1<=in2 then Begin

    SwapRecords(in1,in2);

    inc(in1); dec(in2);

   End;

  Until in1>in2;

 

  IF K1<in2 Then SortRecords(K1, in2);

  IF in1<K2 Then SortRecords(in1, K2);

End Else IF GetString(K1)>GetString(K2) Then SwapRecords(K1,K2);

DataBaseModified:=ModifOld;

End;

 

Procedure ShowAllRecords;

Var

ReadedRecord             : DataBaseRecord;

ActiveNumber,ViewedWindow: Word          ;

CursorPosition           : Byte          ;

Ch                       : Char          ;

Stroka                   : String[255]  ;

N                        : Word          ;

WindowLen                : Byte          ;

PrintStart,PrintFinish   : Word          ;

NumberTMP                : Word          ;

NeadReDraw               : Boolean       ;

StartSimbols             : Byte          ;

StartLines               : Byte          ;

Begin

ClrScr;

SortRecords(1,NumberOfDataBaseRecords);

ActiveNumber:=1; CursorPosition:=1;

ViewedWindow:=1; WindowLen:=20;

StartSimbols:=1; StartLines:=1;

NeadReDraw:=True;

Repeat

  GotoXY(70,1); Write(ActiveNumber,'/',NumberOfDataBaseRecords,'    ');

 

  PrintStart:=ViewedWindow;

  PrintFinish:=ViewedWindow+WindowLen;

  IF PrintFinish>NumberOfDataBaseRecords Then PrintFinish:=NumberOfDataBaseRecords;

IF NeadReDraw Then Begin

  GotoXY(1,1);

  WriteLN(Chr(201)+MakeStr(Chr(205),SurNameLen+NameLen+SecondNameLen+13)+Chr(187),15,14,0);

  For N:=PrintStart to PrintFinish do Begin

   WriteLN(Chr(186)+GetString(N)+Chr(186), 15,14,0);

  End;

  WriteLN(Chr(200)+MakeStr(Chr(205),SurNameLen+NameLen+SecondNameLen+13)+Chr(188),15,14,0);

  GotoXY(1,24); WriteLN('Viberiti klavishamiя:[vniz],[vver],[vlevo],[vpravo],[home],[end],[delete],[Enter]',15,14,0);

  GotoXY(1,25); WriteLN('.',15,14,0);

  NeadReDraw:=False;

End;

 

  GotoXY(CursorPosition+StartSimbols,ActiveNumber-ViewedWindow+1+StartLines);

 

  Ch:=ReadKey;

  IF Ord(Ch)=13 Then Begin

   ReadRecordFromMemory(ActiveNumber, ReadedRecord);

   PrintRecordOnScreen(ReadedRecord);

   ReadKey;

   NeadReDraw:=True;

  End;

 

IF Ord(Ch)=0 Then Begin

  Ch:=ReadKey;

  Case Ord(Ch) Of

   72: Dec(ActiveNumber);

   80: Inc(ActiveNumber);

   77: Inc(CursorPosition);

   75: Dec(CursorPosition);

   71: CursorPosition:=1;

   79: CursorPosition:=MyLen(GetString(ActiveNumber));

   83: Begin

        ClrScr;

        IF Yes_Or_No('Vi hotite ydalit?')=True Then

         IF Yes_Or_No('Vi soobrazhaete?')=True Then

          IF Yes_Or_No('2+2*2=8?')=False Then Begin

           DeleteRecord(ActiveNumber);

           NeadReDraw:=True;

          End;

       End;

   73: IF ActiveNumber>WindowLen Then

        ActiveNumber:=ActiveNumber-WindowLen

       Else ActiveNumber:=1;

   81: IF ActiveNumber+WindowLen<=NumberOfDataBaseRecords Then

        ActiveNumber:=ActiveNumber+WindowLen

       Else ActiveNumber:=NumberOfDataBaseRecords;

  End;

End Else Begin

  NumberTMP:=ActiveNumber;

  For N:=Pred(ActiveNumber) Downto 1 do Begin

   Stroka:=GetString(N);

   IF Stroka[CursorPosition]=Ch Then ActiveNumber:=N;

  End;

  For N:=NumberOfDataBaseRecords Downto NumberTMP do Begin

   Stroka:=GetString(N);

   IF Stroka[CursorPosition]=Ch Then ActiveNumber:=N;

  End;

  INC(CursorPosition);

End;

 

  IF CursorPosition=0 Then CursorPosition:=MyLen(GetString(ActiveNumber));

  IF CursorPosition>MyLen(GetString(ActiveNumber)) Then CursorPosition:=1;

  IF ActiveNumber=0 Then ActiveNumber:=NumberOfDataBaseRecords;

  IF ActiveNumber>NumberOfDataBaseRecords Then ActiveNumber:=1;

  IF ActiveNumber<ViewedWindow Then Begin ViewedWindow:=ActiveNumber; NeadReDraw:=True; End;

  IF ActiveNumber>(ViewedWindow+WindowLen) Then Begin ViewedWindow:=ActiveNumber-WindowLen; NeadReDraw:=True; End;

Until Ord(Ch)=27;

End;

 

Function SelectForm(N: Word;S1,S2,S3: String): String;

Var

StringTMP: String;

X: Byte;

NumberString: String;

Begin

NumberString:=MyStr(N);

StringTMP:=NumberString[MyLen(NumberString)];

X:=MyVal(StringTMP);

Case X of

  1          : SelectForm:=NumberString+' '+S1;

  2,3,4      : SelectForm:=NumberString+' '+S2;

  5,6,7,8,9,0: SelectForm:=NumberString+' '+S3;

End;

End;

 

Function Menu: Byte;

Var

C: Char;

ActiveLine: Byte;

SelectedLine: Byte;

Begin

ActiveLine  :=1;

SelectedLine:=0;

 

ClrScr; TextColor(7);

GotoXY(60,1); Write('Imeetsya',SelectForm(NumberOfDataBaseRecords,'zapis','zapisi','zapisei'));

GotoXY(1,25); WriteLN('Viberite Klavishami [vniz],[vverh] nyzhni punkt i nazhmite [Enter]',15,14,0);

GotoXY(1,1);

WriteLN('[a]-Dobavit informaciyu'      , 15,14,0);

WriteLN('[s]-Poisk Informacii'        , 15,14,0);