home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d123456 / STR_BIT.ZIP / 16 / PRIM / DESKR16.PAS < prev    next >
Pascal/Delphi Source File  |  2000-02-24  |  4KB  |  100 lines
  1. program Deskr16;
  2.  {************************************************************************}
  3.  { ¡á óσ«ñ »α«úαá¼¼δ »«ñáÑΓß∩ Σá⌐½, óδσ«ñ¡«⌐ Σá⌐½ »«½πτáÑΓß∩              }
  4.  { ñÑ߬αÑ¼í½¿α«ó᡿Ѽ ¿ßσ«ñ¡«ú« Σá⌐½á ó ß««ΓóÑΓßΓó¿¿ ß ºáñá¡¡δ¼ »«½¿¡«¼«¼ }
  5.  {                                                                        }
  6.  { ö«α¼áΓ ºáñá¡¿∩ »áαá¼ÑΓα«ó τÑαѺ ¬«¼á¡ñ¡πε ßΓ᫬π:                      }
  7.  { Deskr16 [êßσ.Σá⌐½] [öá⌐½ óδó«ñá] [æΓѻѡ∞ »«½¿¡«¼á] [ÄΓó«ñ »«½¿¡«¼á]'  }
  8.  {                                                                        }
  9.  { é ß½πτáÑ ºáñá¡¿∩ τáßΓ¿ »áαá¼ÑΓα«ó «ßΓá½∞¡δÑ íπñπΓ ºá»α«ΦÑ¡δ ó αѪ¿¼Ñ   }
  10.  { ñ¿á½«úá                                                                }
  11.  {************************************************************************}
  12. {$F+,R+,X+,B+,V-}
  13.  uses  StrBit16;
  14. var
  15.  InName, OutName, Prom : String;
  16.  Stepen, OtvPol : integer;
  17.  LenStr,i : WORD;
  18.  Ftest : File;
  19.  
  20. procedure DeskrSS(NameIs, NameRez: String; Otv1,Otv2: byte);
  21. const DlinaBl = 8192;
  22. var FIn, FOut : PBitFile;
  23.     TekPoz : Longint;
  24. begin
  25.  FIn := New(PBitFile,Init(DlinaBl+64,4096)); {éδñѽѡ¿Ñ »á¼∩Γ¿}
  26.  FOut := New(PBitFile,Init(DlinaBl,4096));   {éδñѽѡ¿Ñ »á¼∩Γ¿}
  27.  TekPoz := 0;
  28.    FIn^.OpenBitFile(NameIs, btOpenRead);     {ÄΓ¬αδΓ¿Ñ Σá⌐½á}
  29.    FOut^.OpenBitFile(NameRez, btCreate);
  30.     while Fin^.ReadStr(DlinaBl+Otv2) = btOk do
  31.      begin
  32.        FOut^.Copy(FIn, Otv2, DlinaBl); { C½«ªÑ¡¿Ñ »« ¼«ñπ½ε 2 ΓαÑσ í¿Γ«óδσ    }
  33.        FOut^.Mod2(Fin);                { »«Γ«¬«ó, ßñó¿¡πΓδσ ñαπú «Γ¡«ß¿Γѽ∞¡« }
  34.        FIn^.Delete(0, Otv2 - Otv1);    { ñαπúá ¡á óѽ¿τ¿¡π, «íαáΓ¡πε ßΓѻѡ¿  }
  35.        FOut^.Mod2(Fin);                { «Γó«ñá »«½¿¡«¼á ß¬αѼí½Ñαá           }
  36.        FOut^.WriteStr;
  37.        inc(TekPoz, DlinaBl);
  38.        Fin^.SeekStr(TekPoz);
  39.      end;
  40.  FIn^.CloseBitFile; { çá¬αδΓ¿Ñ «íαáíáΓδóáѼδσ Σá⌐½«ó}
  41.  FOut^.CloseBitFile;
  42.  Dispose(FIn,Done); Dispose(FOut,Done);  {Äßó«í«ªñÑ¡¿Ñ »á¼∩Γ¿}
  43.  Writeln('Äíαáí«Γ¬á ºáóÑαΦÑ¡á');
  44. end;
  45.  
  46. begin
  47.   Writeln('äÑ߬αÑ¼í½¿α«óá¡¿Ñ í¿Γ«ó«ú« »«Γ«¬á');
  48.   Writeln('ÇóΓ«α : æѼѡ«ó é.ï. éÑαß¿∩ 3.3 «Γ 25.11.99 ú.');
  49.   InName := '';
  50.  if ParamCount <1
  51.    then repeat
  52.    if InName <> '' then writeln('öá⌐½  ',InName, ' ¡Ñ ¡á⌐ñÑ¡!   éóÑñ¿ΓÑ ¬«ααÑ¬Γ¡«Ñ ¿¼∩ Σá⌐½á');
  53.       write('éóÑñ¿ΓÑ ¿¼∩ ¿ßσ«ñ¡«ú« Σá⌐½á: ');
  54.       readln(InName);
  55. {$I-}
  56.       Assign(Ftest,InName);
  57.       FileMode := 0;
  58.       Reset(Ftest);
  59.       Close(Ftest);
  60. {$I+}
  61.    until (IOResult = 0) and (InName <> '')
  62.   else InName :=ParamStr(1);   { óº∩Γ∞ ¿¼∩ Σá⌐½á ¿º ¬«¼á¡ñ¡«⌐ ßΓ᫬¿ }
  63.  if (ParamCount = 1) and ((InName='?') or (InName='/?') or (InName='-?')
  64.      or (InName='h')  or (InName='/h') or (InName='-h') )
  65.     then begin
  66.       writeln;
  67.       writeln('       ö«α¼áΓ ºáñá¡¿∩ »áαá¼ÑΓα«ó τÑαѺ ¬«¼á¡ñ¡πε ßΓ᫬π:');
  68.       writeln('Deskr16 [êßσ.Σá⌐½] [öá⌐½ óδó«ñá] [æΓѻѡ∞ »«½¿¡«¼á] [ÄΓó«ñ »«½¿¡«¼á]');
  69.       writeln;
  70.       writeln('é ß½πτáÑ ºáñá¡¿∩ τáßΓ¿ »áαá¼ÑΓα«ó «ßΓá½∞¡δÑ íπñπΓ ºá»α«ΦÑ¡δ ó αѪ¿¼Ñ ñ¿á½«úá');
  71.       Exit;
  72.          end;
  73.  if ParamCount < 2 then
  74.   begin write('éóÑñ¿ΓÑ ¿¼∩ Σá⌐½á óδó«ñá αѺπ½∞ΓáΓ«ó: ');
  75.         readln(OutName);
  76.   end
  77.   else OutName :=ParamStr(2);   { óº∩Γ∞ ¿¼∩ Σá⌐½á ¿º ¬«¼á¡ñ¡«⌐ ßΓ᫬¿ }
  78.  if ParamCount < 3 then
  79.   begin write('éóÑñ¿ΓÑ ßΓѻѡ∞ »«½¿¡«¼á: ');
  80.         readln(Prom);
  81.   end
  82.   else Prom :=ParamStr(3);   { óº∩Γ∞ ¿¼∩ Σá⌐½á ¿º ¬«¼á¡ñ¡«⌐ ßΓ᫬¿ }
  83.   Val(Prom, Stepen, i );
  84.   if (i <> 0) or (Stepen>64) then begin
  85.      Writeln('ÄΦ¿í¬á »α¿ ºáñá¡¿¿ æÆàÅàìê »«½¿¡«¼á!');
  86.      Exit                          end;
  87.   if ParamCount > 3 then Prom :=ParamStr(4)
  88.      else begin
  89.        write('éóÑñ¿ΓÑ «Γó«ñ »«½¿¡«¼á: ');
  90.        readln(Prom);
  91.           end;
  92.   Val(Prom, OtvPol, i );
  93.   if (i <> 0) or (Stepen<=OtvPol) then begin
  94.      Writeln('ÄΦ¿í¬á »α¿ ºáñá¡¿¿ æÆàÅàìê »«½¿¡«¼á!');
  95.      Exit                          end;
  96.  
  97.   DeskrSS(InName, OutName, OtvPol, Stepen);
  98.  
  99. end.
  100.