Unit Ernst;

{$B-}

Interface

uses Dos, Crt;

type
    Cols = set of 1..80;
    String80 = String[80];
    Buffer = array[1..4000] of char;  {Use for calls to SAVE_SCREEN      }
    Keys = (NullKey, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10,
            CarriageReturn, Tab, ShiftTab, BkSp, UpArrow,
            DownArrow, RightArrow, LeftArrow, DeleteKey,
            InsertKey, HomeKey, Esc, EndKey, TextKey, NumberKey,
            Space, PgUp, PgDn);

var
    P       : ^Buffer;                      {Pointer to Video Memory           }
    Key     : Keys;
    Stype   : Char;


(* ====================================================================== *)

procedure FastWrite( X, Y : integer;
                     var S : String;
                     FG, BG : integer;
                     stype : char);

procedure FastWriteStr( X, Y : integer;
                        S : String;
                        FG, BG : integer;
                        stype : char);

procedure GetScreenType(var Stype : char);

procedure Cursor_Off(Stype : char);
procedure Cursor_Small(Stype : char);
procedure Cursor_Big(Stype: char);

procedure Beep(Freq, Time : integer);

procedure Inkey( var FunctionKey : boolean;
                 var Ch: char;
                 BeginCursor,
                 EndCursor : char);

procedure InputStringShift ( var S          : string;
                             WindowLength,
                             MaxLength,
                             X, Y           : integer;
                             FT             : char;
                             BackgroundChar : integer);

procedure DrawBox(X1, X2, Y1, Y2 : byte; Message: string);

(* ====================================================================== *)

function GetLine(Var FileVar: Text; Line: Word): String;
         {Retorna a linha Line do arquivo Text
         Arquivo deve estar fechado}

function FileString(Var FileVar: Text; Line: Word; Pos: Byte; Len: Byte): String;
         {Recebe uma vari vel File, Linha, Posi‡„o e tamanho e retorna o
         conte£do desse lugar no arquivo File }

function RTrim(s: String): String;
         {Retira espa‡os em branco DEPOIS de determinada String}

function LTrim(s: String): String;
         {Retira espa‡os em branco ANTES de determinada String}

function Strip(St: string; Imbed: boolean): string;
         {Remove espa‡os antes e depois da string St.
         Se Imbed for TRUE, tamb‚m remove espa‡os no meio da string}

function Upper(s: String): String;
         {Retorna uma String em letras mai£sculas}

function Lower(s: String): String;
         {Retorna uma String em letras min£sculas}

function FitString(len : word; str : string): string;
         {Retorna string com LEN caracteres}

function Capitalize(s: String): String;
         {Capitaliza uma string (primeira letra mai£scula, resto min£scula)}

function FirstName(s: String): String;
         {Retorna a primeira palavra de uma string}

function LastName(s: String): String;
         {Retorna a £ltima palavra de uma string}

function FileExists(FileName: String): Boolean;
         {Fun‡„o boolana que retorna True se o arquivo existir, se n„o,
         retorna False. Nem abre o arquivo}

function SizeFile(Fname : string) : longint;
         {Retorna o tamanho do arquivo em bytes. -1 para arquivo que nao existe}

function DirExists(d: pathstr): boolean;
         {Fun‡„o boolana que retorna True se o diret¢rio existir, se n„o,
         retorna False.}

procedure CursorOff;
          {Desativa o cursor na tela}

procedure CursorOn;
          {Reativa o cursor na tela}

function GetFileName(Param1: string): string;
         {Retorna apenas o nome do arquivo com extens„o, se for entrado o
         path e nome}

function GetPathName(Param1: string): string;
         {Retorna apenas o diret¢rio de um arquivo entrado}

