Vstupný súbor prekopíruje do výstupného s tým že TABulátory zmení na 8 medzier
Delphi & Pascal (česká wiki)
Kategorija: Programy zos Pascalu
Program: Trdbf.pas
Subor exe: Trdbf.exe
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.