Inteligentný prevod TXT->DBF

{ TXTDBF.PAS                Copyright (c) TrSek alias Zdeno Sekerak }
{ ----------------------------------------------------------------- }
{ Inteligentny prevod TXT->DBF                                      }
{ Ak najde formular (*.frm) tak pracuje podla neho inac             }
{ si vytvory sam formu a dalej pokracuje                            }
{ Datum:28.05.96                              http://www.trsek.com  }
{ ----------------------------------------------------------------- }
{ Chybovnik                                                         }
{ 2-neexistuje vstupny subor, alebo nemozno zapisovat               }
{ 3-nemozem zapisovat do predvoleneho DBF                           }
{ 4-nemozem zapisovat do FRM suboru                                 }
{ 5-nemozem otvorit FRM subor                                       }
{ 6-pri zapisovani do DBF doslo k chybe                             }
{ ----------------------------------------------------------------- }
{ Parametre                                                         }
{ txtdbf.exe %1 %2 %3 [/switches]                                   }
{ %1 vstupny textovy subor                                          }
{ %2 vystupny DBF subor                                             }
{ %3 meno formulara                                                 }
{ switches /n nepis nic na obrazovku                                }
{ ----------------------------------------------------------------- }
 
{$M 32768,0,655350}
program easy_txt_dbf;
 
uses crt,dos;
 
const MinMem=5000;      { Minimalne nechaj 5000 KB pamate }
      max_viet=100;     { max - kolko moze byt maximalne premennych v 1 vete }
      MaxCH=3;          { Maximalny pocet chyb }
      Chybovnik: array[1..MaxCH] of string =
      ('Malo pamete',
       'Nemozem otvorit, alebo zapisovat do suboru.',
       'Nebol zadany ziaden parameter');
 
type  pole = array[0..32768] of char;
      premenna=(C,L,N,D);
                       { typ premennej C-retazec, L-logicka, N-numericka }
                       {               D-datum }
   hlava=record                     { typ tzv. hlavy DBF blizie informacie }
     nazov: array[1..11] of char;   { na horeuvedenej adrese }
     typep: char;
       zac: word;
      od_r: integer;
      size: byte;
     desat: byte;
      do_r: integer;
     end;
 
var InF,OutF : file;                 { Vstupno vystupne subory }
    HandI, HandO : ^pole;            { Smerniky na in out v pameti }
    riadok : string;                 { Precitany riadok zo suboru }
    vypis : boolean;                 { Vypisovat nieco na obrazovku ??? }
    EOFI, EOFO : boolean;            { Je koniec suboru nacitaneho ??? }
    in_file, out_file, frm_file : string;   { nazvy suborov }
    TotI, CurI : Longint;            { IN Celkova dlzka, aktualna pozicia }
    DlzHI, DlzI, RelI : Word;        { IN kolko je pamete pre precitanie, precitana dlzka, pozicia v precitanej dlzke  }
    TotO, CurO : Longint;            { OUT Celkova dlzka, aktualna pozicia}
    DlzHO, DlzO, RelO : Word;        { OUT Kolko je pamete pre precitanie, precitana dlzka, pozicia v precitanej dlzke  }
 
    PocH : integer;                  { pocet hlav }
    Cria : integer;                  { minimalne pozadovana sirka riadka }
    base : array[1..max_viet] of string;   { polozky jednej vety                  }
    hlavy : array[1..max_viet] of hlava;   { hlavy (popisy) kazdej z poloziek     }
    nothing: string;                 { pre prazdnu premennu }
 
 
{ Vyhlasuje chyby }
procedure chyba( err : byte );
begin
 if( vypis ) then begin
   WriteLn('Nastala chyba c.:',err );
   if err > MaxCH then WriteLn('Blizsie neviem definovat tuto chybu.')
                  else WriteLn('Popis:',Chybovnik[ err ] );
  end;
 { Uvolnime pamet }
 if( HandI <> NIL )then FreeMem( HandI, DlzHI );
 if( HandO <> NIL )then FreeMem( HandO, DlzHO );
 { Vratime errorlevel do systemu }
 halt( err );
end;
 
 
{ zobrazi pomoc }
procedure Help( i:integer );
begin
 WriteLn;
 WriteLn('Inteligentny prevod TXT->DBF                                      ');
 WriteLn('Software by TRSEK alias Zdeno Sekerak, www.trsek.com              ');
 WriteLn('Ak najde formular (*.frm) tak pracuje podla neho inac             ');
 WriteLn('si vytvory sam formular a dalej pokracuje                         ');
 WriteLn('------------------------------------------------------------------');
 WriteLn('Chybovnik                                                         ');
 WriteLn(' 2-neexistuje vstupny subor, alebo nemozno zapisovat              ');
 WriteLn(' 3-nemozem zapisovat do DBF suboru                                ');
 WriteLn(' 4-nemozem zapisovat do FRM suboru                                ');
 WriteLn('------------------------------------------------------------------');
 WriteLn('Parametre                                                         ');
 WriteLn('txtdbf.exe %1 %2 %3 [/switches]                                   ');
 WriteLn('%1 vstupny textovy subor                                          ');
 WriteLn('%2 vystupny DBF subor                                             ');
 WriteLn('%3 meno formulara                                                 ');
 WriteLn('switches /n nepis nic na obrazovku                                ');
 WriteLn('         /h vypis help na obrazovku                               ');
 Chyba(3);
end;
 
 
{ Nastavi Default hodnoty }
procedure Default;
var i : integer;
begin
                                      { nazvy suborov }
 in_file:='zasoby.job'; out_file:='zasoby.dbf'; frm_file:='zasoby.frm';
 nothing:='';for i:=1 to 255 do nothing:=nothing+' ';
 HandI:=NIL; HandO := NIL;            { Smerniky na in out v pameti }
 riadok := '';                        { Precitany riadok zo suboru }
 vypis := True;                       { Vypisovat nieco na obrazovku ??? }
 TotI:=0; CurI:=0; DlzI:=0; RelI:=0;  { IN Celkova dlzka, aktualna pozicia, precitana dlzka, pozicia v precitanej dlzke }
 TotO:=0; CurO:=0; DlzO:=0; RelO:=0;  { OUT Celkova dlzka, aktualna pozicia, precitana dlzka, pozicia v precitanej dlzke }
 PocH:=0; Cria:=0;                    { pocet hlav, minimalne pozadovana sirka riadka }
 EOFI:=False; EOFO:=False;            { Indikatory konca suborov }
end;
 
 
{ S akymi parametrami bol program spusteny }
function TestParam( var in_file, out_file, frm_file : string ) : boolean;
var PS : array[1..9] of string;
    i : byte;
begin
 for i:=1 to 9 do PS[i]:='';
 for i:=1 to ParamCount do PS[i]:=Paramstr(i);
 
 TestParam := True;
 if (ParamCount = 0) then TestParam := False;
 
 for i:=1 to ParamCount do begin
    if ( PS[i][1]='/' ) and ( UpCase( PS[i][2] )='N') then vypis:=False;
    if ( PS[i][1]='/' ) and ( UpCase( PS[i][2] )='H') then TestParam:=False;
   end;
 
 if ( PS[1] <> '' ) and (PS[1][1] <> '/') then in_file:=PS[1];
 if ( PS[2] <> '' ) and (PS[2][1] <> '/') then in_file:=PS[2];
 if ( PS[3] <> '' ) and (PS[3][1] <> '/') then in_file:=PS[3];
end;
 
 
{ Otestuje existenciu suboru }
function TestFile( meno : string ) : Boolean;
var DirInfo : SearchRec;
begin
 FindFirst( meno, AnyFile, DirInfo );
 If DosError <> 0 then TestFile:=False
                  else TestFile:=True;
end;
 
 
{ Ma vyrobit prazdny FRM subor }
procedure MakeFrm( Txt_file, Frm_file : string );
var f:text;
begin
 Assign( f, Frm_file );
 {$I-}
 ReWrite( f );
 {$I+}
 if IoResult<>0 then chyba(4);
 WriteLn( f,'; Formular podla ktoreho je riadeny vyber poloziek.');
 WriteLn( f,'; Ich vyznam:');
 WriteLn( f,'; Nazov Typ Dlzka_typu Pocet_desatinnych_miest V_riadku_od V_riadku_do');
 WriteLn( f,'; Typ je C-retazec L-logicka N-cislo D-datum');
 WriteLn( f,'; ak sa nachadza v riadku nieco medzi nepokrytimi je riadok ignorovany');
 Close(f);
end;
 
 
{ vrati retazec po najbliziu medzeru }
function Dalsi( var retaz:string ) : string;
var pom : string;
begin
 pom:='';
 
 while( not( retaz[1] in ['a'..'z','A'..'Z','0'..'9','_']) and
           ( length( retaz ) > 0) ) do begin
   delete( retaz, 1, 1);
  end;
 
 while( retaz[1] in ['a'..'z','A'..'Z','0'..'9','_']) and
      ( length( retaz ) > 0) do begin
   pom := pom + retaz[1];
   delete( retaz, 1, 1);
  end;
 Dalsi := pom;
end;
 
 
{ vrati cislo po najbliziu medzeru }
function DalsiN( var retaz:string ) : word;
var pom : string;
    i,err : integer;
begin
 pom := Dalsi( retaz );
 repeat
  Val( pom, i, err);
  delete( pom,err,1 );
 until( ( err=0 ) or ( length( pom )=0 ) );
 DalsiN := i;
end;
 
 
{ Ma otvorit FRM subor a precitat z neho udaje }
procedure OpenFrm( Frm_file : string );
var f : text;
    i,err : integer;
    InfR : string;
    pom : string;
begin
 Assign( f, Frm_file );
 {$I-}
 ReSet( f );
 {$I+}
 if IoResult<>0 then chyba(5);
 
 Repeat
  ReadLn( f, InfR );
  if( InfR[1] <> ';' )then begin
   { Rozlozi sa na kusky }
   inc( PocH );
   pom := dalsi( InfR ); delete( pom, 11, length( pom ) );
   for i:=1 to length( pom ) do hlavy[ PocH ].nazov[i] := pom[i];
   pom := dalsi( InfR );
   hlavy[ PocH ].typep := pom[1];
   hlavy[ PocH ].size := dalsiN( InfR );
   hlavy[ PocH ].desat := dalsiN( InfR );
   hlavy[ PocH ].od_r := dalsiN( InfR );
   hlavy[ PocH ].do_r := dalsiN( InfR );
   if( hlavy[ PocH ].do_r > Cria ) then Cria := hlavy[ PocH ].do_r;
  end;  { if( InfR[1] <> ';' )then begin }
 
 Until( Eof(f) );
 Close(f);
end;
 
 
{ Ma otvorit TXT subor z ktoreho bude citat udaje }
function OpenFile( MenoI, MenoO : string ) : Boolean;
var DirInfo :SearchRec;
begin
 OpenFile:=False;               { Co nie je ukoncene je zle !!! Murphy 0 }
 { Pre In }
 FindFirst( MenoI, Anyfile, DirInfo );
 { Taku ma velkost }
 TotI := DirInfo.Size;
 { Otvorime si }
 Assign( InF, MenoI );
 {$I-}
 ReSet( InF,1 );
 {$I+}
 if IoResult = 0 then begin
     DlzHI := round( (MaxAvail - MinMem )/2 ); { /2 polovicu nechame pre zapis }
     if DlzHI > 65520 then DlzHI := 65520;     { Za segment neviem ist, ani alokovat, ani citat }
     if DlzHI > 0 then OpenFile := True;       { zatial vsetko OK }
     GetMem( HandI, DlzHI );
     if HandI = NIL then OpenFile := False;
    end;
 
 { Pre Out }
 Assign( OutF, MenoO );
 {$I-}
 ReWrite( OutF,1 );
 {$I+}
 if IoResult = 0 then begin
     DlzHO := (MaxAvail - MinMem );
     if DlzHO > 65520 then DlzHO := 65520; { Za segment neviem ist, ani alokovat, ani citat }
     if DlzHO > 0 then OpenFile := True;   { zatial vsetko OK }
     GetMem( HandO, DlzHO );
     if HandO = NIL then OpenFile := False;
    end;
end;
 
 
{ Zapise halvu DBF suboru }
procedure WriteHlava( var f:file );
begin
end;
 
 
{ Vyrobi cislo ako ma byt }
procedure MakeC( var retaz: string );
var i:integer;
begin
 i:=1;
 repeat
  if( retaz[i] in ['0'..'9','.'] )then inc(i)
                                  else delete( retaz, i, 1);
 until( i > length( retaz ) );
 if( length( retaz ) = 0) then retaz:='0';
end;
 
 
{ Vyrobi datum ako ma byt, len taky hruby filter }
procedure MakeD( var retaz: string );
begin
 if( retaz[1] in ['0'..'9'] )then retaz[1]:='0';
 if( retaz[2] in ['0'..'9'] )then retaz[2]:='0';
 if( retaz[3] <> '.')        then retaz[3]:='.';
 if( retaz[4] in ['0'..'9'] )then retaz[4]:='0';
 if( retaz[5] in ['0'..'9'] )then retaz[5]:='0';
 if( retaz[6] <> '.')        then retaz[6]:='.';
 if( retaz[7] in ['0'..'9'] )then retaz[7]:='0';
 if( retaz[8] in ['0'..'9'] )then retaz[8]:='0';
end;
 
 
{ Konvertuje do tvaru DBF riadku }
function Konvert( riadok: string; var base: array of string ) : boolean;
var i,x,err : integer;
    pom : string;
begin
 Konvert := False;
 if( ( length( riadok ) +1 ) < Cria ) then exit;
 
 for i:=1 to PocH do begin
   pom := copy( riadok, hlavy[i].od_r, ( hlavy[i].do_r - hlavy[i].od_r ));
   if( hlavy[i].typep ='N' )then MakeC( pom );
   if( hlavy[i].typep ='D' )then MakeD( pom );
   delete( pom, hlavy[i].size+1, length( pom ) );
   for err:=length( pom ) to hlavy[i].size-1 do pom := pom+' ';
   base[i] := pom;
  end;
 
 for i:=1 to PocH do
   for x:=hlavy[i].od_r to hlavy[i].do_r do riadok[x] := ' ';
 
 Repeat
  i := pos(' ', riadok );
  delete( riadok, i, 1);
 Until( ( i=0 ) or ( length( riadok )=0 ) );
 { bol to riadok ako ma byt }
 if( length( riadok ) = 0)then Konvert := True;
end;
 
 
{ Precita jeden riadok zo suboru }
procedure ReadNext( var f:file; var riadok: string );
var i : integer;
    staci : Boolean;     { mam este raz opakovat }
    tmp : char;
begin
 riadok:='';             { Vyprazdnime }
 
 Repeat
  staci := True;
  if (DlzI = 0) or ( DlzI = RelI) then begin
     gotoxy(1,1);Write('r', CurI:7 );
     CurI := CurI + DlzI;
     BlockRead( InF, HandI^, DlzHI, DlzI );
     RelI := 0;
    end;
 
  repeat
   Inc( RelI );
   { Filter na riadiace znaky }
   if( HandI^[ RelI ] >= #32 ) then riadok := riadok + HandI^[ RelI ];
  until( (HandI^[ RelI ] = #13) or (RelI >= DlzI) );
 
  { Noze mi nacitaj dalsi blok }
  if not(HandI^[ RelI ] = #13) then staci := False;
  { Dolsi sme na koniec suboru }
  if( TotI <= ( CurI + RelI ) )then begin
     EOFI:=True;
     staci := True;
    end;
 
 Until( staci );
end;
 
 
{ Zapise jeden znak do suboru }
procedure WriteNext( var OutF:file; ch:char; dopis: boolean );
begin
 Inc( RelO );
 
 if(( RelO = DlzHO) or dopis )then begin
    gotoxy(1,1);Write('W', CurO:7 );
    BlockWrite( OutF, HandO^, RelO, DlzO );
    if( DlzO <> RelO )then chyba(6);    { nastala zrada menaj zapisal ako mal }
    RelO := 0;
    CurO := CurO + DlzO;
   end;
 
 HandO^[ RelO ] := ch;
end;
 
 
{ Zapise jeden riadok do DBF suboru }
procedure WriteDBF( var OutF:file; base: array of string );
var i,y:integer;
begin
 for i:=1 to PocH do
    for y:=1 to hlavy[i].size do WriteNext( OutF, base[i][y], false );
end;
 
begin
 { Default }
 Default;
 { Test priechodnosti }
 if not( TestParam( in_file, out_file, frm_file )) then help(0);
 { Test a nacitanie formulara }
 if not( TestFile( frm_file ) ) then MakeFrm( in_file, frm_file );
 OpenFRM( frm_file );
 { Otvor subory }
 if not( OpenFile( in_file, out_file ) )  then chyba(2);
 { Zapise hlavu DBF }
 WriteHlava( OutF );
 
 While( not(EOFI) ) do begin
  { Precitaj dalsi riadok }
  ReadNext( InF, riadok );
  { Konvertuj na neake schopne DBF a -> Zapis do DBF }
  if( Konvert( riadok, base ) ) then
      WriteDBF( OutF, base );
 End; { While( Eof(InF) ) do begin }
 
 { Vyprazdnime buffer }
 WriteNext( OutF, ' ', True );
 { Uvolnime pamet }
 FreeMem( HandI, DlzHI ); FreeMem( HandO, DlzHO );
 { Uzavrieme subory }
 Close( InF ); Close( OutF );
end.