home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d123456 / STR_BIT.ZIP / 32 / skr32 / SkrPr.pas < prev    next >
Pascal/Delphi Source File  |  2000-03-30  |  3KB  |  81 lines
  1. unit SkrPr;
  2.  
  3. interface
  4.  
  5. uses Dialogs, StrBit32;
  6.  
  7.  { φαδεµσφΦσ ∞≤δⁿ≥Φ∩δΦΩα≥ΦΓφεπε ±Ω≡σ∞ßδσ≡α }
  8. procedure SkrSS(NameIs, NameRez: String; Otv, OtvMax: byte);
  9.  { ±φ ≥Φσ ∞≤δⁿ≥Φ∩δΦΩα≥ΦΓφεπε ±Ω≡σ∞ßδσ≡α }
  10. procedure DeskrSS(NameIs, NameRez: String; Otv1,Otv2: byte);
  11.  
  12. implementation
  13.  
  14. procedure SkrSS(NameIs, NameRez: String; Otv, OtvMax: byte);
  15.  { φαδεµσφΦσ ∞≤δⁿ≥Φ∩δΦΩα≥ΦΓφεπε ±Ω≡σ∞ßδσ≡α }
  16. Var  Reg : TStr_Bit;
  17.      FIn, FOut : TBitFile;
  18.      PrBit : byte;
  19.      OtvMaxVn, OtvVn : Integer;
  20. begin
  21.  if (NameIs = '') or (NameRez = '') then Exit;
  22.  Reg := TStr_Bit.Create;
  23.  FIn := TBitFile.Create; {┬√ΣσδσφΦσ ∩α∞ ≥Φ}
  24.  FOut := TBitFile.Create; {┬√ΣσδσφΦσ ∩α∞ ≥Φ}
  25.  Try
  26.    FIn.OpenBitFile(NameIs, btOpenRead,bt8); {╬≥Ω≡√≥Φσ ⌠αΘδα}
  27.    FOut.OpenBitFile(NameRez, btCreate, bt8);
  28.    { ╙±≥αφεΓΩα φα≈αδⁿφεπε ±ε±≥ε φΦ  ≡σπΦ±≥≡α ±Ω≡σ∞ßδσ≡α }
  29.    Reg.Init_0(OtvMax);     Reg[0]:= 1;
  30.     { ▀Γφεσ ∩≡σεß≡ατεΓαφΦσ ≥Φ∩α ≤±Ωε≡ σ≥ Γ√τεΓ ∩≡ε÷σΣ≤≡ }
  31.    OtvMaxVn := OtvMax-1;   OtvVn := Otv-1;
  32.    PrBit := Fin.ReadBit;
  33.     while PrBit < 2 do
  34.      begin
  35.       PrBit := (Reg[OtvMaxVn] + Reg[OtvVn] + PrBit) mod 2;
  36.       FOut.WriteBit(PrBit);
  37.       Reg.BitDisplase(PrBit);
  38.       PrBit := Fin.ReadBit;
  39.      end;
  40.  Except   on EfileBitError do {╬°ΦßΩα εß≡αßε≥ΩΦ ⌠αΘδα}
  41.      ShowMessage('╬°ΦßΩα εß≡αßε≥ΩΦ');
  42.  end; {Except}
  43.  FIn.CloseBitFile; { ╟αΩ≡√≥Φσ εß≡αßα≥√Γασ∞√⌡ ⌠αΘδεΓ}
  44.  FOut.CloseBitFile;
  45.  Reg.Free;
  46.  FIn.Free; FOut.Free;  {╬±ΓεßεµΣσφΦσ ∩α∞ ≥Φ}
  47.  ShowMessage('╬ß≡αßε≥Ωα ταΓσ≡°σφα');
  48. end;
  49.  
  50. procedure DeskrSS(NameIs, NameRez: String; Otv1,Otv2: byte);
  51.  { ±φ ≥Φσ ∞≤δⁿ≥Φ∩δΦΩα≥ΦΓφεπε ±Ω≡σ∞ßδσ≡α }
  52. const DlinaBl = 8192;
  53. var FIn, FOut : TBitFile;
  54.     TekPoz : Longint;
  55. begin
  56.  if (NameIs = '') or (NameRez = '') then Exit;
  57.  FIn := TBitFile.Create; {┬√ΣσδσφΦσ ∩α∞ ≥Φ}
  58.  FOut := TBitFile.Create; {┬√ΣσδσφΦσ ∩α∞ ≥Φ}
  59.  TekPoz := 0;
  60.  Try
  61.    FIn.OpenBitFile(NameIs, btOpenRead,bt8); {╬≥Ω≡√≥Φσ ⌠αΘδα}
  62.    FOut.OpenBitFile(NameRez, btCreate,bt8);
  63.     while Fin.ReadStr(DlinaBl+Otv2) = btOk do
  64.      begin
  65.        FOut.Copy(FIn, Otv2, DlinaBl);
  66.        FOut.Bool(Fin,btXOR);
  67.        FIn.Delete(0, Otv2 - Otv1);
  68.        FOut.Bool(Fin,btXOR);
  69.        FOut.WriteStr;
  70.        inc(TekPoz, DlinaBl);    Fin.SeekStr(TekPoz);
  71.      end;
  72.  Except   on EfileBitError do {╬°ΦßΩα εß≡αßε≥ΩΦ ⌠αΘδα}
  73.      ShowMessage('╬°ΦßΩα εß≡αßε≥ΩΦ');
  74.  end; {Except}
  75.  FIn.CloseBitFile; { ╟αΩ≡√≥Φσ εß≡αßα≥√Γασ∞√⌡ ⌠αΘδεΓ}
  76.  FOut.CloseBitFile;
  77.  FIn.Free; FOut.Free;  {╬±ΓεßεµΣσφΦσ ∩α∞ ≥Φ}
  78.  ShowMessage('╬ß≡αßε≥Ωα ταΓσ≡°σφα');
  79. end;
  80.  
  81. end.