Localize file www.TrSek.com/pas/txtdbf.pas{ 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);
{ 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 }