function ClearPath(S: string): string;
         {Devolve o diret¢rio especificado COM '\' final}

function LeadingZero(w : Word) : string;
         {Ajusta um n£mero para duas casas, colocando zero na frente, se
         necess rio.  Retorna o resultado numa string}

function Current_Date : string;
         {Retorna a data atual}

function Current_Month : string;
         {Retorna o mˆs atual}

function Current_Time : string;
         {Retorna a hora atual}

function Current_DOW : string;
         {Retorna o dia da semana atual}

function GetDateTime(What: string): word;
         {What pode ser:  Year, Month, Day, DOW, Hour, Minute, Second, S100}

function CountDays(Day, Month, Year: word): longint;
         {Conta dias a partir de 1/1/1980}

function IsAlpha(C: Char) : Boolean;
         {Retorna TRUE, se caracter for alfab‚tico}

function IntToStr(I: longint): string;
         {Convert any integer type to a string}

function StrToInt(S: string): integer;
         {Convert any string type to a integer}

function Dup(Mask: char; N: integer) : string;
         {Retorna uma string com N caracteres MASK}

procedure Fw(X, Y: integer; Attr: byte; Line: string80);
          {Escreve string 'line' na posi‡„o (x,y) com atributos 'attr'.
          Attr ‚ em hexa: $07 para fundo '0' e cor '7'. }

procedure Set_Attr(X: cols; Y: integer; Attrib : byte);
          {set_attr([1..4,10],Y,$07);
          Ajusta colunas 1 a 4 e 10 na linha Y para
          fundo PRETO (0) e frente CINZA (7) }

procedure Pop_Window(X1, Y1, X2, Y2: integer; Style: integer; Attr: byte);

          {Abre uma janela.  Tamanho determinado por X1, Y1, X2, Y2
          Style = 0, nenhuma; 1, simples; 2, dupla = com sombra
          Style = 10, nenhuma; 11, simples; 12, dupla = sem sombra
          Attr = Cor da janela                                       }

procedure Pop_Message(X, Y: integer; Border, Attr: byte;
                         Mattr: byte; Message: string80);
          {Abre uma janela em (X,Y) em volta da mensagem 'message'.
          Se X for zero, a janela ‚ centralizada horizontalmente
          X,Y = Canto superior esquerdo da janela
          Border = 0, nenhuma; 1, simples; 2, dupla = com sombra
          Border = 10, nenhuma; 11, simples; 12, dupla = sem sombra
          Attr = Cor da borda
          Mattr = Cor da mensagem
          Message = Mensagem a ser exibida                          }

procedure Pop_Window_Title(   X,Y,X1,Y1 : integer;
                           Border, Attr : byte;
                                  Tattr,
                                     Ty : byte;
                                  Title : string80);

          {Abre janela com coordenadas (X,Y,X1,Y1), como pop_window
          Title ser  centralizado na linha Ty na cor Tattr}

function ValToChar(Valor: LongInt): string;

function TrimVal4(w : Word) : String;

function TrimVal3(w : Word) : String;

function CopyInt(Valor:longint; Pos1, Len:byte) : longint;

procedure CleanLines(Line1, Line2: integer);
          {Limpa linha LineNr}

function StatusBar(total, amt : longint) : string;
         {Mostra uma barra de status com % done}
         {Entrada: Quantidade total, Quantidade feita}

(* ====================================================================== *)


Implementation

(* ---------------------------------------------------------------------- *)
procedure FastWrite( X, Y : integer;
                     var S : String;
                     FG, BG : integer;
                     stype : char);

var
    I, B : byte;

begin

X := X + 1;
Y := Y - 1;

if UpCase(Stype) = 'M' then
begin
    B := (BG shl 4) + FG;
    X := ((X-1) * 2) + ((Y-1) * 160);
    for I := 1 to length(S) do
    begin
        mem[$B000:X] := byte(S[I]);
        mem[$B000:X+1] := B;
        inc(X,2);
    end;
end

else
        
inline ( $50/
         $53/
         $51/
         $52/
         $1E/
         $06/
         $57/
         $56/
         $8B/$5E/<X/
         $8B/$46/<Y/
         $4B/
         $4B/
         $B9/$50/$00/
         $F7/$E1/
         $03/$C3/
         $B9/$02/$00/
         $F7/$E1/
         $8B/$F8/
         $8B/$5E/<BG/
         $8B/$46/<FG/
         $B9/$04/$00/
         $D3/$E3/
         $03/$D8/
         $86/$DF/
         $BA/$DA/$03/
         $B8/$00/$B8/
         $8E/$C0/
         $C5/$76/<S/
         $8A/$0C/
         $80/$F9/$00/
         $74/$15/
         $FC/
         $46/
         $8A/$1C/
         $EC/
         $A8/$01/
         $75/$FB/
         $FA/
         $EC/
         $A8/$01/
         $74/$FB/
         $8B/$C3/
         $AB/
         $FB/
         $E2/$EC/
         $5E/
         $5F/
         $07/
         $1F/
         $5A/
         $59/
         $5B/
         $58/
         $E9/$00/$00/
         $8B/$E5/
         $5D/
         $C2/$0E/$00 );

X := X - 1;
Y := Y + 1;

end; {FastWrite}

(* ---------------------------------------------------------------------- *)
procedure FastWriteStr( X, Y : integer;
                      S : String;
                      FG, BG : integer;
                      stype : char);

var  Str : String;
begin
     Str := S;
     FastWrite(X, Y, Str, FG, BG, stype);
end;

(* ---------------------------------------------------------------------- *)
procedure GetScreenType(var Stype : char);

var
    Regs : registers;

begin
    Regs.AH := $0F;
    intr($10,Regs);
    if Regs.AL = 7 then
        Stype := 'M'
    else
        Stype := 'C';
end; {GetScreenType}

(* ---------------------------------------------------------------------- *)
procedure Cursor_Off(Stype : Char);

var
    Regs : Registers;

begin
    with Regs do
    begin
        AH := $01;
        CH := $20;
        CL := $20;
    end;
    intr($10,Regs);
end; {Cursor_Off}

(* ---------------------------------------------------------------------- *)
procedure Cursor_Small(Stype : Char);

var
    Regs : Registers;

begin
    case Stype of

    'M' :
        begin
        with Regs do
            begin
                AH := $01;
                CH := 12;
                CL := 13;
            end;
        end;

    'C' :
        begin
        with Regs do
            begin
                AH := $01;
                CH := 6;
                CL := 7;
            end;
        end;

    end;

    intr($10,Regs);

end; {Cursor_Small}

(* ---------------------------------------------------------------------- *)
procedure Cursor_Big(Stype: char);

var
    Regs : Registers;

begin
    case Stype of

    'M' :
        begin
        with Regs do
            begin
                AH := $01;
                CH := 0;
                CL := 13;
            end;
        end;

    'C' :
        begin
            with Regs do
            begin
                AH := $01;
                CH := 0;
                CL := 7;
            end;
        end;

    end;
    intr($10,Regs);

end; {Cursor_Big}

(* ---------------------------------------------------------------------- *)
procedure Beep(Freq, Time : integer);

begin
    Sound(Freq);
    delay(Time);
    nosound;
end; {Beep}

(* ---------------------------------------------------------------------- *)
procedure Inkey( var FunctionKey : boolean;
                 var Ch: char;
                 BeginCursor,
                 EndCursor : char);

begin

case BeginCursor of
    'B' : Cursor_Big(Stype);
    'S' : Cursor_Small(Stype);
    'O' : Cursor_Off(Stype);
end;

FunctionKey := false;
Ch := ReadKey;
if (Ch = #0) then
begin
    FunctionKey := true;
    Ch := ReadKey;
end;

if FunctionKey then
    case Ord(Ch) of
        15: key := ShiftTab;
        72: key := UpArrow;
        80: key := DownArrow;
        82: key := InsertKey;
        75: key := LeftArrow;
        77: key := RightArrow;
        73: key := PgUp;
        81: key := PgDn;
        71: key := HomeKey;
        79: key := EndKey;
        83: key := DeleteKey;
        82: key := InsertKey;
        59: key := F1;
        60: key := F2;
        61: key := F3;
        62: key := F4;
        63: key := F5;
        64: key := F6;
        65: key := F7;
        66: key := F8;
        67: key := F9;
        68: key := F10;
    end
else
    case ord(Ch) of
         8: key := BkSp;
         9: key := Tab;
        13: key := CarriageReturn;
        27: key := Esc;
        32: key := Space;
        33..44, 47, 58..254 : key := TextKey;
        44..46, 48..57 : key := NumberKey;
    end;

case EndCursor of
    'B' : Cursor_Big(Stype);
    'S' : Cursor_Small(Stype);
    'O' : Cursor_Off(Stype);
end;

end; {Inkey}

(* ---------------------------------------------------------------------- *)
procedure InputStringShift ( var S          : string;
                             WindowLength,
                             MaxLength,
                             X, Y           : integer;
                             FT             : char;
                             BackgroundChar : integer);

var
    Xx, I, J, P: integer;
    Ch: char;
    InsertOn,
    SpecialKey : boolean;
    Offset : integer;
    TempStr: string;

    (* ------------------------------------------------------------------ *)
    procedure XY(x, y: integer);
    var
        Xsmall: integer;

        begin

            repeat
            Xsmall := x-80;
            if Xsmall > 0 then
            begin
                Y := Y + 1;
                X := Xsmall;
            end;
            until Xsmall <= 0;
            gotoxy(x, y);

        end;

    (* ------------------------------------------------------------------ *)
    procedure SetString;

    var
        I : integer;

        begin
            I := length(S);
            while S[I] = char(BackgroundChar) do
                I := I-1;
            S[0] := char(I);
            cursor_small(Stype);
        end;

    (* ------------------------------------------------------------------ *)

begin

    J := length(S) + 1;
    for I := J to MaxLength do
        S[I] := char(BackgroundChar);

    S[0] := char(MaxLength);

    TempStr := copy(S, 1, WindowLength);
    FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
    P := 1;
    Offset := 1;
    InsertOn := true;

    repeat

        Xx := X+(P-Offset);
        if (P-Offset) = WindowLength then
            Xx := Xx-1;

        XY(Xx, Y);

        if InsertOn then
            Inkey(SpecialKey, ch, 'B', 'O')
        else
            Inkey(SpecialKey, ch, 'S', 'O');

        if (FT = 'N') then
        begin
            if (key = TextKey) then
            begin
                beep(300, 100);
                key := Nullkey;
            end
            else if (Ch = '-') and ((P > 1) or (S[1] = '-')) then
            begin
                beep(300, 100);
                key := Nullkey;
            end
            else if (ch = '.') then
            begin
                if not((pos('.',S) = 0) or (pos('.',S) = P)) then
                begin
                    beep(300, 100);
                    key := Nullkey;
                end
                else if (pos('.',S) = P) then
                    delete(S, P, 1);
            end;
        end;
        
        case key of

        NumberKey,
        TextKey,
        Space    :
        begin
            if (length(S) = MaxLength) then
            begin
                if P = MaxLength then
                begin
                    delete(S, MaxLength, 1);
                    S := S + Ch;
                    if P = WindowLength + Offset then
                        Offset := Offset + 1;
                    TempStr := copy(S, Offset, WindowLength);
                    FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
                end
                else
                begin
                    if InsertOn then
                    begin
                        delete(S, MaxLength, 1);
                        insert(Ch, S, P);
                        if P = WindowLength + Offset then
                            Offset := Offset + 1;
                        if P < MaxLength then
                            P := P + 1;
                        TempStr := copy(S, Offset, WindowLength);
                        FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
                    end
                    else (* Substitui‡„o *)
                    begin
                        delete(S, P, 1);
                        insert(Ch, S, P);
                        if P = WindowLength + Offset then
                            Offset := Offset + 1;
                        if P < MaxLength then
                            P := P + 1;
                        TempStr := copy(S, Offset, WindowLength);
                        FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
                    end;
                end;
            end
            else
            begin
                if InsertOn then
                    insert(Ch, S, P)
                else
                begin
                    delete(S, P, 1);
                    insert(Ch, S, P);
                end;
                if P = WindowLength + Offset then
                    Offset := Offset + 1;
                if P < MaxLength then
                    P := P + 1;
                TempStr := copy(S, Offset, WindowLength);
                FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
            end;
        end;

        Bksp :
        begin
            if P > 1 then
            begin
                P := P - 1;
                delete(S, P, 1);
                S := S + Char(BackgroundChar);
                if Offset > 1 then
                    Offset := Offset - 1;
                TempStr := copy(S, Offset, WindowLength);
                FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
            end
            else
            begin
                beep(300, 100);
                Ch := ' ';
                P := 1;
            end;
        end;

        LeftArrow :
        begin
            if P > 1 then
            begin
                P := P - 1;
                if P < Offset then
                begin
                    Offset := Offset - 1;
                    TempStr := copy(S, Offset, WindowLength);
                    FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
                end;
            end
            else
            begin
                beep(300, 100);
                Ch := ' ';
                P := 1;
            end;
        end;

        RightArrow :
        begin
            if (S[P] <> Char(BackgroundChar)) and (P < MaxLength) then
            begin
                P := P + 1;
                if P = (WindowLength + Offset) then
                begin
                    Offset := Offset + 1;
                    TempStr := copy(S, Offset, WindowLength);
                    FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
                end;
            end
            else
            begin
                beep(300, 100);
                Ch := ' ';
            end;
        end;

        DeleteKey :
        begin
            delete(S, P, 1);
            S := S + Char(BackgroundChar);
            TempStr := copy(S, Offset, WindowLength);
            FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
        end;

        InsertKey :
        begin
            if InsertOn then
            begin
                InsertOn := false;
                Cursor_Big(Stype);
            end
            else
            begin
                InsertOn := true;
                Cursor_Small(Stype);
            end;
        end;

        HomeKey :
        begin
            P := 1;
            Offset := 1;
            TempStr := copy(S, Offset, WindowLength);
            FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
        end;

        EndKey :
        begin
            P := 1;
            while (S[P+1] <> Char(BackgroundChar)) and (P < MaxLength) do
            begin
                P := P + 1;
                if P = (WindowLength + Offset) then
                begin
                    Offset := Offset + 1;
                    TempStr := copy(S, Offset, WindowLength);
                    FastWrite(X, Y, TempStr, Yellow, Blue, Stype);
                end;
            end;
        end;

        else
        if not(Key in [CarriageReturn, NullKey, Esc]) then
            beep(300, 100);

{        if not(Key in [CarriageReturn, UpArrow, DownArrow, PgDn, PgUp, NullKey,
                           Esc, Tab, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10]) then
            beep(300, 100);}

        end;

    until (Key in [CarriageReturn, NullKey, Esc]);

{    until (Key in [CarriageReturn, UpArrow, DownArrow, PgDn, PgUp, NullKey,
                   Esc, Tab, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10]);}

    SetString;

end; {InputStringShift}

(* ---------------------------------------------------------------------- *)
procedure DrawBox(X1, X2, Y1, Y2 : byte; Message : string);
var  X, Y : byte;

begin

     FastWriteStr(X1, Y1, 'Ú'+Dup('Ä', X2-X1), LightGray, Blue, Stype);
     FastWriteStr(X2, Y1, '¿', DarkGray, Blue, Stype);

     for Y := Y1+1 to Y2-1 do
     begin

          FastWriteStr(X1, Y, '³'+Dup(' ', X2-X1), LightGray, Blue, Stype);
          FastWriteStr(X2, Y, '³', DarkGray, Blue, Stype);

     end;

     FastWriteStr(X1, Y2, 'À', LightGray, Blue, Stype);
     FastWriteStr(X1+1, Y2, Dup('Ä', X2-X1-1)+'Ù', DarkGray, Blue, Stype);

     FastWriteStr(X1+2, Y1, ' '+Strip(Message, False)+' ', White, Blue, Stype);

end;

(* ====================================================================== *)


(* ---------------------------------------------------------------------- *)
function GetLine(Var FileVar: Text; Line: Word): String;
         {Retorna a linha Line do arquivo Text
         Arquivo deve estar fechado}

var Counter: Integer;
    TempLine: String[128];

begin

    if Line = 0 then
    begin
        GetLine := '';
        exit;
    end;

    Counter := 0;
    reset(FileVar);

    while (Counter < Line) and not(eof(FileVar)) do
    begin
        readln(FileVar, TempLine);
        inc(Counter);
    end;

{     if eof(FileVar) then
         GetLine:= '** EOF **'
     else }

    GetLine:= TempLine;
    close(FileVar);

end;

(* ---------------------------------------------------------------------- *)
function FileString(Var FileVar: Text; Line: Word; Pos: Byte; Len: Byte): String;
         {Recebe uma vari vel File, Linha, Posi‡„o e tamanho e retorna o
         conte£do desse lugar no arquivo File }

var FullLine: String[128];

begin

    FullLine := GetLine(FileVar,Line);
    if FullLine = '** EOF **' then
        FileString := ''
    else
        FileString := copy(FullLine, Pos, Len);

end;

(* ---------------------------------------------------------------------- *)
function RTrim(s: String): String;
         {Retira espa‡os em branco DEPOIS de determinada String}

var  C: Byte;
     I: Byte;

begin

    C := Length(s);
    I := Length(s);
    while Copy(s,C,1) = ' ' do
    begin
         dec(C);
         if Copy(s,C,1) <> ' ' then I := C;
    end;
    RTrim := Copy(s,1,I);

end;

(* ---------------------------------------------------------------------- *)
function LTrim(s: String): String;
         {Retira espa‡os em branco ANTES de determinada String}

begin

    while (copy(s,1,1) = ' ') do
         delete(s,1,1);

    LTrim := s;

end;

(* ---------------------------------------------------------------------- *)
function Strip(St: string; Imbed: boolean): string;
         {Remove espa‡os antes e depois da string St.
         Se Imbed for TRUE, tamb‚m remove espa‡os no meio da string}

begin

    while (length(St) > 0) and (St[1] = ' ') do
        delete(St,1,1);

    while (length(St) > 0) and (St[length(St)] = ' ') do
        delete(St,length(St),1);

    if imbed then
        while pos(' ',st) > 0 do
            delete(St,pos(' ',St),1);

    strip := St;

end;


(* ---------------------------------------------------------------------- *)
function Upper(S: string): string;
         {Retorna uma String em letras mai£sculas}

var  I : integer;

begin

    for I := 1 to length(S) do
        s[I] := UpCase(S[I]);
    Upper := S;

end;

(* ---------------------------------------------------------------------- *)
function Lower(s: String): String;
         {Retorna uma String em letras min£sculas}

var X : byte;

begin

    for X := 1 to length(S) do
         if ord(S[X]) in [65..90] then S[X] := chr(ord(S[X])+32);

    Lower := S;

end;

(* ---------------------------------------------------------------------- *)
function FitString(len : word; str : string): string;
         {Retorna string com LEN caracteres}

var str2 : string;

begin

    if length(str) >= len then str2 := copy(str, 1, len);

    if length(str) < len then
    begin
         FillChar(str2, SizeOf(str2), ' ');
         str2 := copy(str, 1, length(str));
         str2[0] := Chr(len);
    end;

    FitString := str2;

end;

(* ---------------------------------------------------------------------- *)
function Capitalize(s: String): String;
         {Capitaliza uma string (primeira letra mai£scula, resto min£scula)}

var  Str : Array[1..201] of string[1];
     Cnt1: integer;
     Cp  : string;

begin

    S := Lower(S);
    Cp := '';
    if length(S) > 200 then halt;

    for Cnt1 := 1 to length(S) do
        str[Cnt1] := copy(S,Cnt1,1);

    str[1] := Upper(str[1]);

    for Cnt1 := 2 to length(S)+1 do
        if str[Cnt1]=' ' then
            str[Cnt1+1] := Upper(str[Cnt1+1]);

    for Cnt1 := 1 to length(S) do
        Cp := Cp + str[Cnt1];

    Capitalize := Cp;

End;


(* ---------------------------------------------------------------------- *)
function FirstName(s: String): String;
         {Retorna a primeira palavra de uma string}

var  I    : byte;
     Flag : boolean;

begin

     I := 0;
     Flag := false;

     while (I < length(S)) and (not Flag) do
     begin
          inc(I);
          if copy(S,I,1) = ' ' then Flag := true;
     end;

     FirstName := copy(S,1,I-1);
     if I = length(S) then FirstName := S;

end; {FirstName}


(* ---------------------------------------------------------------------- *)
function LastName(S: String): String;
         {Retorna a £ltima palavra de uma string}

var  Ls, I : byte;
     Flag  : boolean;

begin

     Ls := 1;
     I := Length(s);
     Flag := false;

     while (I > Ls) and (not Flag) do
     begin
          dec(I);
          if copy(S,I,1) = ' ' then Flag := true;
     end;

     LastName := copy(S,I+1,length(S)-I+1);
     if I = Ls then LastName := S;

end; {LastName}


(* ---------------------------------------------------------------------- *)
function FileExists(FileName: String): Boolean;
         {Fun‡„o boolana que retorna True se o arquivo existir, se n„o,
         retorna False. Nem abre o arquivo}

begin

    FileExists := fsearch(FileName, '') <> ''

end; { FileExists }


(* ---------------------------------------------------------------------- *)
function SizeFile(Fname : string) : longint;

var SR  : SearchRec;
    IDX : integer;

begin

    SizeFile := 0;
    findfirst(Fname, anyfile, SR);
    if doserror = 0 then SizeFile := SR.Size else SizeFile := -1;

end;

(* ---------------------------------------------------------------------- *)
function DirExists(d: pathstr): boolean;

var
    f   : file;
    attr: word;
    len : byte;

begin

    len:= length(d);

    if (d[len] = '\') then         {if d has a trailing slash...         }
        dec(d[0]);                 {remove the trailing slash.           }

    d:= d + '\.';                  {add '\.' to d                        }
    assign(f,d);                   {assign d to f                        }
    getfattr(f,attr);              {get the attribute word               }
    DirExists := ((attr and directory)=directory);
                                   {return true if attr is directory     }

end;


(* ---------------------------------------------------------------------- *)
procedure CursorOff;
          {Desativa o cursor na tela}

var Regs : Registers;

begin

    Regs.ah := 1;
    Regs.ch := 1;
    Regs.cl := 0;
    Intr($10,Regs);

end;

(* ---------------------------------------------------------------------- *)
procedure CursorOn;
          {Reativa o cursor na tela}

var Regs : Registers;

begin

    Regs.ah := 1;
    Regs.ch := 6;
    Regs.cl := 7;
    Intr($10,Regs);

end;

(* ---------------------------------------------------------------------- *)
function GetFileName(Param1: String): String;
         {Retorna apenas o nome do arquivo com extens„o, se for entrado o
         path e nome}

var
    Fullname : String;   {nome completo do arquivo}
    Counter  : Integer;  {Contador para achar o '\'}

Begin

    Fullname := Param1;
    For Counter := Length(Fullname) DownTo (Length(Fullname)-12) Do Begin
        If Copy(Fullname, Counter, 1) = '\' Then Begin
            GetFileName := Copy(Fullname, Counter+1, 13);
            Counter := Length(Fullname)-12;
        End;
    End;

End;

(* ---------------------------------------------------------------------- *)
function GetPathName(Param1: String): String;
         {Retorna apenas o diret¢rio de um arquivo entrado}

var
    Fullname : string;   {nome completo do arquivo}
    Resultado: string;
    Counter  : integer;  {Indice dentro do Fullname para achar o '\'}

Begin

    Fullname := Param1;
    Resultado := '';
    For Counter := Length(Fullname) DownTo (Length(Fullname)-12) Do Begin
        If Copy(Fullname, Counter, 1) = '\' Then Begin
            Resultado := Copy(Fullname, 1, Counter);
            Counter := Length(Fullname)-12;
        End;
    End;

    GetPathName := Resultado;

End;

(* ---------------------------------------------------------------------- *)
function ClearPath(S: String): String;
         {Devolve o diret¢rio especificado COM '\' final}

begin

    if S[length(S)] = '\' then
        ClearPath := S
    else
        ClearPath := S + '\';

end;  {ClearPath}


(* ---------------------------------------------------------------------- *)
function LeadingZero(w : Word) : String;
         {Ajusta um n£mero para duas casas, colocando zero na frente, se
         necess rio.  Retorna o resultado numa string}

var
  s : String;

begin

    Str(w:0,s);
    if Length(s) = 1 then
        s := '0' + s;
    LeadingZero := s;

end;

(* ---------------------------------------------------------------------- *)
function Current_Date : String;
         {Retorna a data atual}
var  Year, Month, Day, DayOfWeek:  Word;

begin

    GetDate(Year, Month, Day, DayOfWeek);
    Current_Date := LeadingZero(Day) + '-' + LeadingZero(Month) + '-' + LeadingZero(Year);

end;

(* ---------------------------------------------------------------------- *)
function Current_Month: String;
         {Retorna o mˆs atual}
var  Year, Month, Day, DayOfWeek:  Word;

begin

    GetDate(Year, Month, Day, DayOfWeek);
    Case Month of
         1 : Current_Month := 'janeiro';
         2 : Current_Month := 'fevereiro';
         3 : Current_Month := 'mar‡o';
         4 : Current_Month := 'abril';
         5 : Current_Month := 'maio';
         6 : Current_Month := 'junho';
         7 : Current_Month := 'julho';
         8 : Current_Month := 'agosto';
         9 : Current_Month := 'setembro';
         10: Current_Month := 'outubro';
         11: Current_Month := 'novembro';
         12: Current_Month := 'dezembro';
    else
         Current_Month := '<error>';
    end;

end;

(* ---------------------------------------------------------------------- *)
function Current_Time : String;
         {Retorna a hora atual}
var  Hour, Minute, Second, Sec100: Word;

begin

    GetTime(Hour, Minute, Second, Sec100);
    Current_Time := LeadingZero(Hour) + ':' + LeadingZero(Minute);

end;

(* ---------------------------------------------------------------------- *)
function Current_DOW : String;
         {Retorna o dia da semana atual}
var  Year, Month, Day, DayOfWeek:  Word;

begin

    GetDate(Year, Month, Day, DayOfWeek);
    Case DayOfWeek of
         0 : Current_DOW := 'domingo';
         1 : Current_DOW := 'segunda';
         2 : Current_DOW := 'ter‡a';
         3 : Current_DOW := 'quarta';
         4 : Current_DOW := 'quinta';
         5 : Current_DOW := 'sexta';
         6 : Current_DOW := 's bado';
    else
         Current_DOW := '<error>';
    end;

end;

(* ---------------------------------------------------------------------- *)
function GetDateTime(What: string): word;
         {What pode ser:  Year, Month, Day, DOW, Hour, Minute, Second, S100}
var  Year, Month, Day, DOW:  Word;
     Hour, Minute, Second, Sec100: Word;
     Temp: word;

begin

    Temp := 0;
    GetDate(Year, Month, Day, DOW);
    GetTime(Hour, Minute, Second, Sec100);
    if Upper(What) = 'YEAR'   then Temp := Year;
    if Upper(What) = 'MONTH'  then Temp := Month;
    if Upper(What) = 'DAY'    then Temp := Day;
    if Upper(What) = 'DOW'    then Temp := Dow;
    if Upper(What) = 'HOUR'   then Temp := Hour;
    if Upper(What) = 'MINUTE' then Temp := Minute;
    if Upper(What) = 'SECOND' then Temp := Second;
    if Upper(What) = 'SEC100' then Temp := Sec100;

    GetDateTime := Temp;

end;


(* ---------------------------------------------------------------------- *)
function CountDays(Day, Month, Year: word): longint;
         {Conta dias a partir de 1/1/1980}

var A, Final : longint;

begin

     A := (((Year-1977) div 4)*366 + (Year-1980-((Year-1977) div 4))*365) + Day;

     Case Month of
       1  : Final := A;
       2  : Final := A+31;
       3  : Final := A+59;
       4  : Final := A+90;
       5  : Final := A+120;
       6  : Final := A+151;
       7  : Final := A+181;
       8  : Final := A+212;
       9  : Final := A+243;
       10 : Final := A+273;
       11 : Final := A+304;
       12 : Final := A+334;
     end;

     if (Month > 2) and (Year mod 4 = 0) then Final := Final + 1;

    CountDays := Final;
    
end;

(* ---------------------------------------------------------------------- *)
function IsAlpha(C: Char) : Boolean;
         {Retorna TRUE, se caracter for alfab‚tico}

begin

    case C of
        'A'..'Z' : IsAlpha := true;
        'a'..'z' : IsAlpha := true;
    else
        IsAlpha := false;
    end;

end;

(* ---------------------------------------------------------------------- *)
function IntToStr(I: Longint): String;
         {Converte qualquer tipo de integer em uma string}

var
   S: string[11];

begin

     Str(I, S);
     IntToStr := S;

end;

(* ---------------------------------------------------------------------- *)
function StrToInt(S: string): integer;
         {Convert any string type to a integer}

var Code, I : integer;

begin

     val(S, I, Code);

     if Code = 0 then
         StrToInt := I
     else
         StrToInt := 0;

end;

(* ---------------------------------------------------------------------- *)
function Dup(Mask: char; N: integer) : string;
         {Retorna uma string com N caracteres MASK}

var
    St: string;

begin

    fillchar(St,sizeof(St),Mask);
    if (N < 256) and (N > 0) then
        St[0] := chr(N)
    else
        St[0] := chr(0);
    Dup := St;

end;


(* ---------------------------------------------------------------------- *)
procedure Fw(X, Y: integer; Attr: byte; Line: string80);
          {Escreve string 'line' na posi‡„o (x,y) com atributos 'attr'.
          Attr ‚ em hexa: $07 para fundo '0' e cor '7'.}

var
    I,J,
    Z : integer;

begin

    Z := (((Y * 160) - 160) + (X * 2)) - 1;
    I := 1;
    J := 1;

    if length(Line) > 0 then
    repeat
        p^[Z+J-1] := Line[I];
        p^[Z+J]   := chr(Attr);
        I := I + 1;
        J := J + 2;
    until I > length(Line);

end;

(* ---------------------------------------------------------------------- *)
procedure Set_Attr(X: cols; Y: integer; Attrib : byte);
          {set_attr([1..4,10],Y,$07);
          Ajusta colunas 1 a 4 e 10 na linha Y para
          fundo PRETO (0) e frente CINZA (7) }

var
    Monitor_info : byte absolute $0040:$0010;
    Screen1      : array [1..4000] of byte absolute $b800:$0000;
    Screen2      : array [1..4000] of byte absolute $b000:$0000;
    I,Z          : integer;

begin

    for I := 1 to 80 do
        if I in X then
        begin
            Z := ((Y * 160) - 160) + (I * 2);
            if Monitor_info and 48=48 then
                Screen2[Z] := Attrib
            else
                if Monitor_info and 32=32 then
                    Screen1[Z] := Attrib;
        end;

end;


(* ---------------------------------------------------------------------- *)
procedure Pop_Window(X1, Y1, X2, Y2: integer; Style: integer; Attr: byte);
          {Abre uma janela.  Tamanho determinado por X1, Y1, X2, Y2
          Style = 0, nenhuma; 1, simples; 2, dupla = com sombra
          Style = 10, nenhuma; 11, simples; 12, dupla = sem sombra
          Attr = Cor da janela                                       }

var
    I,
    Shadow       : byte;
    Urcorner,
    Ulcorner,
    Lrcorner,
    Llcorner,
    Vertical,
    Horizontal   : char;

begin

    case style of

        0, 10:
        begin
            urcorner   := ' ';
            ulcorner   := ' ';
            lrcorner   := ' ';
            llcorner   := ' ';
            vertical   := ' ';
            horizontal := ' ';
        end;

        1, 11:
        begin
            urcorner   := '¿';
            ulcorner   := 'Ú';
            lrcorner   := 'Ù';
            llcorner   := 'À';
            vertical   := '³';
            horizontal := 'Ä';
        end;

        else
        begin
            urcorner   := '»';
            ulcorner   := 'É';
            lrcorner   := '¼';
            llcorner   := 'È';
            vertical   := 'º';
            horizontal := 'Í';
        end;

    end;

    fw(X1,Y1,Attr,Ulcorner+dup(Horizontal,X2-X1-1)+Urcorner);
    for I := Y1 + 1 to Y2 - 1 do
        fw(X1,I,Attr,Vertical+dup(' ',X2-X1-1)+Vertical);

    fw(X1,Y2,Attr,Llcorner+dup(Horizontal,X2-X1-1)+Lrcorner);

    if Style < 10 then
        if (X2 < 80) and (Y2 < 25) then

        begin

            Shadow := $07;

            if Y2 < 25 then
                set_attr([x1+2..x2+2],y2+1,shadow);

            for i := y1 + 1 to y2 + 1 do
                if i <= 25 then
                    set_attr([x2+1,x2+2],i,shadow);

        end;

end; {Pop_Window}


(* ---------------------------------------------------------------------- *)
procedure Pop_Message(X, Y: integer; Border, Attr: byte;
                         Mattr: byte; Message: string80);
          {Abre uma janela em (X,Y) em volta da mensagem 'message'.
          Se X for zero, a janela ‚ centralizada horizontalmente
          X,Y = Canto superior esquerdo da janela
          Border = 0, nenhuma; 1, simples; 2, dupla = com sombra
          Border = 10, nenhuma; 11, simples; 12, dupla = sem sombra
          Attr = Cor da borda
          Mattr = Cor da mensagem
          Message = Mensagem a ser exibida                          }

begin

    if X = 0 then
        X := 40 - ((length(Message) + 3) div 2);

    Pop_Window(X,Y,X+length(Message)+3,Y+2,Border,Attr);
    Fw(X+2,Y+1,Mattr,Message);
    gotoxy(X+length(Message)+2,Y+1);

end; {Pop_Message}


(* ---------------------------------------------------------------------- *)
procedure Pop_Window_Title(   X,Y,X1,Y1 : integer;
                           Border, Attr : byte;
                                  Tattr,
                                     Ty : byte;
                                  Title : string80);

          {Abre janela com coordenadas (X,Y,X1,Y1), como pop_window
          Title ser  centralizado na linha Ty na cor Tattr}

begin

    Pop_Window(X,Y,X1,Y1,Border,Attr);
    Fw((X+((X1-X) div 2) - (length(Title) div 2)),Ty,Tattr,+' '+Title+' ');

end; {Pop_Window_Title}

(* ---------------------------------------------------------------------- *)
function ValToChar(Valor: LongInt): string;
begin
    ValToChar := Chr(Valor+65);
end;

(* ---------------------------------------------------------------------- *)
function TrimVal4(w : Word) : String;
         {Ajusta um n£mero para quatro casas, colocando zero na frente, se
         necess rio.  Retorna o resultado numa string}

var
  s : String;

begin

    Str(w:0,s);
    if length(s) < 4 then s := '0' + s;
    if length(s) < 4 then s := '0' + s;
    if length(s) < 4 then s := '0' + s;
    if length(s) < 4 then s := '0' + s;
    TrimVal4 := s;

end;

(* ---------------------------------------------------------------------- *)
function TrimVal3(w : Word) : String;
         {Ajusta um n£mero para quatro casas, colocando zero na frente, se
         necess rio.  Retorna o resultado numa string}

var
  s : String;

begin

    Str(w:0,s);
    if length(s) < 3 then s := '0' + s;
    if length(s) < 3 then s := '0' + s;
    if length(s) < 3 then s := '0' + s;
    TrimVal3 := s;

end;

(* ---------------------------------------------------------------------- *)
function CopyInt(Valor:longint; Pos1, Len:byte) : longint;
var Valor1, Valor2 : longint;

     function DezA(X:byte) : longint;
     begin
         DezA := round(exp(ln(10)*X));
     end;

begin

    valor1 := (Valor div DezA(Pos1-Len));
    valor2 := (Valor div DezA(Pos1))*(DezA(Len));

    CopyInt := Valor1 - Valor2;

end;

(* ---------------------------------------------------------------------- *)
procedure CleanLines(Line1, Line2: integer);
          {Limpa linha LineNr}

var Str : string;
    C   : integer;

begin

    fillchar(Str, SizeOf(Str), ' ');
    Str[0] := #80;
    for C := Line1 to Line2 do
        FastWrite(1, C, Str, White, Black, Stype);

end;

(* ---------------------------------------------------------------------- *)
function StatusBar(total, amt : longint) : string;
         {Mostra uma barra de status com % done}
         {Entrada: Quantidade total, Quantidade feita}

Const BarLength = 40;
var a, b, c, d : longint;
    percent : real;
    st : string;

    function CharStr(quant: byte; char1: char): string;
    var  I : byte;
         str1 : string;
    begin
         str1 := '';
         for I := 1 to quant do str1 := str1 + char1;
         CharStr := str1;
    end;

begin

     if (Total = 0) or (Amt = 0) then
     begin
          StatusBar := '';
          exit;
     end;
     if (Amt > Total) then Amt := Total;
     Percent := Amt / Total * (Barlength * 10);
     A := trunc(Percent);
     B := A div 10;
     C := 1;
     Percent := amt / total * 100;
     D := Trunc(Percent);
     St := ' (' + IntToStr(D) + '%)';
     StatusBar := CharStr(b * c, #219) + CharStr(Barlength - (b * c), #176) + st;
end;


end. {Ernst Unit}