Vstupný súbor prekopíruje do výstupného s tým že TABulátory zmení na 8 medzier

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija: Programy zos Pascalu

Program: Trdbf.pas
Subor exe: Trdbf.exe

Vstupný súbor prekopíruje do výstupného s tým že TABulátory zmení na 8 medzier. Tento text potom bude vypadať v každom editore rovnako.
{ TRDBF.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Konvertuje znak TAB na osem medzier.                              }
{ syntax: trdbf.exe [zdroj] [ciel] [/smer] (prepinace)              }
{ zdroj - subor odsahujuci zdrojovi text s TAB, alebo bez TAB pri   }
{         spatnej konverzii                                         }
{ ciel  - subor ktory ma vzniknut konverziov TAB znakov na medzery  }
{                                                                   }
{ /smer                                                             }
{   /t - konvertuj tam TAB -> iny znak oddelovaca                   }
{   /s - konvertuj sem iny znak oddelovaca -> TAB                   }
{                                                                   }
{  nepovinne prepinace                                              }
{   /w:[znak] - znak ktory ma nahradit TAB                          }
{   /o:[znak] - znak ktory sa ma nahradit znakom /w:[znak]          }
{          /n - nepis nic na obrazovku                              }
{                                                                   }
{ Datum:28.11.1996                             http://www.trsek.com }
 
program sem_tem_TXT;
uses crt,dos;
const EOF_F=#26;
 
var ch:char;
    conv:boolean;
    oddel,TAB:char;             { odelovac miesto TAB }
    meno_z,meno_d:string;       { mena konvertovania z->do }
    poms:string;                { pomocny retazec }
    i:integer;                  { to iste }
    nepis:boolean;              { pisat/nepisat text na obrazovka }
 
procedure help;
begin
 WriteLn;
 WriteLn('Help trans TXT (with TAB) -> TXT (with word ; , etc.)');
 WriteLn('                                       Software by the best program`s man TRSEK');
 WriteLn('-------------------------------------------------------------------------------');
 WriteLn('without param - help');
 Writeln;
 WriteLn('syntax: trdbf.exe [zdroj] [ciel] [/smer] {prepinace}');
 WriteLn;
 WriteLn(' zdroj - subor odsahujuci zdrojovi text s TAB, alebo bez TAB pri ');
 WriteLn('         spatnej konverzii');
 WriteLn(' ciel  - subor ktory ma vzniknut konverziov TAB znakov na ine znaky');
 WriteLn;
 WriteLn(' /smer');
 WriteLn('         /t - konvertuj tam TAB -> iny znak oddelovaca ');
 WriteLn('         /s - konvertuj sem iny znak oddelovaca -> TAB');
 WriteLn;
 WriteLn(' nepovinne prepinace');
 WriteLn('  /w:[znak] - znak ktory ma nahradit TAB');
 WriteLn('  /o:[znak] - znak ktory sa ma nahradit znakom /w:[znak]');
 WriteLn('         /n - nepis nic na obrazovku');
 halt(0);
end;
 
function LZero(w : Word) : String;
var  s : String;
begin
  Str(w:0,s);
  if Length(s) = 1 then  s := '0' + s;
  LZero := s;
end;
 
procedure chyba(err:byte);
var f:text;
    y,m,d,dow : Word;
    h,mi,s,hund : Word;
begin
 GetDate(y,m,d,dow);
 GetTime(h,mi,s,hund);
 
 Assign(f,'trans.err');
 ReWrite(f);
 if conv then WriteLn(f,'U,',oddel:1,',',d:2, '.', m:2, '.', y:4,',',LZero(h),':',LZero(m),':',LZero(s),',',err:3)
         else WriteLn(f,'D,',oddel:1,',',d:2, '.', m:2, '.', y:4,',',LZero(h),':',LZero(mi),':',LZero(s),',',err:3);
 close(f);
 
 if (err<>0) then begin
    WriteLn('Ty pnaku nastala chyba c.',err);
    case err of
      2: WriteLn('Popis: Nemozem otvorit subor pravdepodobne neexistuje.');
      3: WriteLn('Popis: Nemozem zapisovat do suboru.');
      4: WriteLn('Popis: Subor neobsahuje ziadne data.');
     else
      WriteLn('Neviem co sa mohlo stat.');
     end;
   end;
 
 halt(err);
end;
 
procedure convertuj(meno_z,meno_d:string;conv:boolean;oddel:char);
var f,g:file;
    buf:pointer;
    dlzka,precitane:word;
    kolko,i:word;
    ch:^char;
begin
 if (MaxAvail>65535) then dlzka:=65535
                     else dlzka:=MaxAvail;
 if (dlzka>1024) then dlzka:=dlzka-1024;   { pre istotu }
 GetMem(buf,dlzka);
 
 Assign(f,meno_z);
 {$I-}
 ReSet(f,1);
 {$I+}
 if IOResult<>0 then chyba(2);
 
 Assign(g,meno_d);
 {$I-}
 ReWrite(g,1);
 {$I+}
 if IOResult<>0 then chyba(3);
 
 repeat
  {$I-}
  BlockRead(f,buf^,dlzka,precitane);
  {$I+}
  if IOResult<>0 then chyba(4);
  ch:=buf;kolko:=0;
  for i:=1 to precitane do begin
      if conv then begin
         if (ch^=TAB) then ch^:=oddel;
        end
        else begin
         if (ch^=oddel) then ch^:=TAB;
        end;
        ch:=Ptr(Seg(ch^),Ofs(ch^)+1);
        if (ch^=EOF_F) then i:=precitane;
        inc(kolko);
       end;
  BlockWrite(g,buf^,kolko);
 until (Eof(f));
 
 FreeMem(buf,dlzka);
 Close(f);
 Close(g);
end;
 
begin
 { Default nastavenia }
 oddel:=';';conv:=true;nepis:=false;TAB:=#9;
 
 if (ParamCount>=1) then meno_z:=ParamStr(1)
                    else help;
 
 if (ParamCount>=2) then meno_d:=ParamStr(2)
                    else help;
 
 for i:=3 to ParamCount do begin
     poms:=ParamStr(i);
     if (UpCase(poms[2])='T') then conv:=true;
     if (UpCase(poms[2])='S') then conv:=false;
     if (UpCase(poms[2])='W') then oddel:=poms[4];
     if (UpCase(poms[2])='O') then TAB:=poms[4];
     if (UpCase(poms[2])='N') then nepis:=true;
    end;
 
 if not(nepis) then begin
    WriteLn;
    WriteLn('Trans TXT (with TAB) -> TXT (with word ; , etc.)');
    WriteLn('------------------------------------------------');
   end;
 
 Convertuj(meno_z,meno_d,conv,oddel);
 if not(nepis) then WriteLn('O.K. - o.b.');
 Chyba(0);
end.