{ This file is generated with BasPas Version 0.602 from  March/17/2003, }
{ the Basic to Pascal Compiler from Andrea Tobian-Mezger }
{ http://groups.yahoo.com/group/BasPas }
Program BasPas;
uses
sysutils,dos;

TYPE
asel    = String[100];
lbn     = String[160];
libisin     = ARRAY[0..2500] of Byte;
FDATAB = RECORD
data : String[200];
next : Byte;
end;
FHEAD = RECORD
name 	: String[50];
exch    : String[50];
wo	: Integer;
end;
VAR

libdata		: ARRAY[0..2500] of FDATAB;
libid		: ARRAY[0..2500] of FHEAD;
isLibin     	: Array[0..20] of libisin;
libIncludes  	: ARRAY[0..20] of lbn;
basfile,pasfile,basic, basic1, dummy, dummy2, comment 	: AnsiString;
bPath,bName,bExt 					: String[200];
fhlb,fhid						: Integer;
zahl, mark, allsel, aktsel, tallsel         : Integer;
i,j,jj                                      : Integer;
ispas,linenumber,indent,libfound 	    : Integer;
xuse 	: Array[0..100] of Integer;
sel 	: Array[0..100] of asel;
bas,pas,tcon,tvar,ttyp,tbv,tpc,pp,incl,tbasf,tbasf2,tfunc,tforw		: Text;
Hour,Min,Sec,HSec : word;
Hour2,Min2,Sec2,HSec2 : word;
Function ExtractBP(ss : String;cc : String) : String;forward;
PROCEDURE OpenWriteBP(VAR fh : Text; name : String);forward;
PROCEDURE OpenReadBP(VAR fh : Text; name : String);forward;
Function TrimAllBP( s : String) : String;forward;
Procedure BPclearlibBP;forward;
Procedure BPLoadLibBP(thelib : String);forward;
Function RemainBP(ss : String;cc : String) : String;forward;
PROCEDURE OpenAppendBP(VAR fh : Text; name : String);forward;
Function ReplaceOutSBP(Var main: String; such : String; rep : String) : String;forward;
Function ReplaceBP(Var main: String; such : String; rep : String) : String;forward;
Function PRemainBP(ss : String;fxa : Byte) : String;forward;
Procedure ConnectFiles(q,z : AnsiString);forward;
PROCEDURE FPrintLF( s : AnsiString);forward;
Procedure LibWork;forward;
PROCEDURE noSemi;forward;
PROCEDURE XnoSemi;forward;
PROCEDURE makeSemi;forward;
PROCEDURE XmakeSemi;forward;
PROCEDURE headerparse;forward;
PROCEDURE parse;forward;
Function ExtractBP(ss : String;cc : String) : String;
VAR
fcxdb : Byte;
begin
fcxdb := Pos(cc,ss);
ExtractBP := LeftStr(ss,fcxdb-1);
END;
PROCEDURE OpenWriteBP(VAR fh : Text; name : String);
begin
Assign(fh,name);
Rewrite(fh);
END;
PROCEDURE OpenReadBP(VAR fh : Text; name : String);
begin
Assign(fh,name);
Reset(fh);
END;
Function TrimAllBP( s : String) : String;
VAR
i,l,x,y : Integer;
a : AnsiString;
begin
L := Length(s);
IF L > 0 THEN
  BEGIN
      For i := 1 to L DO
        BEGIN
            IF Byte(s[i]) > 32 THEN
              BEGIN
                  x := i;
                  BREAK;
              END;
        END;
      For i := L Downto 1 DO
        BEGIN
            IF Byte(s[i]) > 32 THEN
              BEGIN
                  y := i;
                  BREAK;
              END;
        END;
      For i := x to y DO
        BEGIN
            a:= a+ CHAR(s[i]);
        END;
  END
ELSE
  BEGIN
      a := '';
  END;
TRIMALLBP := a;
END;
Procedure BPclearlibBP;
VAR
i : Integer;
begin
For i := 0 to 2500 DO
  BEGIN
      libdata[i].data := '';
      libdata[i].next := 0;
      libid[i].name := '';
      libid[i].exch := '';
      libid[i].wo := 0;
  END;
END;
Procedure BPLoadLibBP(thelib : String);
begin
fhid := FileOpen(thelib+'.id',fmOpenRead);
FileRead(fhid,libid,sizeof(libid));
FileClose(fhid);
fhlb := FileOpen(thelib+'.lb',fmOpenRead);
FileRead(fhlb,libdata,sizeof(libdata));
FileClose(fhlb);
END;
Function RemainBP(ss : String;cc : String) : String;
VAR
fxa : Byte;
fxb : Byte;
begin
fxb := Length(ss);
fxa := Pos(cc,ss);
fxa := (fxb-fxa)+1;
RemainBP := RightStr(ss,fxa);
END;
PROCEDURE OpenAppendBP(VAR fh : Text; name : String);
begin
Assign(fh,name);
Append(fh);
END;
Function ReplaceOutSBP(Var main: String; such : String; rep : String) : String;
VAR
brack   : Array[0..40] of Integer;
dummy2,dummy3   : Ansistring;
d,h,x,lm,ln,inBRACK : Integer;
BEGIN
Repeat
    For h := 1 to 40 DO
      BEGIN
          brack[h] := 0;
      END;
    lm := Length(main);
    ln := Length(such);
    x := 0;
    IF (lm > ln) AND (ln > 0) AND (lm > 0) THEN
      BEGIN
          d := 0;
          For h := 1 to lm DO
            BEGIN
                IF main[h] = chr(39) THEN
                  BEGIN
                      brack[d] := h;
                      INC(d);
                      IF d = 40 THEN
                        BEGIN
                            BREAK;
                        END;
                  END;
            END;
          x := pos(UpCase(such),UpCase(main));
          inBRACK := 0;
          For h := 0 to 39 DO
            BEGIN
                IF (x > brack[h]) AND (x < brack[h+1]) THEN
                  BEGIN
                      dummy2 := LeftStr(main,brack[h+1]);
                      Delete(main,1,brack[h+1]);
                      dummy3 := dummy3 + dummy2;
                      inBRACK := 1;
                      BREAK;
                  END;
                INC(h);
            END;
          If (inBRACK = 0 ) and (x > 0) and (x < (lm-ln)+1) then
            BEGIN
                dummy2 := LeftStr(main,x-1);
                dummy3 := dummy3 + dummy2 + rep;
                Delete(main,1,(x+ln)-1);
            END;
      END;
Until x = 0;
main := dummy3 + main;
ReplaceOutSBP := main;
END;
Function ReplaceBP(Var main: String; such : String; rep : String) : String;
Var
x,ln,lm : Integer;
astr : String;
begin
astr := main;
lm := Length(main);
ln := Length(such);
x := pos(such,astr);
If (x > 0) and (x < ((lm-ln)+1)) then
  BEGIN
      Delete(astr,x,ln);
      Insert(rep,astr,x);
  END;
ReplaceBP := astr;
END;
Function PRemainBP(ss : String;fxa : Byte) : String;
VAR
fxb : Byte;
begin
fxb := Length(ss);
fxa := (fxb-fxa)+1;
PRemainBP := RightStr(ss,fxa);
END;
Procedure ConnectFiles(q,z : AnsiString);
VAR
fq,fz : Text;
zt : Ansistring;
begin
OpenAppendBP(fq,q);
OpenReadBP(fz,z);
While not eof(fz) DO
  BEGIN
      Readln(fz,zt);
      Writeln(fq,zt);
END;
Close(fz);
Close(fq);

END;
PROCEDURE FPrintLF( s : AnsiString);
VAR
xs : AnsiString;
begin
IF indent > 0 THEN
  BEGIN
      xs := StringofChar(' ',indent);
  END
ELSE
  BEGIN
      xs := '';
      indent := 0;
  END;
s := xs + s;
if ispas = 1 then
  BEGIN
      Writeln(pas,s);
  END
ELSE
  BEGIN
      Writeln(tpc,s);
  END;

END;
Procedure LibWork;
VAR

numb,k,tz,index,merk  : Integer;

begin
numb := 0;
index := 0;
merk := 0;
While not eof(tbasf) DO
  BEGIN
      Readln(tbasf,basic);
      
      
      dummy := UpCASE(basic);
      basic := ' ' + basic + ' ';
      dummy := ' ' + dummy + ' ';
      For k := 0 to 2500 DO
        BEGIN
            IF libid[k].exch = '' THEN
              BEGIN
                  BREAK;
              END;
            merk := 0;
            Repeat
                REPEAT
                    merk := numb;
                    numb := Pos(TrimAllBP(UpCASE(libid[k].exch)),dummy);
                    
                    
                    IF numb > 0 THEN
                      BEGIN
                          
                          tz := Length(libid[k].exch);
                          
                          
                          IF numb > 0 THEN
                            BEGIN
                                IF (Byte(basic[numb-1]) > 47 ) AND (Byte(basic[numb-1]) < 58) THEN
                                  BEGIN
                                      BREAK;
                                  END;
                                IF (Byte(basic[numb-1]) > 64 ) AND (Byte(basic[numb-1]) < 91) THEN
                                  BEGIN
                                      BREAK;
                                  END;
                                IF (Byte(basic[numb-1]) > 96 ) AND (Byte(basic[numb-1]) < 123) THEN
                                  BEGIN
                                      BREAK;
                                  END;
                                IF Byte(basic[numb-1]) = 95   THEN
                                  BEGIN
                                      BREAK;
                                  END;
                            END;
                          IF numb < ((Length(basic)-tz)+1) THEN
                            BEGIN
                                IF (Byte(basic[numb+tz]) > 47 ) AND (Byte(basic[numb+tz]) < 58) THEN
                                  BEGIN
                                      BREAK;
                                  END;
                                IF (Byte(basic[numb+tz]) > 64 ) AND (Byte(basic[numb+tz]) < 91) THEN
                                  BEGIN
                                      BREAK;
                                  END;
                                IF (Byte(basic[numb+tz]) > 96 ) AND (Byte(basic[numb+tz]) < 123) THEN
                                  BEGIN
                                      BREAK;
                                  END;
                                IF Byte(basic[numb+tz]) = 95   THEN
                                  BEGIN
                                      BREAK;
                                  END;
                            END;
                          IF isLibin[j][k] = 0 THEN
                            BEGIN
                                libfound := 1;
                                index := libid[k].wo;
                                dummy2 := libdata[index].data;
                                IF libdata[index].next = 1 THEN
                                  BEGIN
                                      WHILE libdata[index].next = 1 DO
                                        BEGIN
                                            INC(index);
                                            dummy2 := dummy2+libdata[index].data;
                                      END;
                                  END;
                                
                                Writeln(tfunc,TrimAllBP(dummy2));
                                isLibin[j][k] := 1;
                            END;
                          
                          basic := ReplaceOutSBP(basic,TrimAllBP(libid[k].exch),libid[k].name);
                          
                          
                      END;
                UNTIL true;
                
                IF merk = numb THEN
                  BEGIN
                      BREAK;
                  END;
                dummy := UpCase(basic);
            Until numb = 0;
        END;
      Writeln(tbasf2,TrimAllBP(basic));
      
END;
END;
PROCEDURE noSemi;
begin
basic := basic + comment;
FPrintLF(basic);
END;
PROCEDURE XnoSemi;
begin

If basic <> '' then
  BEGIN
      basic := ReplaceBP(basic,'=',':=');
      basic := basic + comment;
      FPrintLF(basic);
      
  END;
END;
PROCEDURE makeSemi;
begin
basic := basic + ';';
FPrintLF(basic);

END;
PROCEDURE XmakeSemi;
begin

IF basic <> '' then
  BEGIN
      zahl := Length(basic);
      IF basic[zahl] <> '_' then
        BEGIN
            basic := ReplaceBP(basic,'=',':=');
            basic := basic + ';';
            FPrintLF(basic);
        END
      ELSE
        BEGIN
            basic[zahl] := chr(95);
            XnoSemi;
        END;
      
  END
ELSE
  BEGIN
      basic := basic + comment;
      FPrintLF(basic);
  END;

END;
PROCEDURE headerparse;
begin

dummy := '';
dummy2 := '';
basic1 := '';
basic1 := TrimAllBP(UpCase(basic));

REPEAT
    IF basic1 = 'BEGIN' THEN
      BEGIN
          basic := basic + comment;
          mark := 0;
          FPrintLF(basic);
      BREAK;
      END;
    IF basic1 = 'CONST' THEN
      BEGIN
          mark := 2;
          basic := basic + comment;
          Writeln(tcon,basic);
      BREAK;
      END;
    IF basic1  = 'VAR' THEN
      BEGIN
          mark := 3;
          basic :=  comment;
          Writeln(tvar,basic);
      BREAK;
      END;
    IF basic1  = 'TYPE' THEN
      BEGIN
          mark := 4;
          basic := basic + comment;
          Writeln(ttyp,basic);
      BREAK;
      END;
    IF basic1  = 'USES' THEN
      BEGIN
          mark := 5;
          basic := basic + comment;
          Writeln(tbv,basic);
          
          BREAK;
      END
    ELSE
      BEGIN
          IF (RightStr(basic1,7) = ' RECORD') or (RightStr(basic1,7) = '=RECORD') THEN
            BEGIN
                Writeln(ttyp,basic);
            END
          ELSE
            BEGIN
                REPEAT
                    IF mark  = 1 THEN
                      BEGIN
                          basic := basic + ';';
                          Writeln(tbv,basic);
                      BREAK;
                      END;
                    IF mark  = 2 THEN
                      BEGIN
                          basic := basic + ';';
                          Writeln(tcon,basic);
                      BREAK;
                      END;
                    IF mark  = 3 THEN
                      BEGIN
                          basic := basic + ';';
                          Writeln(tvar,basic);
                      BREAK;
                      END;
                    IF mark  = 4 THEN
                      BEGIN
                          basic := basic + ';';
                          Writeln(ttyp,basic);
                      BREAK;
                      END;
                    IF mark  = 5 THEN
                      BEGIN
                          basic := basic + ';';
                          Writeln(tbv,basic);
                          BREAK;
                      END
                    ELSE
                      BEGIN
                          basic := basic + ';';
                          Writeln(tbv,basic);
                      END;
                UNTIL true;
            END;
          
      END;
UNTIL true;
END;
PROCEDURE parse;
begin

dummy := '';
dummy2 := '';
basic1 := '';
basic1 := TrimAllBP(UpCase(basic));
REPEAT
    
    
    
    
    IF basic1[1] = '?' THEN
      BEGIN
          Delete(basic,1,1);
          IF TrimAllBP(basic) <> '' then
            BEGIN
                zahl := LongInt(Length(basic));
                If basic[zahl] = Chr(34) then
                  BEGIN
                      
                      basic[zahl] := chr(39);
                  END;
                If basic[1] = Chr(34) then
                  BEGIN
                      basic[1] := chr(39);
                  END;
            END;
          basic := 'Writeln (' + basic +');';
          noSemi;
          
          
      BREAK;
      END;
    IF basic1[1] = 'B' THEN
      BEGIN
          Repeat
          IF basic1 = 'BEGIN' THEN
            Begin
                noSemi;
                
            BREAK;
            END;
          IF  LeftStr(basic1,10) = 'BREAKLOOP ' THEN
            BEGIN
                FPrintLF('BREAK;');
                BREAK;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          UNTIL true;
          
          
      BREAK;
      END;
    IF basic1[1] = 'C' THEN
      BEGIN
          
          
          IF basic1 = 'CONST' THEN
            BEGIN
                noSemi;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
      BREAK;
      END;
    IF basic1[1] = 'D' THEN
      BEGIN
          IF LeftStr(basic1,4) = 'DIM ' then
            BEGIN
                Delete(basic,1,4);
                zahl:= Pos(':',basic);
                IF zahl > 1 THEN
                  BEGIN
                      dummy := LeftStr(basic,zahl-1);
                      dummy2 := PRemainBP(basic,zahl+1);
                      basic := dummy + ' : ' + dummy2 + ';';
                      Writeln(tvar,basic);
                  END
                ELSE
                  BEGIN
                      zahl:= Pos('as',basic);
                      IF zahl > 1 THEN
                        BEGIN
                            dummy := LeftStr(basic,zahl-1);
                            dummy2 := PRemainBP(basic,zahl+2);
                            basic := dummy + ' : ' + dummy2 + ';';
                            Writeln(tvar,basic);
                        END;
                  END;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
      BREAK;
      END;
    IF basic1[1] = 'E' THEN
      BEGIN
          Repeat
          IF (basic1 = 'END IF') OR (basic1 = 'ENDIF')  THEN
            Begin
                indent := indent - 4;
                basic := 'END;';
                noSemi;
                indent := indent -2;
            BREAK;
            END;
          IF  basic1 = 'END SELECT' THEN
            BEGIN
                DEC(aktsel);
                DEC(tallsel);
                indent := indent;
                indent := indent - 4;
                FPrintLF('END;');
                indent := indent - 6;
                basic := 'UNTIL true;';
                noSemi;
                xuse[aktsel] := 0;
            BREAK;
            END;
          IF  (basic1 = 'ENDPROC') OR (basic1 = 'END PROC') OR (basic1 = 'END PROCEDURE') THEN
            BEGIN
                indent := 0;
                basic := 'END;';
                noSemi;
                ispas := 1;
            BREAK;
            END;
          IF  (basic1 = 'ENDFUNC') OR (basic1 = 'END FUNC') OR (basic1 = 'END FUNCTION') THEN
            BEGIN
                indent := 0;
                basic := 'END;';
                noSemi;
                ispas := 1;
            BREAK;
            END;
          IF  (basic1 = 'END WHEN') OR (basic1 = 'ENDWHEN') THEN
            BEGIN
                indent := indent - 4;
                FPrintLF('END;');
                indent := indent - 2;
                basic := 'UNTIL true;';
                noSemi;
            BREAK;
            END;
          IF  basic1 = 'END.' THEN
            BEGIN
                indent := 0;
                basic := 'END.';
                noSemi;
            BREAK;
            END;
          IF  ( basic1 = 'ELSE') OR (basic1 = 'ELSETHEN') OR (basic1 = 'ELSE THEN') OR (basic1 = 'ELSEIF') OR (basic1 = 'ELSE IF') THEN
            BEGIN
                indent := indent - 4;
                FPrintLF('END');
                indent := indent - 2;
                basic := 'ELSE';
                noSemi;
                indent := indent + 2;
                FPrintLF('BEGIN');
                indent := indent + 4;
            BREAK;
            END;
          IF   (basic1 = 'ELSEWHEN') OR (basic1 = 'ELSE WHEN') OR (basic1 = 'ELSEUSE') OR (basic1 = 'ELSE USE')  THEN
            BEGIN
                FPrintLF('BREAK;');
                indent := indent - 4;
                FPrintLF('END');
                indent := indent - 2;
                basic := 'ELSE';
                noSemi;
                indent := indent + 2;
                FPrintLF('BEGIN');
                indent := indent + 4;
            BREAK;
            END;
          IF  basic1 = 'ELSES' THEN
            BEGIN
                indent := indent - 6;
                basic := 'ELSE';
                FPrintLF('END');
                noSemi;
            BREAK;
            END;
          IF  basic1 = 'EXITLOOP' THEN
            BEGIN
                FPrintLF('BREAK;');
                
                BREAK;
            END
          ELSE
            BEGIN
                
                XmakeSemi;
                
            END;
          UNTIL true;
          
          
      BREAK;
      END;
    IF basic1[1] = 'F' THEN
      BEGIN
          Repeat
          IF LeftStr(basic1,4) = 'FOR ' then
            Begin
                IF RightStr(basic1,2) = 'DO' then
                  BEGIN
                      dummy := ReplaceBP(basic,'=',':=');
                      noSemi;
                  END
                ELSE
                  BEGIN
                      dummy := ReplaceBP(basic,'=',':=');
                      basic := dummy + ' DO';
                      noSemi;
                      indent := indent + 2;
                      FPrintLF('BEGIN');
                      indent := indent + 4;
                  END;
                
            BREAK;
            END;
          IF  LeftStr(basic1,9) = 'FUNCTION ' THEN
            BEGIN
                ispas := 0;
                makeSemi;
                
                BREAK;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          UNTIL true;
          
      BREAK;
      END;
    IF basic1[1] = 'I' THEN
      BEGIN
          Repeat
          IF LeftStr(basic1,3) = 'IF ' then
            Begin
                dummy := RightStr(basic1,5);
                IF dummy = ' THEN' then
                  BEGIN
                      noSemi;
                      indent := indent + 2;
                      FPrintLF('BEGIN');
                      indent := indent + 4;
                  END
                ELSE
                  BEGIN
                      zahl := Pos(' THEN',basic1);
                      IF zahl > 0 then
                        BEGIN
                            zahl := Pos('THEN',UPCASE(basic));
                            dummy := ExtractBP(UPCASE(basic),'THEN');
                            dummy2 := PRemainBP(basic,zahl+4);
                            dummy2 := ReplaceBP(dummy2,'=',':=');
                            basic := dummy + dummy2 + ';';
                            noSemi;
                            
                        END
                      ELSE
                        BEGIN
                            basic := basic + ' THEN';
                            noSemi;
                            indent := indent + 2;
                            FPrintLF('BEGIN');
                            indent := indent + 4;
                        END;
                  END;
                
            BREAK;
            END;
          IF   LeftStr(basic1,8) = 'PINCLUDE ' then
            BEGIN
                Delete(basic,1,8);
                TrimAllBP(basic);
                basic := chr(123)+'$I '+basic+chr(125);
                noSemi;
                BREAK;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          UNTIL true;
      BREAK;
      END;
    IF basic1[1] = 'N' THEN
      BEGIN
          IF LeftStr(basic1,5) = 'NEXT ' THEN
            BEGIN
                indent := indent - 4;
                FPrintLF('END;');
                indent := indent - 2;
                
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          
      BREAK;
      END;
    IF basic1[1] = 'O' THEN
      BEGIN
          IF (LeftStr(basic1,7) = 'ORWHEN ') OR (LeftStr(basic1,8) = 'OR WHEN ') THEN
            BEGIN
                indent := indent - 4;
                Delete(basic,1,7);
                dummy := RightStr(basic1,5);
                IF dummy = ' THEN' then
                  BEGIN
                      basic := 'IF ' + basic;
                  END
                ELSE
                  BEGIN
                      basic := 'IF ' + basic + ' THEN';
                  END;
                FPrintLF('BREAK;');
                FPrintLF('END;');
                indent := indent - 2;
                noSemi;
                indent := indent + 2;
                FPrintLF('BEGIN');
                indent := indent + 4;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          
      BREAK;
      END;
    IF basic1[1] = 'P' THEN
      BEGIN
          IF LeftStr(basic1,10) = 'PROCEDURE ' THEN
            BEGIN
                ispas := 0;
                makeSemi;
                
                
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          
      BREAK;
      END;
    IF basic1[1] = 'R' THEN
      BEGIN
          IF basic1 = 'REPEAT' THEN
            BEGIN
                noSemi;
                indent := indent + 4;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          
          
          
      BREAK;
      END;
    IF basic1[1] = 'S' THEN
      BEGIN
          IF LeftStr(basic1,7) = 'SELECT ' THEN
            BEGIN
                Delete(basic,1,6);
                sel[aktsel] := TrimAllBP(basic);
                INC(aktsel);
                INC(allsel);
                tallsel := allsel;
                basic := 'REPEAT';
                noSemi;
                indent := indent + 4;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          
      BREAK;
      END;
    IF basic1[1] = 'T' THEN
      BEGIN
          Repeat
          IF basic1 = 'THEN' THEN
            Begin
                FPrintLF('BEGIN');
            BREAK;
            END;
          IF   basic1 = 'TYPE' THEN
            BEGIN
                noSemi;
                BREAK;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          UNTIL true;
      BREAK;
      END;
    IF basic1[1] = 'U' THEN
      BEGIN
          Repeat
          IF  LeftStr(basic1,6) = 'UNTIL ' THEN
            Begin
                indent := indent - 4;
                makeSemi;
            BREAK;
            END;
          IF  LeftStr(basic1,4) = 'USE ' THEN
            BEGIN
                Delete(basic,1,3);
                basic := sel[aktsel-1] + basic;
                basic := 'IF ' + basic + ' THEN';
                IF xuse[aktsel-1] = 0 then
                  BEGIN
                      xuse[aktsel-1] := 1;
                      noSemi;
                      indent := indent + 2;
                      FPrintLF( 'BEGIN');
                      indent := indent + 4;
                      
                  END
                ELSE
                  BEGIN
                      indent := indent - 4;
                      INC( xuse[aktsel-1]);
                      FPrintLF('BREAK;');
                      FPrintLF('END;');
                      indent := indent -2;
                      noSemi;
                      indent := indent + 2;
                      FPrintLF('BEGIN');
                      indent := indent + 4;
                  END;
                
                BREAK;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          UNTIL true;
      BREAK;
      END;
    IF basic1[1] = 'V' THEN
      BEGIN
          IF basic1 = 'VAR' THEN
            BEGIN
                noSemi;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          
          
      BREAK;
      END;
    IF basic1[1] = 'W' THEN
      BEGIN
          Repeat
          IF  LeftStr(basic1,6) = 'WHILE ' THEN
            Begin
                basic := basic + ' DO';
                noSemi;
                indent := indent + 2;
                FPrintLF('BEGIN');
                indent := indent + 4;
            BREAK;
            END;
          IF  basic1 = 'WEND' THEN
            BEGIN
                indent := indent - 6;
                basic := 'END;';
                noSemi;
            BREAK;
            END;
          IF  basic1 = 'WITH' THEN
            BEGIN
                noSemi;
            BREAK;
            END;
          IF  LeftStr(basic1,5) = 'WHEN ' THEN
            BEGIN
                basic := TrimAllBP(basic);
                Delete(basic,1,5);
                dummy := RightStr(basic1,5);
                IF dummy = ' THEN' then
                  BEGIN
                      basic := 'IF ' + basic;
                  END
                ELSE
                  BEGIN
                      basic := 'IF ' + basic + ' THEN';
                  END;
                FPrintLF('Repeat');
                noSemi;
                indent := indent + 2;
                FPrintLF('Begin');
                indent := indent + 4;
                BREAK;
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          UNTIL true;
      BREAK;
      END;
    IF basic1[1] = '_' THEN
      BEGIN
          IF basic1 = '+PAS' THEN
            BEGIN
                Repeat
                    Readln(bas,basic);
                    basic := TrimAllBP(basic);
                    IF UpCase(basic) = '-PAS' THEN
                      BEGIN
                          BREAK;
                      END
                    ELSE
                      BEGIN
                          FPrintLF(basic);
                      END;
                UNTIL eof(bas);
            END
          ELSE
            BEGIN
                XmakeSemi;
            END;
          BREAK;
      END
    ELSE
      BEGIN
          XmakeSemi;
          
      END;
UNTIL true;
END;




begin

GetTime(Hour,Min,Sec,HSec);

basfile := Paramstr(1);
FSplit(ParamStr(0),bPath,bName,bExt);

dummy := ExtractBP(basfile,'.');
pasfile := dummy + '.pas';
mark := 1;
ispas := 1;
linenumber := 0;
indent := 0;
If FileExists(basfile) then
  BEGIN
      Writeln ( 'You compile ',basfile,' with BasPas Version 0.602');
      Writeln ( 'Written by Andrea Tobian-Mezger 2003');
      Writeln ();
      Writeln ( 'Show also on:  http://groups.yahoo.com/group/BasPas');
      Writeln ( 'for informations and files');
      Writeln ();
      For i := 0 to 20 DO
        BEGIN
            libIncludes[i] := '';
        END;
      
      OpenWriteBP(tbasf,'tbasfile');
      OpenReadBP(bas,basfile);
      
      While not eof(bas) DO
        BEGIN
            Readln(bas,basic);
            basic := TrimAllBP(basic);
            IF (basic <> '') AND (LENGTH(basic) > 8) THEN
              BEGIN
                  IF LeftStr(basic,8) <> 'INCLUDE ' THEN
                    BEGIN
                        IF LeftStr(basic,11) <> 'INCLUDELIB ' THEN
                          BEGIN
                              Writeln(tbasf,basic);
                          END
                        ELSE
                          BEGIN
                              Delete(basic,1,11);
                              For i := 1 to 20 DO
                                BEGIN
                                    IF libIncludes[i] = '' THEN
                                      BEGIN
                                          IF UpCase(basic) <> 'BASPASLIB' THEN
                                            BEGIN
                                                libIncludes[i] := bpath + TrimAllBP(basic);
                                                Writeln ( libIncludes[i]);
                                            END;
                                          BREAK;
                                      END;
                                END;
                          END;
                    END
                  ELSE
                    BEGIN
                        Delete(basic,1,8);
                        basic := TrimAllBP(basic);
                        If FileExists(basic) then
                          BEGIN
                              OpenReadBP(incl,basic);
                              WHILE NOT eof(incl) DO
                                BEGIN
                                    Readln(incl,basic);
                                    Writeln(tbasf,basic);
                              END;
                              CLOSE(incl);
                          END;
                    END;
              END
            ELSE
              BEGIN
                  Writeln(tbasf,basic);
              END;
            
      END;
      libIncludes[0]:= bpath + 'BASPASLIB';
      Close(bas);
      CLOSE(tbasf);
      IF Paramstr(2) <> UpCase('-nolibs') THEN
        BEGIN
            For jj := 0 to 20 DO
              BEGIN
                  For j := 0 to 2500 DO
                    BEGIN
                        isLibin[jj][j] := 0;
                    END;
              END;
            OpenWriteBP(tfunc,'tfunc.bbb');
            
            
            For j := 0 to 20 DO
              BEGIN
                  IF libIncludes[j] = '' THEN
                    BEGIN
                        
                        BREAK;
                    END
                  ELSE
                    BEGIN
                        
                        BPclearlibBP;
                        
                        BPLoadLibBP(libIncludes[j]);
                        
                        OpenReadBP(tbasf,'tbasfile');
                        
                        OpenWriteBP(tbasf2,'tbasfile2');
                        
                        LibWork;
                        
                        Close(tbasf2);
                        Close(tbasf);
                        DeleteFile('tbasfile');
                        RenameFile('tbasfile2','tbasfile');
                        DeleteFile('tbasfile2');
                    END;
              END;
            
            
            Close(tfunc);
            
            libfound := 1;
            While libfound = 1 DO
              BEGIN
                  libfound  := 0;
                  For j := 0 to 20 DO
                    BEGIN
                        
                        IF libIncludes[j] = '' THEN
                          BEGIN
                              
                              BREAK;
                          END
                        ELSE
                          BEGIN
                              BPclearlibBP;
                              
                              BPLoadLibBP(libIncludes[j]);
                              
                              OpenReadBP(tbasf,'tfunc.bbb');
                              
                              OpenWriteBP(tfunc,'tfunc2.bbb');
                              OpenWriteBP(tbasf2,'tbasfile2');
                              
                              LibWork;
                              
                              Close(tfunc);
                              Close(tbasf2);
                              Close(tbasf);
                              DeleteFile('tfunc.bbb');
                              ConnectFiles('tfunc2.bbb','tbasfile2');
                              RenameFile('tfunc2.bbb','tfunc.bbb');
                              DeleteFile('tfunc2.bbb');
                              DeleteFile('tbasfile2');
                          END;
                        
                    END;
            END;
            
            {Connect the Functions/Procedures to Basicsource}
            OpenReadBP(tbasf,'tbasfile');
            OpenWriteBP(tbasf2,'tbasfile2');
            OpenWriteBP(tforw,'tforward');
            I := 0;
            While not eof(tbasf) DO
              BEGIN
                  Readln(tbasf,dummy);
                  IF  (LeftStr(UpCase(dummy),9) = 'FUNCTION ') or  (LeftStr(UpCase(dummy),10) = 'PROCEDURE ') THEN
                    BEGIN
                        Writeln(tforw,dummy + ';forward;');
                    END;
                  Writeln(tbasf2,dummy);
                  IF (LeftStr(UpCase(dummy),5) = 'BEGIN') AND (I=0) THEN
                    BEGIN
                        I := 1;
                        OpenReadBP(tfunc,'tfunc.bbb');
                        While not eof(tfunc) DO
                          BEGIN
                              Readln(tfunc,dummy2);
                              IF  (LeftStr(UpCase(dummy2),9) = 'FUNCTION ') or  (LeftStr(UpCase(dummy2),10) = 'PROCEDURE ') THEN
                                BEGIN
                                    Writeln(tforw,dummy2 + ';forward;');
                                END;
                              Writeln(tbasf2,dummy2);
                        END;
                    END;
            END;
            Close(tforw);
            Close(tfunc);
            Close(tbasf);
            Close(tbasf2);
            DeleteFile('tbasfile');
            RenameFile('tbasfile2','tbasfile');
        END;
      
      
      
      OpenReadBP(bas,'tbasfile');
      OpenWriteBP(pas,'tpas');
      OpenWriteBP(tcon,'tconst');
      OpenWriteBP(tvar,'tvar');
      Writeln(tvar,'VAR');
      OpenWriteBP(ttyp,'ttyp');
      OpenWriteBP(tbv,'tbevor');
      OpenWriteBP(tpc,'tprocs');
      {Write forward; Functions/Procedures}
      OpenReadBP(tforw,'tforward');
      While not eof(tforw) DO
        BEGIN
            Readln(tforw,dummy);
            Writeln(tpc,dummy);
      END;
      Close(tforw);
      DeleteFile('tforward');
      While not eof(bas) DO
        BEGIN
            comment := '';
            basic := '';
            Readln(bas,basic);
            INC(linenumber);
            
            TrimAllBP(basic);
            
            IF (basic <> '')  then
              BEGIN
                  IF Pos(chr(123),basic) > 0 then
                    BEGIN
                        
                        comment := RemainBP(basic,chr(123));
                        basic := ExtractBP(basic,chr(123));
                        basic := TrimAllBP(basic);
                    END;
                  
                  TrimAllBP(basic);
                  IF (basic <> '')  then
                    BEGIN
                        zahl := Length(basic);
                        IF (basic[zahl] = ':') OR (basic[zahl] = ';') then
                          BEGIN
                              noSemi;
                          END
                        ELSE
                          BEGIN
                              If mark = 0 then
                                BEGIN
                                    parse;
                                END;
                              If mark > 0 then
                                BEGIN
                                    headerparse;
                                END;
                          END;
                    END
                  ELSE
                    BEGIN
                        noSemi;
                    END;
              END
            ELSE
              BEGIN
                  
                  noSemi;
              END;
            
      END;
      Close(tpc);
      Close(tbv);
      Close(ttyp);
      Close(tvar);
      Close(tcon);
      Close(pas);
      Close(bas);
      OpenWriteBP(pp,pasfile);
      dummy := chr(123) + ' This file is generated with BasPas Version 0.602 from  March/17/2003, ' + chr(125);
      Writeln(pp,dummy);
      dummy := chr(123) + ' the Basic to Pascal Compiler from Andrea Tobian-Mezger ' + chr(125);
      Writeln(pp,dummy);
      dummy := chr(123) + ' http://groups.yahoo.com/group/BasPas ' + chr(125);
      Writeln(pp,dummy);
      OpenReadBP(tbv,'tbevor');
      Repeat
          Readln(tbv,dummy);
          Writeln(pp,dummy);
      Until eof(tbv);
      CLOSE(tbv);
      OpenReadBP(tcon,'tconst');
      Repeat
          Readln(tcon,dummy);
          Writeln(pp,dummy);
      Until eof(tcon);
      CLOSE(tcon);
      OpenReadBP(ttyp,'ttyp');
      Repeat
          Readln(ttyp,dummy);
          Writeln(pp,dummy);
      Until eof(ttyp);
      CLOSE(ttyp);
      OpenReadBP(tvar,'tvar');
      Repeat
          Readln(tvar,dummy);
          Writeln(pp,dummy);
      Until eof(tvar);
      CLOSE(tvar);
      OpenReadBP(tpc,'tprocs');
      Repeat
          Readln(tpc,dummy);
          Writeln(pp,dummy);
      Until eof(tpc);
      CLOSE(tpc);
      OpenReadBP(pas,'tpas');
      Repeat
          Readln(pas,dummy);
          Writeln(pp,dummy);
      Until eof(pas);
      CLOSE(pas);
      CLOSE(pp);
      DeleteFile('tbevor');
      DeleteFile('tconst');
      DeleteFile('ttyp');
      DeleteFile('tvar');
      DeleteFile('tprocs');
      DeleteFile('tpas');
      DeleteFile('tbasfile');
      DeleteFile('tfunc.bbb');
      GetTime(Hour2,Min2,Sec2,HSec2);
      Writeln ( 'from Hour:',Hour,' Min:',Min,' Sec:',sec,' hsec:',hsec);
      Writeln ( 'to   Hour:',Hour2,' Min:',Min2,' Sec:',sec2,' hsec:',hsec2);
      Writeln ( 'even out rake, promotes the brain achievement:)');
      Writeln ( '-----------BasPas End------------------------------');
  END;



{----------------------------------------------------------------}
{...........................................................................}













END.

